Binary_File_Utility.f90

Go to the documentation of this file.

!
! Binary_File_Utility
!
! Module for utility routines for "Binary" datafiles (unformatted,
! sequential) that conform to the required format.
!
!
! CREATION HISTORY:
!       Written by:     Paul van Delst, 12-Jun-2000
!                       paul.vandelst@noaa.gov
!

MODULE binary_file_utility

  ! ------------------
  ! Environment set up
  ! ------------------
  ! Module use
  USE type_kinds,      ONLY: long, n_bytes_long
  USE file_utility,    ONLY: get_lun, file_exists, file_open
  USE message_handler, ONLY: success, failure, warning, display_message
  USE endian_utility,  ONLY: swap_endian
  ! Disable all implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  PRIVATE
  PUBLIC :: open_binary_file
  PUBLIC :: writegatts_binary_file
  PUBLIC :: readgatts_binary_file
  PUBLIC :: writelogical_binary_file
  PUBLIC :: readlogical_binary_file


  ! -------------------
  ! Procedure overloads
  ! -------------------
  INTERFACE writelogical_binary_file
    MODULE PROCEDURE writelogical_scalar
    MODULE PROCEDURE writelogical_rank1
  END INTERFACE writelogical_binary_file

  INTERFACE readlogical_binary_file
    MODULE PROCEDURE readlogical_scalar
    MODULE PROCEDURE readlogical_rank1
  END INTERFACE readlogical_binary_file


  ! ----------
  ! Parameters
  ! ----------
  CHARACTER(*), PARAMETER :: module_version_id = &
  '$Id: Binary_File_Utility.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
  ! Magic number header value for byte-swap checks
  INTEGER(Long), PARAMETER :: magic_number = 123456789_long
  ! Integer "logicals" for I/O
  INTEGER(Long), PARAMETER :: false = 0_long
  INTEGER(Long), PARAMETER :: true  = 1_long
  ! String lengths
  INTEGER, PARAMETER :: ml = 256   ! For messages
  INTEGER, PARAMETER :: gl = 5000  ! For local global attribute values
  ! Global attribute names
  CHARACTER(*), PARAMETER :: write_module_gattname = 'write_module'
  CHARACTER(*), PARAMETER :: created_on_gattname   = 'created_on'
  CHARACTER(*), PARAMETER :: title_gattname        = 'title'
  CHARACTER(*), PARAMETER :: history_gattname      = 'history'
  CHARACTER(*), PARAMETER :: comment_gattname      = 'comment'
  

CONTAINS


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

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       Open_Binary_File
!
! PURPOSE:
!       Function to open unformatted, sequential access "Binary" files
!
! CALLING SEQUENCE:
!       Error_Status = Open_Binary_File( Filename,                &
!                                        FileID,                  &
!                                        For_Output = For_Output, &
!                                        No_Check   = No_Check    )
!
! INPUTS:
!       Filename:         Name of the Binary file to open.
!                         UNITS:      N/A
!                         TYPE:       CHARACTER(*)
!                         DIMENSION:  Scalar
!                         ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!       For_Output:       Set this logical argument to open a new file for
!                         writing. Default action is to open an existing file
!                         for read access. Note, if the file already exists and
!                         it is opened with this keyword set, the file is
!                         overwritten.
!                         If == .FALSE., existing file is opened for READ access (DEFAULT)
!                                        ACTION='READ', STATUS='OLD'
!                            == .TRUE. , new file is opened for WRITE access.
!                                        ACTION='WRITE', STATUS='REPLACE'
!                         UNITS:      N/A
!                         TYPE:       LOGICAL
!                         DIMENSION:  Scalar
!                         ATTRIBUTES: INTENT(IN), OPTIONAL
!
!       No_Check:         Set this logical argument to suppress the byte-order
!                         check made on an existing file by NOT reading the file
!                         header magic number.  Default action is to check the
!                         file. This argument is ignored if the FOR_OUTPUT 
!                         optional argument is set.
!                         If == .FALSE., existing file magic number is read and the
!                                        byte order is checked (DEFAULT)
!                            == .TRUE.,  magic number is *NOT* read from file and
!                                        checked for validity.
!                         UNITS:      N/A
!                         TYPE:       LOGICAL
!                         DIMENSION:  Scalar
!                         ATTRIBUTES: INTENT(IN), OPTIONAL
!
! OUTPUTS:
!       FileID:           File unit number.
!                         UNITS:      N/A
!                         TYPE:       INTEGER
!                         DIMENSION:  Scalar
!                         ATTRIBUTES: 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. Values returned by
!                         this function are:
!                           SUCCESS == file open was successful
!                           FAILURE == an unrecoverable error occurred
!                         UNITS:      N/A
!                         TYPE:       INTEGER
!                         DIMENSION:  Scalar
!
!:sdoc-:
!--------------------------------------------------------------------------------

  FUNCTION open_binary_file( &
    Filename,   &  ! Input
    FileID,     &  ! Output
    For_Output, &  ! Optional input
    No_Check  ) &  ! Optional input
  result( err_stat )
    ! Arguments
    CHARACTER(*),           INTENT(IN)  :: filename
    INTEGER,                INTENT(OUT) :: fileid
    LOGICAL,      OPTIONAL, INTENT(IN)  :: for_output
    LOGICAL,      OPTIONAL, INTENT(IN)  :: no_check
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'Open_Binary_File'
    ! Local variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    LOGICAL :: file_check
    LOGICAL :: file_input
    INTEGER :: io_stat
    INTEGER(Long) :: magic_number_read
    CHARACTER(7) :: file_status
    CHARACTER(5) :: file_action

    ! Set up
    err_stat = success
    ! ...Check the For_Output argument
    file_input = .true.
    IF ( PRESENT(for_output) ) file_input = .NOT. for_output
    ! ...Check the No_Check argument
    file_check = file_input
    IF ( PRESENT(no_check) ) file_check = (.NOT. no_check) .AND. file_input


    ! Branch depending on type of file I/O
    IF ( file_input ) THEN
      ! Set OPEN keywords for READING
      file_status = 'OLD'
      file_action = 'READ'
    ELSE
      ! Set OPEN keywords for WRITING
      file_status = 'REPLACE'
      file_action = 'WRITE'
    END IF


    ! Check the file byte order
    IF ( file_check ) THEN
      err_stat = check_binary_file( filename )
      IF ( err_stat /= success ) THEN
        msg = 'Error checking '//trim(filename)//' file byte order'
        CALL cleanup(); RETURN
      END IF
    END IF


    ! Get a free unit number
    fileid = get_lun()
    IF ( fileid < 0 ) THEN
      msg = 'Error obtaining file unit number for '//trim(filename)
      CALL cleanup(); RETURN
    END IF


    ! Open the file
    OPEN( fileid, file   = filename     , &
                  status = file_status  , &
                  action = file_action  , &
                  access = 'SEQUENTIAL' , &
                  form   = 'UNFORMATTED', &
                  iostat = io_stat      , &
                  iomsg  = io_msg         )
    IF ( io_stat /= 0 ) THEN
      msg = 'Error opening '//trim(filename)//' - '//trim(io_msg)
      CALL cleanup(); RETURN
    END IF


    ! Skip past, or write the magic number
    IF ( file_input ) THEN
      READ( fileid, iostat=io_stat, iomsg=io_msg ) magic_number_read
      IF ( io_stat /= 0 ) THEN
        msg = 'Error reading magic number from '//trim(filename)//' - '//trim(io_msg)
        CALL cleanup(); RETURN
      END IF
    ELSE
      WRITE( fileid, iostat=io_stat, iomsg=io_msg ) magic_number
      IF ( io_stat /= 0 ) THEN
        msg = 'Error writing magic number to '//trim(filename)//' - '//trim(io_msg)
        CALL cleanup(); RETURN
      END IF
    END IF
    
  CONTAINS
   
     SUBROUTINE cleanup()
       IF ( file_open(filename) ) THEN
         CLOSE( fileid, iostat=io_stat, iomsg=io_msg )
         IF ( io_stat /= 0 ) &
           msg = trim(msg)//'; Error closing file during error cleanup - '//trim(io_msg)
       END IF
       err_stat = failure
       CALL display_message( routine_name, msg, err_stat )
     END SUBROUTINE cleanup

  END FUNCTION open_binary_file





  ! Function to write standard global attributes to a Binary file.

  FUNCTION writegatts_binary_file( &
    fid         , &  ! Input
    Write_Module, &  ! Optional input
    Created_On  , &  ! Optional input
    Title       , &  ! Optional input
    History     , &  ! Optional input
    Comment     ) &  ! Optional input
  result( err_stat )
    ! Arguments
    INTEGER     ,           INTENT(IN) :: fid
    CHARACTER(*), OPTIONAL, INTENT(IN) :: write_module
    CHARACTER(*), OPTIONAL, INTENT(IN) :: created_on  
    CHARACTER(*), OPTIONAL, INTENT(IN) :: title
    CHARACTER(*), OPTIONAL, INTENT(IN) :: history
    CHARACTER(*), OPTIONAL, INTENT(IN) :: comment
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'WriteGAtts_Binary_File'
    ! Local variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    CHARACTER(8)  :: cdate
    CHARACTER(10) :: ctime
    CHARACTER(5)  :: czone
    INTEGER :: io_stat

    ! Set up
    err_stat = success
    msg = ''

    ! Software ID
    CALL writesinglegatt( write_module_gattname, gattvalue = write_module )
    IF ( err_stat /= success ) RETURN
    
    ! Creation date/time
    CALL date_and_time( cdate, ctime, czone )
    IF ( PRESENT(created_on) ) THEN
      CALL writesinglegatt( created_on_gattname, gattvalue = created_on )
    ELSE
      CALL writesinglegatt( created_on_gattname, &
                            gattvalue = &
                              cdate(1:4)//'/'//cdate(5:6)//'/'//cdate(7:8)//', '// &
                              ctime(1:2)//':'//ctime(3:4)//':'//ctime(5:6)//' '// &
                              czone//'UTC')
    END IF
    IF ( err_stat /= success ) RETURN


    ! The title
    CALL writesinglegatt( title_gattname, gattvalue = title )
    IF ( err_stat /= success ) RETURN


    ! The history
    CALL writesinglegatt( history_gattname, gattvalue = history )
    IF ( err_stat /= success ) RETURN


    ! The comment
    CALL writesinglegatt( comment_gattname, gattvalue = comment )
    IF ( err_stat /= success ) RETURN
    
  CONTAINS
  
    SUBROUTINE writesinglegatt(gattname, gattvalue)
      CHARACTER(*),           INTENT(IN) :: gattname
      CHARACTER(*), OPTIONAL, INTENT(IN) :: gattvalue
      INTEGER :: gattlen
      CHARACTER(GL) :: l_gattvalue
      ! Setup
      l_gattvalue = ''
      IF ( PRESENT(gattvalue) ) THEN
        IF ( len_trim(gattvalue) /= 0 ) l_gattvalue = trim(gattname)//': '//trim(gattvalue)
      END IF
      gattlen = len_trim(l_gattvalue)
      ! Write the string length
      WRITE( fid, iostat=io_stat, iomsg=io_msg ) gattlen
      IF ( io_stat /= 0 ) THEN
        msg = 'Error writing '//trim(gattname)//' attribute length - '//trim(io_msg)
        CALL writegatts_cleanup(); RETURN
      END IF
      IF ( gattlen == 0 ) RETURN
      ! Write the attribute
      WRITE( fid, iostat=io_stat, iomsg=io_msg ) trim(l_gattvalue)
      IF ( io_stat /= 0 ) THEN
        msg = 'Error writing '//trim(gattname)//' attribute - '//trim(io_msg)
        CALL writegatts_cleanup(); RETURN
      END IF
    END SUBROUTINE writesinglegatt
     
    SUBROUTINE writegatts_cleanup()
      IF ( file_open(fid) ) 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 writegatts_cleanup
    
  END FUNCTION writegatts_binary_file



  ! Function to read standard global attributes from a Binary file.

  FUNCTION readgatts_binary_file( &
    fid         , &  ! Input
    Write_Module, &  ! Optional output
    Created_On  , &  ! Optional output
    Title       , &  ! Optional output
    History     , &  ! Optional output
    Comment     ) &  ! Optional output
  result( err_stat )
    ! Arguments
    INTEGER     ,           INTENT(IN)  :: fid
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: write_module
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: created_on  
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: title
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: history
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: comment
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'ReadGAtts_Binary_File'
    ! Local variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    INTEGER :: io_stat

    ! Set up
    err_stat = success
    msg = ''

    ! 
    ! Software ID
    CALL readsinglegatt( write_module_gattname, gattvalue = write_module )
    IF ( err_stat /= success ) RETURN
    
    ! Creation date/time
    CALL readsinglegatt( created_on_gattname, gattvalue = created_on )
    IF ( err_stat /= success ) RETURN


    ! The title
    CALL readsinglegatt( title_gattname, gattvalue = title )
    IF ( err_stat /= success ) RETURN


    ! The history
    CALL readsinglegatt( history_gattname, gattvalue = history )
    IF ( err_stat /= success ) RETURN


    ! The comment
    CALL readsinglegatt( comment_gattname, gattvalue = comment )
    IF ( err_stat /= success ) RETURN
    
  CONTAINS
  
    SUBROUTINE readsinglegatt( gattname, gattvalue)
      CHARACTER(*),           INTENT(IN)  :: gattname
      CHARACTER(*), OPTIONAL, INTENT(OUT) :: gattvalue
      INTEGER :: i, gattlen
      CHARACTER(GL) :: l_gattvalue
      ! Setup
      IF ( PRESENT(gattvalue) ) gattvalue = ''
      l_gattvalue = ''
      ! Read the string length
      READ( fid, iostat=io_stat, iomsg=io_msg ) gattlen
      IF ( io_stat /= 0 ) THEN
        msg = 'Error reading '//trim(gattname)//' attribute length - '//trim(io_msg)
        CALL readgatts_cleanup(); RETURN
      END IF
      IF ( gattlen == 0 ) RETURN
      ! Read the attribute
      READ( fid, iostat=io_stat, iomsg=io_msg ) l_gattvalue(1:gattlen)
      IF ( io_stat /= 0 ) THEN
        msg = 'Error reading '//trim(gattname)//' attribute - '//trim(io_msg)
        CALL readgatts_cleanup(); RETURN
      END IF
      ! Strip out the attribute name
      IF ( PRESENT(gattvalue) ) THEN
        i = index(l_gattvalue,': ')
        gattvalue = l_gattvalue(i+2:gattlen)
      END IF    
    END SUBROUTINE readsinglegatt
     
    SUBROUTINE readgatts_cleanup()
      IF ( file_open(fid) ) 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 readgatts_cleanup
    
  END FUNCTION readgatts_binary_file




  !
  ! NAME:
  !   ReadLogical_Binary_File
  !
  ! PURPOSE:
  !   Utility function to read an integer "logical" value from file
  !

  FUNCTION readlogical_scalar( &
    fid, &
    logical_value ) &
  result( err_stat )
    ! Arguments
    INTEGER, INTENT(IN)  :: fid
    LOGICAL, INTENT(OUT) :: logical_value
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: routine_name = 'ReadLogical_Binary_File(Scalar)'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    INTEGER :: io_stat
    INTEGER(Long) :: logical_integer

    ! Setup
    err_stat = success

    ! Read the integer
    READ( fid,iostat=io_stat,iomsg=io_msg ) logical_integer
    IF ( io_stat /= 0 ) THEN
      err_stat = failure
      msg = 'Error reading logical integer value - '//trim(io_msg)
      CALL display_message( routine_name, msg, err_stat )
      RETURN
    END IF

    ! Convert integer to a logical value
    logical_value = (logical_integer == true)

  END FUNCTION readlogical_scalar

  FUNCTION readlogical_rank1( &
    fid, &
    logical_value ) &
  result( err_stat )
    ! Arguments
    INTEGER, INTENT(IN)  :: fid
    LOGICAL, INTENT(OUT) :: logical_value(:)
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: routine_name = 'ReadLogical_Binary_File(Rank-1)'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    INTEGER :: io_stat
    INTEGER(Long) :: logical_integer(size(logical_value)) 

    ! Setup
    err_stat = success

    ! Read the integer
    READ( fid,iostat=io_stat,iomsg=io_msg ) logical_integer
    IF ( io_stat /= 0 ) THEN
      err_stat = failure
      msg = 'Error reading logical integer rank-1 array - '//trim(io_msg)
      CALL display_message( routine_name, msg, err_stat )
      RETURN
    END IF

    ! Convert integer to a logical value
    logical_value = (logical_integer == true)

  END FUNCTION readlogical_rank1


  !
  ! NAME:
  !   WriteLogical_Binary_File
  !
  ! PURPOSE:
  !   Utility function to write an integer "logical" value to file
  !

  FUNCTION writelogical_scalar( &
    fid, &
    logical_value ) &
  result( err_stat )
    ! Arguments
    INTEGER, INTENT(IN) :: fid
    LOGICAL, INTENT(IN) :: logical_value
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: routine_name = 'WriteLogical_Binary_File(Scalar)'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    INTEGER :: io_stat
    INTEGER(Long) :: logical_integer

    ! Setup
    err_stat = success


    ! Convert the logical to an integer value
    IF ( logical_value ) THEN
      logical_integer = true
    ELSE
      logical_integer = false
    END IF


    ! Write the integer
    WRITE( fid,iostat=io_stat,iomsg=io_msg ) logical_integer
    IF ( io_stat /= 0 ) THEN
      err_stat = failure
      msg = 'Error writing logical integer - '//trim(io_msg)
      CALL display_message( routine_name, msg, err_stat )
      RETURN
    END IF

  END FUNCTION writelogical_scalar

  FUNCTION writelogical_rank1( &
    fid, &
    logical_value ) &
  result( err_stat )
    ! Arguments
    INTEGER, INTENT(IN) :: fid
    LOGICAL, INTENT(IN) :: logical_value(:)
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: routine_name = 'WriteLogical_Binary_File(Rank-1)'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    INTEGER :: io_stat
    INTEGER(Long) :: logical_integer(size(logical_value)) 

    ! Setup
    err_stat = success


    ! Convert the logical to an integer value
    WHERE ( logical_value )
      logical_integer = true
    ELSEWHERE
      logical_integer = false
    END WHERE


    ! Write the integer
    WRITE( fid,iostat=io_stat,iomsg=io_msg ) logical_integer
    IF ( io_stat /= 0 ) THEN
      err_stat = failure
      msg = 'Error writing logical integer rank-1 array - '//trim(io_msg)
      CALL display_message( routine_name, msg, err_stat )
      RETURN
    END IF

  END FUNCTION writelogical_rank1



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

!--------------------------------------------------------------------------------
!
! NAME:
!       Check_Binary_File
!
! PURPOSE:
!       Function to determine if the unformatted Binary file is in the correct
!       byte order.
!
! CALLING SEQUENCE:
!       Error_Status = Check_Binary_File( Filename )
!
! INPUTS:
!       Filename:         Name of the Binary file to check.
!                         UNITS:      N/A
!                         TYPE:       CHARACTER(*)
!                         DIMENSION:  Scalar
!                         ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!       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 the screen.
!                         UNITS:      N/A
!                         TYPE:       CHARACTER(*)
!                         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. Values returned by
!                         this function are:
!                           SUCCESS == file check was successful
!                           FAILURE == - error occurred reading a file record,
!                                      - 8- and/or 32-bit integers not supported.
!                         UNITS:      N/A
!                         TYPE:       INTEGER
!                         DIMENSION:  Scalar
!
!--------------------------------------------------------------------------------

  FUNCTION check_binary_file( Filename ) RESULT( err_stat )
    ! Arguments
    CHARACTER(*), INTENT(IN) :: filename
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*),  PARAMETER :: routine_name = 'Check_Binary_File'
    ! Local variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    INTEGER :: fid
    INTEGER :: io_stat
    INTEGER(Long) :: magic_number_read
    INTEGER(Long) :: magic_number_swapped

    ! Set up
    err_stat = success


    ! Check that 4-byte integers are supported
    IF ( bit_size( 1_long ) /= 32 ) THEN
      msg = '32-bit integers not supported. Unable to determine endian-ness'
      CALL cleanup(); RETURN
    END IF


    ! Get a free unit number
    fid = get_lun()
    IF ( fid < 0 ) THEN
      msg = 'Error obtaining file unit number for '//trim(filename)
      CALL cleanup(); RETURN
    END IF


    ! Open the file as direct access
    OPEN( fid, file   = filename     , &
               status = 'OLD'        , &
               action = 'READ'       , &
               access = 'DIRECT'     , &
               form   = 'UNFORMATTED', &
               recl   = n_bytes_long , &
               iostat = io_stat      , &
               iomsg  = io_msg         )
    IF ( io_stat /= 0 ) THEN
      msg = 'Error opening '//trim(filename)//' - '//trim(io_msg)
      CALL cleanup(); RETURN
    END IF


    ! Read the magic number
    READ( fid, rec=2, iostat=io_stat, iomsg=io_msg ) magic_number_read
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading file magic number - '//trim(io_msg)
      CALL cleanup(); RETURN
    END IF


    ! Close the file
    CLOSE( fid )


    ! Compare the magic numbers
    IF ( magic_number_read /= magic_number ) THEN

      ! Byte swap the magic number
      magic_number_swapped = swap_endian( magic_number_read )
      IF ( magic_number_swapped /= magic_number ) THEN
        msg = 'Unrecognised file format. Invalid magic number.'
        CALL cleanup(); RETURN
      END IF

      ! If we get here then the data does need to be byte-swapped
      msg = 'Data file needs to be byte-swapped.'
      CALL cleanup(); RETURN

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

  END FUNCTION check_binary_file

END MODULE binary_file_utility