IRwaterCoeff_Define.f90

Go to the documentation of this file.

!
! IRwaterCoeff_Define
!
! Module defining the IRwaterCoeff object to hold coefficient
! data for the infrared water surface emissivity and reflectivity models.
!
!
! CREATION HISTORY:
!       Written by:     Paul van Delst, 19-Aug-2011
!                       paul.vandelst@noaa.gov
 
MODULE irwatercoeff_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
  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE
  ! Datatypes
  PUBLIC :: irwatercoeff_type
  ! Operators
  PUBLIC :: OPERATOR(==)
  ! Procedures
  PUBLIC :: irwatercoeff_associated
  PUBLIC :: irwatercoeff_destroy
  PUBLIC :: irwatercoeff_create
  PUBLIC :: irwatercoeff_inspect
  PUBLIC :: irwatercoeff_validrelease
  PUBLIC :: irwatercoeff_info
  PUBLIC :: irwatercoeff_defineversion
  PUBLIC :: irwatercoeff_inquirefile
  PUBLIC :: irwatercoeff_readfile
  PUBLIC :: irwatercoeff_writefile


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


  ! -----------------
  ! Module parameters
  ! -----------------
  CHARACTER(*), PARAMETER :: module_version_id = &
    '$Id: IRwaterCoeff_Define.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
  ! Current valid release and version
  INTEGER, PARAMETER :: irwatercoeff_release = 3  ! This determines structure and file formats.
  INTEGER, PARAMETER :: irwatercoeff_version = 2  ! This is just the default data version.
  ! Close status for write errors
  CHARACTER(*), PARAMETER :: write_error_status = 'DELETE'
  ! Literal constants
  REAL(fp), PARAMETER :: zero = 0.0_fp
  REAL(fp), PARAMETER :: one  = 1.0_fp
  ! Conversion constants
  REAL(fp), PARAMETER :: pi = 3.141592653589793238462643383279_fp
  REAL(fp), PARAMETER :: degrees_to_radians = pi / 180.0_fp
  ! String lengths
  INTEGER,  PARAMETER :: ml = 256 ! Message length


  ! ----------------------------------
  ! IRwaterCoeff data type definitions
  ! ----------------------------------
  !:tdoc+:
  TYPE :: irwatercoeff_type
    ! Allocation indicator
    LOGICAL :: is_allocated = .false.
    ! Release and version information
    INTEGER(Long) :: release = irwatercoeff_release
    INTEGER(Long) :: version = irwatercoeff_version
    ! Dimensions
    INTEGER(Long) :: n_angles      = 0   ! I dimension
    INTEGER(Long) :: n_frequencies = 0   ! L dimension
    INTEGER(Long) :: n_wind_speeds = 0   ! N dimension
    ! Dimensional vectors
    REAL(Double), ALLOCATABLE :: angle(:)       ! I
    REAL(Double), ALLOCATABLE :: frequency(:)   ! L
    REAL(Double), ALLOCATABLE :: wind_speed(:)  ! N
    ! Emissivity LUT data
    REAL(Double), ALLOCATABLE :: emissivity(:,:,:)  ! I x L x N
    ! Transformed dimensional vectors
    REAL(Double), ALLOCATABLE :: secant_angle(:)  ! I
  END TYPE irwatercoeff_type
  !:tdoc-:


CONTAINS


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

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       IRwaterCoeff_Associated
!
! PURPOSE:
!       Elemental function to test the status of the allocatable components
!       of the IRwaterCoeff structure.
!
! CALLING SEQUENCE:
!       Status = IRwaterCoeff_Associated( IRwaterCoeff )
!
! OBJECTS:
!       IRwaterCoeff:  Structure which is to have its member's
!                      status tested.
!                      UNITS:      N/A
!                      TYPE:       IRwaterCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       Status:        The return value is a logical value indicating the
!                      status of the NLTE members.
!                       .TRUE.  - if ANY of the IRwaterCoeff allocatable members
!                                 are in use.
!                       .FALSE. - if ALL of the IRwaterCoeff allocatable members
!                                 are not in use.
!                      UNITS:      N/A
!                      TYPE:       LOGICAL
!                      DIMENSION:  Same as input
!
!:sdoc-:
!--------------------------------------------------------------------------------

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

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

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


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       IRwaterCoeff_Create
!
! PURPOSE:
!       Elemental subroutine to create an instance of an IRwaterCoeff object.
!
! CALLING SEQUENCE:
!       CALL IRwaterCoeff_Create( IRwaterCoeff , &
!                                 n_Angles     , &
!                                 n_Frequencies, &
!                                 n_Wind_Speeds  )
!
! OBJECTS:
!       IRwaterCoeff:   IRwaterCoeff object structure.
!                       UNITS:      N/A
!                       TYPE:       IRwaterCoeff_type
!                       DIMENSION:  Scalar or any rank
!                       ATTRIBUTES: INTENT(OUT)
!
! INPUTS:
!       n_Angles:       Number of angles dimension.
!                       Must be > 0.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Conformable with the IRwaterCoeff object
!                       ATTRIBUTES: INTENT(IN)
!
!       n_Frequencies:  Number of frequencies dimension.
!                       Must be > 0.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Conformable with the IRwaterCoeff object
!                       ATTRIBUTES: INTENT(IN)
!
!       n_Wind_Speeds:  Number of wind speeds dimension.
!                       Must be > 0.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Conformable with the IRwaterCoeff object
!                       ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE irwatercoeff_create( &
    self         , &  ! Output
    n_Angles     , &  ! Input
    n_Frequencies, &  ! Input
    n_Wind_Speeds  )  ! Input
    ! Arguments
    TYPE(irwatercoeff_type), INTENT(OUT) :: self
    INTEGER                , INTENT(IN)  :: n_angles             
    INTEGER                , INTENT(IN)  :: n_frequencies        
    INTEGER                , INTENT(IN)  :: n_wind_speeds             
    ! Local variables
    INTEGER :: alloc_stat

    ! Check input
    IF ( n_angles      < 1 .OR. &
         n_frequencies < 1 .OR. &
         n_wind_speeds < 1 ) RETURN

   
    ! Perform the allocation
    ALLOCATE( self%Angle( n_angles ), &
              self%Frequency( n_frequencies ), &
              self%Wind_Speed( n_wind_speeds ), &
              self%Emissivity( n_angles, n_frequencies, n_wind_speeds ), &
              self%Secant_Angle( n_angles ), &
              stat = alloc_stat )
    IF ( alloc_stat /= 0 ) RETURN


    ! Initialise
    ! ...Dimensions
    self%n_Angles      = n_angles     
    self%n_Frequencies = n_frequencies
    self%n_Wind_Speeds = n_wind_speeds
    ! ...Arrays
    self%Angle        = zero
    self%Frequency    = zero
    self%Wind_Speed   = zero
    self%Emissivity   = zero
    self%Secant_Angle = zero

    ! Set allocation indicator
    self%Is_Allocated = .true.

  END SUBROUTINE irwatercoeff_create


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

  SUBROUTINE irwatercoeff_inspect( self )
    TYPE(irwatercoeff_type), INTENT(IN) :: self
    INTEGER :: i2, i3
    WRITE(*,'(1x,"IRwaterCoeff OBJECT")')
    ! Release/version info
    WRITE(*,'(3x,"Release.Version :",1x,i0,".",i0)') self%Release, self%Version
    ! Dimensions
    WRITE(*,'(3x,"n_Angles        :",1x,i0)') self%n_Angles     
    WRITE(*,'(3x,"n_Frequencies   :",1x,i0)') self%n_Frequencies
    WRITE(*,'(3x,"n_Wind_Speeds   :",1x,i0)') self%n_Wind_Speeds
    IF ( .NOT. irwatercoeff_associated(self) ) RETURN
    ! Dimension arrays
    WRITE(*,'(3x,"Angle      :")')
    WRITE(*,'(5(1x,es13.6,:))') self%Angle     
    WRITE(*,'(3x,"Frequency  :")')
    WRITE(*,'(5(1x,es13.6,:))') self%Frequency 
    WRITE(*,'(3x,"Wind_Speed :")')
    WRITE(*,'(5(1x,es13.6,:))') self%Wind_Speed
    ! Emissivity array
    WRITE(*,'(3x,"Emissivity :")')
    DO i3 = 1, self%n_Wind_Speeds
      WRITE(*,'(5x,"WIND_SPEED :",es13.6)') self%Wind_Speed(i3)
      DO i2 = 1, self%n_Frequencies
        WRITE(*,'(5x,"FREQUENCY  :",es13.6)') self%Frequency(i2)      
        WRITE(*,'(5(1x,es13.6,:))') self%Emissivity(:,i2,i3)
      END DO
    END DO
  END SUBROUTINE irwatercoeff_inspect



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

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

    ! Set up
    isvalid = .true.


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


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

  END FUNCTION irwatercoeff_validrelease


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       IRwaterCoeff_Info
!
! PURPOSE:
!       Subroutine to return a string containing version and dimension
!       information about a IRwaterCoeff object.
!
! CALLING SEQUENCE:
!       CALL IRwaterCoeff_Info( IRwaterCoeff, Info )
!
! OBJECTS:
!       IRwaterCoeff:  IRwaterCoeff object about which info is required.
!                      UNITS:      N/A
!                      TYPE:       IRwaterCoeff_type
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
!       Info:          String containing version and dimension information
!                      about the IRwaterCoeff object.
!                      UNITS:      N/A
!                      TYPE:       CHARACTER(*)
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE irwatercoeff_info( self, Info )
    ! Arguments
    TYPE(irwatercoeff_type), INTENT(IN)  :: self
    CHARACTER(*),            INTENT(OUT) :: info
    ! Parameters
    INTEGER, PARAMETER :: carriage_return = 13
    INTEGER, PARAMETER :: linefeed = 10
    ! Local variables
    CHARACTER(2000) :: long_string

    ! Write the required data to the local string
    WRITE( long_string, &
           '( a,1x,"IRwaterCoeff RELEASE.VERSION: ", i2, ".", i2.2, 2x, &
              &"N_ANGLES=",i3,2x,&
              &"N_FREQUENCIES=",i5,2x,&
              &"N_WIND_SPEEDS=",i3 )' ) &
           achar(carriage_return)//achar(linefeed), &
           self%Release, self%Version, &
           self%n_Angles, &
           self%n_Frequencies, &
           self%n_Wind_Speeds
                       
    ! Trim the output based on the
    ! dummy argument string length
    info = long_string(1:min(len(info), len_trim(long_string)))

  END SUBROUTINE irwatercoeff_info
 
 
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       IRwaterCoeff_DefineVersion
!
! PURPOSE:
!       Subroutine to return the module version information.
!
! CALLING SEQUENCE:
!       CALL IRwaterCoeff_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 irwatercoeff_defineversion( Id )
    CHARACTER(*), INTENT(OUT) :: id
    id = module_version_id
  END SUBROUTINE irwatercoeff_defineversion


!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       IRwaterCoeff_InquireFile
!
! PURPOSE:
!       Function to inquire a IRwaterCoeff object container file.
!
! CALLING SEQUENCE:
!       Error_Status = IRwaterCoeff_InquireFile( &
!                        Filename                     , &
!                        n_Angles      = n_Angles     , &
!                        n_Frequencies = n_Frequencies, &
!                        n_Wind_Speeds = n_Wind_Speeds, &
!                        Release       = Release      , &
!                        Version       = Version      , &
!                        Title         = Title        , &
!                        History       = History      , &
!                        Comment       = Comment        )
!
! INPUTS:
!       Filename:           Character string specifying the name of the
!                           data file to inquire.
!                           UNITS:      N/A
!                           TYPE:       CHARACTER(*)
!                           DIMENSION:  Scalar
!                           ATTRIBUTES: INTENT(IN)
!
! OPTIONAL OUTPUTS:
!       n_Angles:           Number of angles for which there are
!                           emissivity data.
!                           UNITS:      N/A
!                           TYPE:       INTEGER
!                           DIMENSION:  Scalar
!                           ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       n_Frequencies:      Number of spectral frequencies for which there are
!                           emissivity data.
!                           UNITS:      N/A
!                           TYPE:       INTEGER
!                           DIMENSION:  Scalar
!                           ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       n_Wind_Speeds:      Number of wind speeds for which there are
!                           emissivity data.
!                           UNITS:      N/A
!                           TYPE:       INTEGER
!                           DIMENSION:  Scalar
!                           ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       Release:            The data/file release number. Used to check
!                           for data/software mismatch.
!                           UNITS:      N/A
!                           TYPE:       INTEGER
!                           DIMENSION:  Scalar
!                           ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       Version:            The data/file version number. Used for
!                           purposes only in identifying the dataset for
!                           a particular release.
!                           UNITS:      N/A
!                           TYPE:       INTEGER
!                           DIMENSION:  Scalar
!                           ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       Title:              Character string containing a succinct description
!                           of what is in the dataset.
!                           UNITS:      N/A
!                           TYPE:       CHARACTER(*)
!                           DIMENSION:  Scalar
!                           ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       History:            Character string containing dataset creation
!                           history.
!                           UNITS:      N/A
!                           TYPE:       CHARACTER(*)
!                           DIMENSION:  Scalar
!                           ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       Comment:            Character string containing any comments about
!                           the dataset.
!                           UNITS:      N/A
!                           TYPE:       CHARACTER(*)
!                           DIMENSION:  Scalar
!                           ATTRIBUTES: INTENT(OUT), 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 inquire was successful
!                              == FAILURE an unrecoverable error occurred.
!                           UNITS:      N/A
!                           TYPE:       INTEGER
!                           DIMENSION:  Scalar
!
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION irwatercoeff_inquirefile( &
    Filename     , &  ! Input
    n_Angles     , &  ! Optional output
    n_Frequencies, &  ! Optional output
    n_Wind_Speeds, &  ! Optional output
    Release      , &  ! Optional output
    Version      , &  ! Optional output
    Title        , &  ! Optional output
    History      , &  ! Optional output
    Comment      ) &  ! Optional output
  result( err_stat )
    ! Arguments
    CHARACTER(*),           INTENT(IN)  :: filename
    INTEGER     , OPTIONAL, INTENT(OUT) :: n_angles     
    INTEGER     , OPTIONAL, INTENT(OUT) :: n_frequencies
    INTEGER     , OPTIONAL, INTENT(OUT) :: n_wind_speeds
    INTEGER     , OPTIONAL, INTENT(OUT) :: release
    INTEGER     , OPTIONAL, INTENT(OUT) :: version
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: title           
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: history         
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: comment         
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: routine_name = 'IRwaterCoeff_InquireFile'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    INTEGER :: io_stat
    INTEGER :: fid
    TYPE(irwatercoeff_type) :: irwatercoeff

 
    ! Setup
    err_stat = success
    ! ...Check that the file exists
    IF ( .NOT. file_exists( filename ) ) THEN
      msg = 'File '//trim(filename)//' not found.'
      CALL inquire_cleanup(); RETURN
    END IF


    ! Open the file
    err_stat = open_binary_file( filename, fid )
    IF ( err_stat /= success ) THEN
      msg = 'Error opening '//trim(filename)
      CALL inquire_cleanup(); RETURN
    END IF


    ! Read the release and version
    READ( fid, iostat=io_stat, iomsg=io_msg ) &
      irwatercoeff%Release, &
      irwatercoeff%Version
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading Release/Version - '//trim(io_msg)
      CALL inquire_cleanup(); RETURN
    END IF


    ! Read the dimensions
    READ( fid, iostat=io_stat, iomsg=io_msg ) &
      irwatercoeff%n_Angles     , &
      irwatercoeff%n_Frequencies, &
      irwatercoeff%n_Wind_Speeds
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading dimension values from '//trim(filename)//' - '//trim(io_msg)
      CALL inquire_cleanup(); RETURN
    END IF


    ! 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 inquire_cleanup(); RETURN
    END IF


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


    ! Assign the return arguments
    IF ( PRESENT(n_angles     ) ) n_angles      = irwatercoeff%n_Angles     
    IF ( PRESENT(n_frequencies) ) n_frequencies = irwatercoeff%n_Frequencies
    IF ( PRESENT(n_wind_speeds) ) n_wind_speeds = irwatercoeff%n_Wind_Speeds    
    IF ( PRESENT(release      ) ) release       = irwatercoeff%Release
    IF ( PRESENT(version      ) ) version       = irwatercoeff%Version
    
  CONTAINS
  
    SUBROUTINE inquire_cleanup()
      ! Close file if necessary
      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
      ! Set error status and print error message
      err_stat = failure
      CALL display_message( routine_name, msg, err_stat )
    END SUBROUTINE inquire_cleanup
    
  END FUNCTION irwatercoeff_inquirefile


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       IRwaterCoeff_ReadFile
!
! PURPOSE:
!       Function to read IRwaterCoeff object files.
!
! CALLING SEQUENCE:
!       Error_Status = IRwaterCoeff_ReadFile( &
!                        IRwaterCoeff       , &
!                        Filename           , &
!                        No_Close = No_Close, &
!                        Quiet    = Quiet   , &
!                        Title    = Title   , &
!                        History  = History , &
!                        Comment  = Comment   )
!
! OBJECTS:
!       IRwaterCoeff:   Object containing the data read from file.
!                       UNITS:      N/A
!                       TYPE:       IRwaterCoeff_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT)
!
! INPUTS:
!       Filename:       Character string specifying the name of the
!                       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 IRwaterCoeff 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
!
! OPTIONAL OUTPUTS:
!       Title:          Character string containing a succinct description
!                       of what is in the dataset.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       History:        Character string containing dataset creation
!                       history.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       Comment:        Character string containing any comments about
!                       the dataset.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT), 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 irwatercoeff_readfile( &
    IRwaterCoeff, &  ! 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(irwatercoeff_type), INTENT(OUT) :: irwatercoeff
    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 = 'IRwaterCoeff_ReadFile'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    LOGICAL :: close_file
    LOGICAL :: noisy
    INTEGER :: io_stat
    INTEGER :: fid
    TYPE(irwatercoeff_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. irwatercoeff_validrelease( dummy ) ) THEN
      msg = 'IRwaterCoeff Release check failed.'
      CALL read_cleanup(); RETURN
    END IF


    ! Read the dimensions
    READ( fid, iostat=io_stat, iomsg=io_msg ) &
      dummy%n_Angles     , &
      dummy%n_Frequencies, &
      dummy%n_Wind_Speeds
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading dimension values from '//trim(filename)//' - '//trim(io_msg)
      CALL read_cleanup(); RETURN
    END IF
    ! ...Create the return object
    CALL irwatercoeff_create( &
           irwatercoeff       , &
           dummy%n_Angles     , &        
           dummy%n_Frequencies, &        
           dummy%n_Wind_Speeds  )
    IF ( .NOT. irwatercoeff_associated( irwatercoeff ) ) THEN
      msg = 'IRwaterCoeff object creation failed.'
      CALL read_cleanup(); RETURN
    END IF
    ! ...Explicitly assign the version number
    irwatercoeff%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 coefficient data
    ! ...Read the dimensional vectors
    READ( fid, iostat=io_stat, iomsg=io_msg ) &
      irwatercoeff%Angle     , &
      irwatercoeff%Frequency , &
      irwatercoeff%Wind_Speed
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading dimensional vectors - '//trim(io_msg)
      CALL read_cleanup(); RETURN
    END IF
    ! ...Read the emissivity data
    READ( fid, iostat=io_stat, iomsg=io_msg ) &
      irwatercoeff%Emissivity
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading emissivity data - '//trim(io_msg)
      CALL read_cleanup(); RETURN
    END IF
    ! ...Compute the transformed dimensional vectors
    irwatercoeff%Secant_Angle = one/cos(degrees_to_radians*irwatercoeff%Angle)

    ! 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


    ! Output an info message
     IF ( noisy ) THEN
       CALL irwatercoeff_info( irwatercoeff, msg )
       CALL display_message( routine_name, 'FILE: '//trim(filename)//'; '//trim(msg), information )
     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
       CALL irwatercoeff_destroy( irwatercoeff )
       err_stat = failure
       CALL display_message( routine_name, msg, err_stat )
     END SUBROUTINE read_cleanup

  END FUNCTION irwatercoeff_readfile


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       IRwaterCoeff_WriteFile
!
! PURPOSE:
!       Function to write IRwaterCoeff object container files.
!
! CALLING SEQUENCE:
!       Error_Status = IRwaterCoeff_WriteFile( &
!                        IRwaterCoeff       , &
!                        Filename           , &
!                        No_Close = No_Close, &
!                        Quiet    = Quiet   , &
!                        Title    = Title   , &
!                        History  = History , &
!                        Comment  = Comment   )
!
! OBJECTS:
!       IRwaterCoeff:   Object containing the data to write to file.
!                       UNITS:      N/A
!                       TYPE:       IRwaterCoeff_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
! INPUTS:
!       Filename:       Character string specifying the name of the
!                       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 IRwaterCoeff 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
!
!       Title:          Character string containing a succinct description
!                       of what is in the dataset.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN), OPTIONAL
!
!       History:        Character string containing dataset creation
!                       history.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN), OPTIONAL
!
!       Comment:        Character string containing any comments about
!                       the dataset.
!                       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.
!                       If == SUCCESS, the file write was successful
!                          == FAILURE, an unrecoverable error occurred.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION irwatercoeff_writefile( &
    IRwaterCoeff, &  ! 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(irwatercoeff_type), INTENT(IN) :: irwatercoeff
    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 = 'IRwaterCoeff_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 there is data to write
    IF ( .NOT. irwatercoeff_associated( irwatercoeff ) ) THEN
      msg = 'IRwaterCoeff object is empty.'
      CALL write_cleanup(); RETURN
    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 ) &
      irwatercoeff%Release, &
      irwatercoeff%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 ) &
      irwatercoeff%n_Angles     , &
      irwatercoeff%n_Frequencies, &
      irwatercoeff%n_Wind_Speeds
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing dimension values to '//trim(filename)//' - '//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 coefficient data
    ! ...Write the dimensional vectors
    WRITE( fid, iostat=io_stat, iomsg=io_msg ) &
      irwatercoeff%Angle     , &
      irwatercoeff%Frequency , &
      irwatercoeff%Wind_Speed
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing dimensional vectors - '//trim(io_msg)
      CALL write_cleanup(); RETURN
    END IF
    ! ...Write the emissivity data
    WRITE( fid, iostat=io_stat, iomsg=io_msg ) &
      irwatercoeff%Emissivity
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing emissivity data - '//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


    ! Output an info message
     IF ( noisy ) THEN
       CALL irwatercoeff_info( irwatercoeff, msg )
       CALL display_message( routine_name, 'FILE: '//trim(filename)//'; '//trim(msg), information )
     END IF

   CONTAINS
   
     SUBROUTINE write_cleanup()
       IF ( file_open(filename) ) THEN
         CLOSE( fid, status=write_error_status, 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 write_cleanup

  END FUNCTION irwatercoeff_writefile


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

!------------------------------------------------------------------------------
!
! NAME:
!       IRwaterCoeff_Equal
!
! PURPOSE:
!       Elemental function to test the equality of two IRwaterCoeff objects.
!       Used in OPERATOR(==) interface block.
!
! CALLING SEQUENCE:
!       is_equal = IRwaterCoeff_Equal( x, y )
!
!         or
!
!       IF ( x == y ) THEN
!         ...
!       END IF
!
! OBJECTS:
!       x, y:          Two IRwaterCoeff objects to be compared.
!                      UNITS:      N/A
!                      TYPE:       IRwaterCoeff_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       is_equal:      Logical value indicating whether the inputs are equal.
!                      UNITS:      N/A
!                      TYPE:       LOGICAL
!                      DIMENSION:  Same as inputs.
!
!------------------------------------------------------------------------------

  ELEMENTAL FUNCTION irwatercoeff_equal( x, y ) RESULT( is_equal )
    TYPE(irwatercoeff_type), INTENT(IN) :: x, y
    LOGICAL :: is_equal

    ! Set up
    is_equal = .false.
   
    ! Check the object association status
    IF ( (.NOT. irwatercoeff_associated(x)) .OR. &
         (.NOT. irwatercoeff_associated(y))      ) RETURN


    ! Check contents
    ! ...Release/version info
    IF ( (x%Release /= y%Release) .OR. &
         (x%Version /= y%Version) ) RETURN
    ! ...Dimensions
    IF ( (x%n_Angles      /= y%n_Angles      ) .OR. &
         (x%n_Frequencies /= y%n_Frequencies ) .OR. &
         (x%n_Wind_Speeds /= y%n_Wind_Speeds ) ) RETURN
    ! ...Arrays
    IF ( all(x%Angle      .equalto. y%Angle      ) .AND. &
         all(x%Frequency  .equalto. y%Frequency  ) .AND. &
         all(x%Wind_Speed .equalto. y%Wind_Speed ) .AND. &
         all(x%Emissivity .equalto. y%Emissivity ) ) &
      is_equal = .true.
    
  END FUNCTION irwatercoeff_equal

END MODULE irwatercoeff_define