!
! CRTM_Surface_Define
!
! Module defining the CRTM Surface structure and containing routines
! to manipulate it.
!
!
! CREATION HISTORY:
!       Written by:  Yong Han,       yong.han@noaa.gov
!                    Quanhua Liu,    quanhua.liu@noaa.gov
!                    Paul van Delst, paul.vandelst@noaa.gov
!                    07-May-2004
!

MODULE CRTM_Surface_Define

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE Type_Kinds            , ONLY: fp
  USE Message_Handler       , ONLY: SUCCESS, FAILURE, WARNING, INFORMATION, Display_Message
  USE Compare_Float_Numbers , ONLY: DEFAULT_N_SIGFIG, &
                                    OPERATOR(.EqualTo.), &
                                    Compares_Within_Tolerance
  USE File_Utility          , ONLY: File_Open, File_Exists
  USE Binary_File_Utility   , ONLY: Open_Binary_File      , &
                                    WriteGAtts_Binary_File, &
                                    ReadGAtts_Binary_File
  USE CRTM_SensorData_Define, ONLY: CRTM_SensorData_type, &
                                    OPERATOR(==), &
                                    OPERATOR(+), &
                                    OPERATOR(-), &
                                    CRTM_SensorData_Associated, &
                                    CRTM_SensorData_Destroy, &
                                    CRTM_SensorData_Create, &
                                    CRTM_SensorData_Zero, &
                                    CRTM_SensorData_IsValid, &
                                    CRTM_SensorData_Inspect, &
                                    CRTM_SensorData_DefineVersion, &
                                    CRTM_SensorData_Compare, &
                                    CRTM_SensorData_ReadFile, &
                                    CRTM_SensorData_WriteFile
  USE CRTM_Land_Parameters,   ONLY: N_VALID_SOIL_TYPES, &
                                    N_VALID_VEGETATION_TYPES
  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE
  ! Operators
  PUBLIC :: OPERATOR(==)
  PUBLIC :: OPERATOR(+)
  PUBLIC :: OPERATOR(-)
  ! SensorData enitities
  ! ...Structures
  PUBLIC :: CRTM_SensorData_type
  ! ...Procedures
  PUBLIC :: CRTM_SensorData_Associated
  PUBLIC :: CRTM_SensorData_Destroy
  PUBLIC :: CRTM_SensorData_Create
  PUBLIC :: CRTM_SensorData_Zero
  PUBLIC :: CRTM_SensorData_IsValid
  PUBLIC :: CRTM_SensorData_Inspect
  PUBLIC :: CRTM_SensorData_DefineVersion
  PUBLIC :: CRTM_SensorData_Compare
  ! Surface entities
  ! ...Gross surface parameters
  PUBLIC :: INVALID_SURFACE
  PUBLIC :: LAND_SURFACE
  PUBLIC :: WATER_SURFACE
  PUBLIC :: SNOW_SURFACE
  PUBLIC :: ICE_SURFACE
  PUBLIC :: N_VALID_SURFACE_TYPES
  PUBLIC :: SURFACE_TYPE_NAME
  ! ...Structures
  PUBLIC :: CRTM_Surface_type
  ! ...Procedures
  PUBLIC :: CRTM_Surface_Associated
  PUBLIC :: CRTM_Surface_Destroy
  PUBLIC :: CRTM_Surface_Create
  PUBLIC :: CRTM_Surface_Zero
  PUBLIC :: CRTM_Surface_IsValid
  PUBLIC :: CRTM_Surface_Inspect
  PUBLIC :: CRTM_Surface_IsCoverageValid
  PUBLIC :: CRTM_Surface_CoverageType
  PUBLIC :: CRTM_Surface_DefineVersion
  PUBLIC :: CRTM_Surface_Compare
  PUBLIC :: CRTM_Surface_InquireFile
  PUBLIC :: CRTM_Surface_ReadFile
  PUBLIC :: CRTM_Surface_WriteFile


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

  INTERFACE OPERATOR(+)
    MODULE PROCEDURE CRTM_Surface_Add
  END INTERFACE OPERATOR(+)

  INTERFACE OPERATOR(-)
    MODULE PROCEDURE CRTM_Surface_Subtract
  END INTERFACE OPERATOR(-)

  INTERFACE CRTM_Surface_ReadFile
    MODULE PROCEDURE Read_Surface_Rank1
    MODULE PROCEDURE Read_Surface_Rank2
  END INTERFACE CRTM_Surface_ReadFile

  INTERFACE CRTM_Surface_WriteFile
    MODULE PROCEDURE Write_Surface_Rank1
    MODULE PROCEDURE Write_Surface_Rank2
  END INTERFACE CRTM_Surface_WriteFile


  ! -----------------
  ! Module parameters
  ! -----------------
  CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = &
  '$Id: CRTM_Surface_Define.f90 29405 2013-06-20 20:19:52Z paul.vandelst@noaa.gov $'
  ! Literal constants
  REAL(fp), PARAMETER :: ZERO = 0.0_fp
  REAL(fp), PARAMETER :: ONE  = 1.0_fp
  ! Message string length
  INTEGER, PARAMETER :: ML = 256
  ! File status on close after write error
  CHARACTER(*), PARAMETER :: WRITE_ERROR_STATUS = 'DELETE'

  ! The gross surface types. These are used for
  ! cross-checking with the coverage fractions
  ! of each gross surface types.
  INTEGER, PARAMETER :: INVALID_SURFACE = 0
  INTEGER, PARAMETER :: LAND_SURFACE    = 1
  INTEGER, PARAMETER :: WATER_SURFACE   = 2
  INTEGER, PARAMETER :: SNOW_SURFACE    = 4
  INTEGER, PARAMETER :: ICE_SURFACE     = 8
  INTEGER, PARAMETER :: N_VALID_SURFACE_TYPES = LAND_SURFACE  + &
                                                WATER_SURFACE + &
                                                SNOW_SURFACE  + &
                                                ICE_SURFACE
  CHARACTER(*), PARAMETER, DIMENSION( 0:N_VALID_SURFACE_TYPES ) :: &
    SURFACE_TYPE_NAME = (/ 'Invalid surface type     ', &
                           'Land                     ', &
                           'Water                    ', &
                           'Land + water             ', &
                           'Snow                     ', &
                           'Land + snow              ', &
                           'Water + snow             ', &
                           'Land + water + snow      ', &
                           'Ice                      ', &
                           'Land + ice               ', &
                           'Water + ice              ', &
                           'Land + water + ice       ', &
                           'Snow + ice               ', &
                           'Land + snow + ice        ', &
                           'Water + snow + ice       ', &
                           'Land + water + snow + ice' /)
  ! Default value parameters
  ! ...Land surface type data
  INTEGER,  PARAMETER :: DEFAULT_LAND_TYPE             = 1         ! First item in list
  REAL(fp), PARAMETER :: DEFAULT_LAND_TEMPERATURE      = 283.0_fp  ! K
  REAL(fp), PARAMETER :: DEFAULT_SOIL_MOISTURE_CONTENT = 0.05_fp   ! g/cm^3
  REAL(fp), PARAMETER :: DEFAULT_CANOPY_WATER_CONTENT  = 0.05_fp   ! g/cm^3
  REAL(fp), PARAMETER :: DEFAULT_VEGETATION_FRACTION   = 0.3_fp    ! 30%
  REAL(fp), PARAMETER :: DEFAULT_SOIL_TEMPERATURE      = 283.0_fp  ! K
  REAL(fp), PARAMETER :: DEFAULT_LAI                   = 3.5
  INTEGER,  PARAMETER :: DEFAULT_SOIL_TYPE             = 1         ! First item in list
  INTEGER,  PARAMETER :: DEFAULT_VEGETATION_TYPE       = 1         ! First item in list
  ! ...Water type data
  INTEGER,  PARAMETER :: DEFAULT_WATER_TYPE        = 1          ! First item in list
  REAL(fp), PARAMETER :: DEFAULT_WATER_TEMPERATURE = 283.0_fp   ! K
  REAL(fp), PARAMETER :: DEFAULT_WIND_SPEED        = 5.0_fp     ! m/s
  REAL(fp), PARAMETER :: DEFAULT_WIND_DIRECTION    = 0.0_fp     ! North
  REAL(fp), PARAMETER :: DEFAULT_SALINITY          = 33.0_fp    ! ppmv
  ! ...Snow surface type data
  INTEGER,  PARAMETER :: DEFAULT_SNOW_TYPE        = 1          ! First item in list
  REAL(fp), PARAMETER :: DEFAULT_SNOW_TEMPERATURE = 263.0_fp   ! K
  REAL(fp), PARAMETER :: DEFAULT_SNOW_DEPTH       = 50.0_fp    ! mm
  REAL(fp), PARAMETER :: DEFAULT_SNOW_DENSITY     = 0.2_fp     ! g/cm^3
  REAL(fp), PARAMETER :: DEFAULT_SNOW_GRAIN_SIZE  = 2.0_fp     ! mm
  ! ...Ice surface type data
  INTEGER,  PARAMETER :: DEFAULT_ICE_TYPE        = 1         ! First item in list
  REAL(fp), PARAMETER :: DEFAULT_ICE_TEMPERATURE = 263.0_fp  ! K
  REAL(fp), PARAMETER :: DEFAULT_ICE_THICKNESS   = 10.0_fp   ! mm
  REAL(fp), PARAMETER :: DEFAULT_ICE_DENSITY     = 0.9_fp    ! g/cm^3
  REAL(fp), PARAMETER :: DEFAULT_ICE_ROUGHNESS   = ZERO


  ! ----------------------------
  ! Surface structure definition
  ! ----------------------------
  !:tdoc+:
  TYPE :: CRTM_Surface_type
    ! Allocation indicator
    LOGICAL :: Is_Allocated = .TRUE.  ! Placeholder for future expansion
    ! Dimension values
    ! ...None yet
    ! Gross type of surface determined by coverage
    REAL(fp) :: Land_Coverage  = ZERO
    REAL(fp) :: Water_Coverage = ZERO
    REAL(fp) :: Snow_Coverage  = ZERO
    REAL(fp) :: Ice_Coverage   = ZERO
    ! Land surface type data
    INTEGER  :: Land_Type             = DEFAULT_LAND_TYPE
    REAL(fp) :: Land_Temperature      = DEFAULT_LAND_TEMPERATURE
    REAL(fp) :: Soil_Moisture_Content = DEFAULT_SOIL_MOISTURE_CONTENT
    REAL(fp) :: Canopy_Water_Content  = DEFAULT_CANOPY_WATER_CONTENT
    REAL(fp) :: Vegetation_Fraction   = DEFAULT_VEGETATION_FRACTION
    REAL(fp) :: Soil_Temperature      = DEFAULT_SOIL_TEMPERATURE
    REAL(fp) :: LAI                   = DEFAULT_LAI
    INTEGER  :: Soil_Type             = DEFAULT_SOIL_TYPE
    INTEGER  :: Vegetation_Type       = DEFAULT_VEGETATION_TYPE
    ! Water type data
    INTEGER  :: Water_Type        = DEFAULT_WATER_TYPE
    REAL(fp) :: Water_Temperature = DEFAULT_WATER_TEMPERATURE
    REAL(fp) :: Wind_Speed        = DEFAULT_WIND_SPEED
    REAL(fp) :: Wind_Direction    = DEFAULT_WIND_DIRECTION
    REAL(fp) :: Salinity          = DEFAULT_SALINITY
    ! Snow surface type data
    INTEGER  :: Snow_Type        = DEFAULT_SNOW_TYPE
    REAL(fp) :: Snow_Temperature = DEFAULT_SNOW_TEMPERATURE
    REAL(fp) :: Snow_Depth       = DEFAULT_SNOW_DEPTH
    REAL(fp) :: Snow_Density     = DEFAULT_SNOW_DENSITY
    REAL(fp) :: Snow_Grain_Size  = DEFAULT_SNOW_GRAIN_SIZE
    ! Ice surface type data
    INTEGER  :: Ice_Type        = DEFAULT_ICE_TYPE
    REAL(fp) :: Ice_Temperature = DEFAULT_ICE_TEMPERATURE
    REAL(fp) :: Ice_Thickness   = DEFAULT_ICE_THICKNESS
    REAL(fp) :: Ice_Density     = DEFAULT_ICE_DENSITY
    REAL(fp) :: Ice_Roughness   = DEFAULT_ICE_ROUGHNESS
    ! SensorData containing channel brightness temperatures
    TYPE(CRTM_SensorData_type) :: SensorData
  END TYPE CRTM_Surface_type
  !:tdoc-:


CONTAINS


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

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Surface_Associated
!
! PURPOSE:
!       Elemental function to test the status of the allocatable components
!       of a CRTM Surface object.
!
! CALLING SEQUENCE:
!       Status = CRTM_Surface_Associated( Sfc )
!
! OBJECTS:
!       Sfc:       Surface structure which is to have its member's
!                  status tested.
!                  UNITS:      N/A
!                  TYPE:       CRTM_Surface_type
!                  DIMENSION:  Scalar or any rank
!                  ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       Status:    The return value is a logical value indicating the
!                  status of the Surface members.
!                    .TRUE.  - if the array components are allocated.
!                    .FALSE. - if the array components are not allocated.
!                  UNITS:      N/A
!                  TYPE:       LOGICAL
!                  DIMENSION:  Same as input
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION CRTM_Surface_Associated( Sfc ) RESULT( Status )
    TYPE(CRTM_Surface_type), INTENT(IN) :: Sfc
    LOGICAL :: Status

    Status = Sfc%Is_Allocated
    ! ...SensorData
    Status = Status .AND. CRTM_SensorData_Associated(Sfc%SensorData)

  END FUNCTION CRTM_Surface_Associated


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

  ELEMENTAL SUBROUTINE CRTM_Surface_Destroy( Sfc )
    TYPE(CRTM_Surface_type), INTENT(OUT) :: Sfc
    Sfc%Is_Allocated = .TRUE.  ! Placeholder for future expansion
  END SUBROUTINE CRTM_Surface_Destroy


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Surface_Create
!
! PURPOSE:
!       Elemental subroutine to create an instance of the CRTM Surface object.
!
! CALLING SEQUENCE:
!       CALL CRTM_Surface_Create( Sfc       , &
!                                 n_Channels  )
!
! OBJECTS:
!       Sfc:          Surface structure.
!                     UNITS:      N/A
!                     TYPE:       CRTM_Surface_type
!                     DIMENSION:  Scalar or any rank
!                     ATTRIBUTES: INTENT(OUT)
!
! INPUT ARGUMENTS:
!       n_Channels:   Number of channels dimension of SensorData
!                     substructure
!                     ** Note: Can be = 0 (i.e. no sensor data). **
!                     UNITS:      N/A
!                     TYPE:       INTEGER
!                     DIMENSION:  Same as Surface object
!                     ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE CRTM_Surface_Create( &
    Sfc       , &  ! Output
    n_Channels  )  ! Input
    ! Arguments
    TYPE(CRTM_Surface_type), INTENT(OUT) :: Sfc
    INTEGER                , INTENT(IN)  :: n_Channels

    ! Check input
    IF ( n_Channels < 0 ) RETURN

    ! Perform the substructure allocation
    ! ...SensorData
    IF ( n_Channels > 0 ) CALL CRTM_SensorData_Create( Sfc%SensorData, n_Channels )

    ! Set allocation indicator
    Sfc%Is_Allocated = .TRUE.

  END SUBROUTINE CRTM_Surface_Create


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Surface_Zero
!
! PURPOSE:
!       Elemental subroutine to zero out the data arrays
!       in a CRTM Surface object.
!
! CALLING SEQUENCE:
!       CALL CRTM_Surface_Zero( Sfc )
!
! OUTPUT ARGUMENTS:
!       Sfc:          CRTM Surface structure in which the data arrays
!                     are to be zeroed out.
!                     UNITS:      N/A
!                     TYPE:       CRTM_Surface_type
!                     DIMENSION:  Scalar or any rank
!                     ATTRIBUTES: INTENT(IN OUT)
!
! COMMENTS:
!       - The various surface type indicator flags are
!         *NOT* reset in this routine.
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE CRTM_Surface_Zero( Sfc )
    TYPE(CRTM_Surface_type), INTENT(IN OUT) :: Sfc

    ! Zero the components
    ! ...Coverage fractions
    Sfc%Land_Coverage  = ZERO
    Sfc%Water_Coverage = ZERO
    Sfc%Snow_Coverage  = ZERO
    Sfc%Ice_Coverage   = ZERO
    ! ...The various surface types
    CALL CRTM_LandSurface_Zero(sfc)
    CALL CRTM_WaterSurface_Zero(sfc)
    CALL CRTM_SnowSurface_Zero(sfc)
    CALL CRTM_IceSurface_Zero(sfc)

    ! Reset the structure components
    IF ( CRTM_SensorData_Associated(Sfc%SensorData) ) CALL CRTM_SensorData_Zero(Sfc%SensorData)

  END SUBROUTINE CRTM_Surface_Zero


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

  FUNCTION CRTM_Surface_IsValid( Sfc ) RESULT( IsValid )
    TYPE(CRTM_Surface_type), INTENT(IN) :: Sfc
    LOGICAL :: IsValid
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_Surface_IsValid'
    CHARACTER(ML) :: msg

    ! Check the gross surface type indicators
    IsValid = CRTM_Surface_IsCoverageValid(sfc)
    IF ( .NOT. IsValid ) THEN
      msg = 'Invalid surface coverage fraction(s) found'
      CALL Display_Message( ROUTINE_NAME, TRIM(msg), INFORMATION )
    ENDIF

    ! Check the various surface types
    IF ( Sfc%Land_Coverage  > ZERO ) IsValid = CRTM_LandSurface_IsValid(sfc)  .AND. IsValid
    IF ( Sfc%Water_Coverage > ZERO ) IsValid = CRTM_WaterSurface_IsValid(sfc) .AND. IsValid
    IF ( Sfc%Snow_Coverage  > ZERO ) IsValid = CRTM_SnowSurface_IsValid(sfc)  .AND. IsValid
    IF ( Sfc%Ice_Coverage   > ZERO ) IsValid = CRTM_IceSurface_IsValid(sfc)   .AND. IsValid

    ! Structure components
    IF ( CRTM_SensorData_Associated(Sfc%SensorData) ) &
      IsValid = CRTM_SensorData_IsValid( Sfc%SensorData ) .AND. IsValid

  END FUNCTION CRTM_Surface_IsValid



!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Surface_Inspect
!
! PURPOSE:
!       Subroutine to print the contents of a CRTM Surface object to stdout.
!
! CALLING SEQUENCE:
!       CALL CRTM_Surface_Inspect( Sfc )
!
! INPUTS:
!       Sfc:  CRTM Surface object to display.
!             UNITS:      N/A
!             TYPE:       CRTM_Surface_type
!             DIMENSION:  Scalar
!             ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE CRTM_Surface_Inspect( Sfc )
    TYPE(CRTM_Surface_type), INTENT(IN) :: Sfc
    WRITE(*, '(1x,"Surface OBJECT")')
    ! Surface coverage
    WRITE(*, '(3x,"Land Coverage :",1x,f6.3)') Sfc%Land_Coverage
    WRITE(*, '(3x,"Water Coverage:",1x,f6.3)') Sfc%Water_Coverage
    WRITE(*, '(3x,"Snow Coverage :",1x,f6.3)') Sfc%Snow_Coverage
    WRITE(*, '(3x,"Ice Coverage  :",1x,f6.3)') Sfc%Ice_Coverage
    ! The various surface types
    IF ( sfc%Land_Coverage  > ZERO ) CALL CRTM_LandSurface_Inspect(sfc)
    IF ( sfc%Water_Coverage > ZERO ) CALL CRTM_WaterSurface_Inspect(sfc)
    IF ( sfc%Snow_Coverage  > ZERO ) CALL CRTM_SnowSurface_Inspect(sfc)
    IF ( sfc%Ice_Coverage   > ZERO ) CALL CRTM_IceSurface_Inspect(sfc)
    ! SensorData information
    IF ( CRTM_SensorData_Associated(Sfc%SensorData) ) &
      CALL CRTM_SensorData_Inspect(Sfc%SensorData)

  END SUBROUTINE CRTM_Surface_Inspect


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Surface_IsCoverageValid
!
! PURPOSE:
!       Function to determine if the coverage fractions are valid
!       for a CRTM Surface object.
!
! CALLING SEQUENCE:
!       result = CRTM_Surface_IsCoverageValid( Sfc )
!
! OBJECTS:
!       Sfc:       CRTM Surface object which is to have its
!                  coverage fractions checked.
!                  UNITS:      N/A
!                  TYPE:       CRTM_Surface_type
!                  DIMENSION:  Scalar
!                  ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       result:    Logical variable indicating whether or not the input
!                  passed the check.
!                  If == .FALSE., Surface object coverage fractions are invalid.
!                     == .TRUE.,  Surface object coverage fractions are valid.
!                  UNITS:      N/A
!                  TYPE:       LOGICAL
!                  DIMENSION:  Scalar
!
!:sdoc-:
!--------------------------------------------------------------------------------

  FUNCTION CRTM_Surface_IsCoverageValid( Sfc ) RESULT( IsValid )
    TYPE(CRTM_Surface_type), INTENT(IN) :: Sfc
    LOGICAL :: IsValid
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_Surface_IsCoverageValid'
    REAL(fp)    , PARAMETER :: TOLERANCE = 1.0e-10_fp
    CHARACTER(ML) :: msg
    REAL(fp) :: Total_Coverage

    ! Compute the total coverage
    Total_Coverage = Sfc%Land_Coverage + Sfc%Water_Coverage + &
                     Sfc%Snow_Coverage + Sfc%Ice_Coverage

    ! Check coverage fractions for < 0 and > 1
    IsValid = IsCoverageValid(Sfc%Land_Coverage, 'Land')
    IsValid = IsValid .AND. IsCoverageValid(Sfc%Water_Coverage, 'Water')
    IsValid = IsValid .AND. IsCoverageValid(Sfc%Snow_Coverage, 'Snow')
    IsValid = IsValid .AND. IsCoverageValid(Sfc%Ice_Coverage, 'Ice')

    ! Check total coverage sums to 1
    IF ( ABS(Total_Coverage-ONE) > TOLERANCE ) THEN
      WRITE( msg,'("Total coverage fraction does not sum to 1 +/- ",es13.6)' ) TOLERANCE
      CALL Display_Message( ROUTINE_NAME,msg,INFORMATION )
      IsValid = .FALSE.
    END IF

  CONTAINS

    FUNCTION IsCoverageValid( Coverage, Name ) RESULT( IsValid )
      REAL(fp)    , INTENT(IN) :: Coverage
      CHARACTER(*), INTENT(IN) :: Name
      LOGICAL :: IsValid

      IsValid = .TRUE.

      ! Check for coverage < -TOLERANCE
      IF ( Coverage < -TOLERANCE ) THEN
        WRITE( msg,'(a," coverage fraction is < ",es13.6)' ) TRIM(Name), -TOLERANCE
        CALL Display_Message( ROUTINE_NAME,msg,INFORMATION )
        IsValid = .FALSE.
      END IF

      ! Check for coverage > 1+TOLERANCE
      IF ( Coverage > ONE+TOLERANCE ) THEN
        WRITE( msg,'(a," coverage fraction is > 1 +",es13.6)' ) TRIM(Name), TOLERANCE
        CALL Display_Message( ROUTINE_NAME,msg,INFORMATION )
        IsValid = .FALSE.
      END IF

    END FUNCTION IsCoverageValid

  END FUNCTION CRTM_Surface_IsCoverageValid



!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Surface_CoverageType
!
! PURPOSE:
!       Elemental function to return the gross surface type based on coverage.
!
! CALLING SEQUENCE:
!       type = CRTM_Surface_CoverageType( sfc )
!
! INPUTS:
!       Sfc:  CRTM Surface object for which the gross surface type is required.
!             UNITS:      N/A
!             TYPE:       CRTM_Surface_type
!             DIMENSION:  Scalar or any rank
!             ATTRIBUTES: INTENT(IN)
!
! FUNCTION:
!       type: Surface type indicator for the passed CRTM Surface object.
!             UNITS:      N/A
!             TYPE:       INTEGER
!             DIMENSION:  Same as input
!
! COMMENTS:
!       For a scalar Surface object, this function result can be used to
!       determine what gross surface types are included by using it to
!       index the SURFACE_TYPE_NAME parameter arrays, e.g.
!
!         WRITE(*,*) SURFACE_TYPE_NAME(CRTM_Surface_CoverageType(sfc))
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION CRTM_Surface_CoverageType( sfc ) RESULT( Coverage_Type )
    TYPE(CRTM_Surface_type), INTENT(IN) :: sfc
    INTEGER :: Coverage_Type
    Coverage_Type = 0
    IF ( sfc%Land_Coverage  > ZERO ) Coverage_Type = LAND_SURFACE
    IF ( sfc%Water_Coverage > ZERO ) Coverage_Type = Coverage_Type + WATER_SURFACE
    IF ( sfc%Snow_Coverage  > ZERO ) Coverage_Type = Coverage_Type + SNOW_SURFACE
    IF ( sfc%Ice_Coverage   > ZERO ) Coverage_Type = Coverage_Type + ICE_SURFACE
  END FUNCTION CRTM_Surface_CoverageType


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

  SUBROUTINE CRTM_Surface_DefineVersion( Id )
    CHARACTER(*), INTENT(OUT) :: Id
    Id = MODULE_VERSION_ID
  END SUBROUTINE CRTM_Surface_DefineVersion


!------------------------------------------------------------------------------
!:sdoc+:
! NAME:
!       CRTM_Surface_Compare
!
! PURPOSE:
!       Elemental function to compare two CRTM_Surface objects to within
!       a user specified number of significant figures.
!
! CALLING SEQUENCE:
!       is_comparable = CRTM_Surface_Compare( x, y, n_SigFig=n_SigFig )
!
! OBJECTS:
!       x, y:          Two CRTM Surface objects to be compared.
!                      UNITS:      N/A
!                      TYPE:       CRTM_Surface_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!       n_SigFig:      Number of significant figure to compare floating point
!                      components.
!                      UNITS:      N/A
!                      TYPE:       INTEGER
!                      DIMENSION:  Scalar or same as input
!                      ATTRIBUTES: INTENT(IN), OPTIONAL
!
! FUNCTION RESULT:
!       is_equal:      Logical value indicating whether the inputs are equal.
!                      UNITS:      N/A
!                      TYPE:       LOGICAL
!                      DIMENSION:  Same as inputs.
!:sdoc-:
!------------------------------------------------------------------------------

  ELEMENTAL FUNCTION CRTM_Surface_Compare( &
    x, &
    y, &
    n_SigFig ) &
  RESULT( is_comparable )
    TYPE(CRTM_Surface_type), INTENT(IN) :: x, y
    INTEGER,       OPTIONAL, INTENT(IN) :: n_SigFig
    LOGICAL :: is_comparable
    ! Variables
    INTEGER :: n

    ! Set up
    is_comparable = .FALSE.
    IF ( PRESENT(n_SigFig) ) THEN
      n = ABS(n_SigFig)
    ELSE
      n = DEFAULT_N_SIGFIG
    END IF

    ! Compare gross surface type coverage
    IF ( (.NOT. Compares_Within_Tolerance(x%Land_Coverage ,y%Land_Coverage ,n)) .OR. &
         (.NOT. Compares_Within_Tolerance(x%Water_Coverage,y%Water_Coverage,n)) .OR. &
         (.NOT. Compares_Within_Tolerance(x%Snow_Coverage ,y%Snow_Coverage ,n)) .OR. &
         (.NOT. Compares_Within_Tolerance(x%Ice_Coverage  ,y%Ice_Coverage  ,n)) ) RETURN

    ! Compare the land surface type data
    IF ( .NOT. CRTM_LandSurface_Compare(x,y,n_SigFig=n) ) RETURN

    ! Compare the water surface type data
    IF ( .NOT. CRTM_WaterSurface_Compare(x,y,n_SigFig=n) ) RETURN

    ! Compare the snow surface type data
    IF ( .NOT. CRTM_SnowSurface_Compare(x,y,n_SigFig=n) ) RETURN

    ! Compare the ice surface type data
    IF ( .NOT. CRTM_IceSurface_Compare(x,y,n_SigFig=n) ) RETURN

    ! Check the SensorData
    IF ( CRTM_SensorData_Associated(x%SensorData) .AND. &
         CRTM_SensorData_Associated(y%SensorData) ) THEN
      IF ( .NOT. CRTM_SensorData_Compare(x%SensorData,y%SensorData,n_SigFig=n) ) RETURN
    END IF

    ! If we get here, the structures are comparable
    is_comparable = .TRUE.

  END FUNCTION CRTM_Surface_Compare


!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Surface_InquireFile
!
! PURPOSE:
!       Function to inquire CRTM Surface object files.
!
! CALLING SEQUENCE:
!       Error_Status = CRTM_Surface_InquireFile( Filename               , &
!                                                n_Channels = n_Channels, &
!                                                n_Profiles = n_Profiles  )
!
! INPUTS:
!       Filename:       Character string specifying the name of a
!                       CRTM Surface data file to read.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
! OPTIONAL OUTPUTS:
!       n_Channels:     The number of spectral channels for which there is
!                       data in the file. Note that this value will always
!                       be 0 for a profile-only dataset-- it only has meaning
!                       for K-matrix data.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: OPTIONAL, INTENT(OUT)
!
!       n_Profiles:     The number of profiles in the data file.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: OPTIONAL, INTENT(OUT)
!
! FUNCTION RESULT:
!       Error_Status:   The return value is an integer defining the error status.
!                       The error codes are defined in the Message_Handler module.
!                       If == SUCCESS, the file inquire was successful
!                          == FAILURE, an unrecoverable error occurred.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION CRTM_Surface_InquireFile( &
    Filename   , &  ! Input
    n_Channels , &  ! Optional output
    n_Profiles ) &  ! Optional output
  RESULT( err_stat )
    ! Arguments
    CHARACTER(*),           INTENT(IN)  :: Filename
    INTEGER     , OPTIONAL, INTENT(OUT) :: n_Channels
    INTEGER     , OPTIONAL, INTENT(OUT) :: n_Profiles
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_Surface_InquireFile'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    INTEGER :: io_stat
    INTEGER :: fid
    INTEGER :: l, m

    ! Set up
    err_stat = SUCCESS
    ! Check that the file exists
    IF ( .NOT. File_Exists( TRIM(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 number of channels,profiles
    READ( fid, IOSTAT=io_stat,IOMSG=io_msg ) l, m
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading dimensions from '//TRIM(Filename)//' - '//TRIM(io_msg)
      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

    ! Set the return arguments
    IF ( PRESENT(n_Channels) ) n_Channels = l
    IF ( PRESENT(n_Profiles) ) n_Profiles = m

  CONTAINS

    SUBROUTINE Inquire_CleanUp()
      IF ( File_Open(fid) ) THEN
        CLOSE( fid,IOSTAT=io_stat,IOMSG=io_msg )
        IF ( io_stat /= SUCCESS ) &
          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 Inquire_CleanUp

  END FUNCTION CRTM_Surface_InquireFile


!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Surface_ReadFile
!
! PURPOSE:
!       Function to read CRTM Surface object files.
!
! CALLING SEQUENCE:
!       Error_Status = CRTM_Surface_ReadFile( Filename               , &
!                                             Surface                , &
!                                             Quiet      = Quiet     , &
!                                             n_Channels = n_Channels, &
!                                             n_Profiles = n_Profiles  )
!
! INPUTS:
!       Filename:     Character string specifying the name of an
!                     Surface format data file to read.
!                     UNITS:      N/A
!                     TYPE:       CHARACTER(*)
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
!       Surface:      CRTM Surface object array containing the Surface
!                     data. Note the following meanings attributed to the
!                     dimensions of the object array:
!                     Rank-1: M profiles.
!                             Only profile data are to be read in. The file
!                             does not contain channel information. The
!                             dimension of the structure is understood to
!                             be the PROFILE dimension.
!                     Rank-2: L channels  x  M profiles
!                             Channel and profile data are to be read in.
!                             The file contains both channel and profile
!                             information. The first dimension of the
!                             structure is the CHANNEL dimension, the second
!                             is the PROFILE dimension. This is to allow
!                             K-matrix structures to be read in with the
!                             same function.
!                     UNITS:      N/A
!                     TYPE:       CRTM_Surface_type
!                     DIMENSION:  Rank-1 (M) or Rank-2 (L x M)
!                     ATTRIBUTES: INTENT(OUT)
!
! OPTIONAL INPUTS:
!       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:
!       n_Channels:   The number of channels for which data was read. Note that
!                     this value will always be 0 for a profile-only dataset--
!                     it only has meaning for K-matrix data.
!                     UNITS:      N/A
!                     TYPE:       INTEGER
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: OPTIONAL, INTENT(OUT)
!
!       n_Profiles:   The number of profiles for which data was read.
!                     UNITS:      N/A
!                     TYPE:       INTEGER
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: OPTIONAL, INTENT(OUT)
!
!
! FUNCTION RESULT:
!       Error_Status: The return value is an integer defining the error status.
!                     The error codes are defined in the Message_Handler module.
!                     If == SUCCESS, the file read was successful
!                        == FAILURE, an unrecoverable error occurred.
!                     UNITS:      N/A
!                     TYPE:       INTEGER
!                     DIMENSION:  Scalar
!
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION Read_Surface_Rank1( &
    Filename  , &  ! Input
    Surface   , &  ! Output
    Quiet     , &  ! Optional input
    n_Channels, &  ! Optional output
    n_Profiles, &  ! Optional output
    Debug     ) &  ! Optional input (Debug output control)
  RESULT( err_stat )
    ! Arguments
    CHARACTER(*),            INTENT(IN)  :: Filename
    TYPE(CRTM_Surface_type), INTENT(OUT) :: Surface(:)  ! M
    LOGICAL,       OPTIONAL, INTENT(IN)  :: Quiet
    INTEGER,       OPTIONAL, INTENT(OUT) :: n_Channels
    INTEGER,       OPTIONAL, INTENT(OUT) :: n_Profiles
    LOGICAL,       OPTIONAL, INTENT(IN)  :: Debug
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_Surface_ReadFile(M)'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    LOGICAL :: noisy
    INTEGER :: io_stat
    INTEGER :: fid
    INTEGER :: n_File_Channels, n_File_Profiles
    INTEGER :: m, n_Input_Profiles


    ! Set up
    err_stat = SUCCESS
    ! ...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 that the file exists
    IF ( .NOT. File_Exists( TRIM(Filename) ) ) THEN
      msg = 'File '//TRIM(Filename)//' not found.'
      CALL Read_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 Read_Cleanup(); RETURN
    END IF


    ! Read the dimensions
    READ( fid,IOSTAT=io_stat,IOMSG=io_msg ) n_File_Channels, n_File_Profiles
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading dimensions from '//TRIM(Filename)//' - '//TRIM(io_msg)
      CALL Read_Cleanup(); RETURN
    END IF
    ! ...Check that n_Channels is zero
    IF ( n_File_Channels /= 0 ) THEN
      msg = 'n_Channels dimensions in '//TRIM(Filename)//' is not zero for a rank-1 '//&
            '(i.e. profiles only) Surface read.'
      CALL Read_Cleanup(); RETURN
    END IF
    ! ...Check if n_Profiles in file is > size of output array
    n_Input_Profiles = SIZE(Surface)
    IF ( n_File_Profiles > n_Input_Profiles ) THEN
      WRITE( msg,'("Number of profiles, ",i0," > size of the output Surface", &
                  &" array, ",i0,". Only the first ",i0, &
                  &" profiles will be read.")' ) &
                  n_File_Profiles, n_Input_Profiles, n_Input_Profiles
      CALL Display_Message( ROUTINE_NAME, msg, WARNING )
    END IF
    n_Input_Profiles = MIN(n_Input_Profiles, n_File_Profiles)


    ! Loop over all the profiles
    Profile_Loop: DO m = 1, n_Input_Profiles
      err_stat = Read_Record( fid, Surface(m), &
                              Quiet = Quiet, &
                              Debug = Debug  )
      IF ( err_stat /= SUCCESS ) THEN
        WRITE( msg,'("Error reading Surface element (",i0,") from ",a)' ) m, TRIM(Filename)
        CALL Read_Cleanup(); RETURN
      END IF
    END DO Profile_Loop


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


    ! Set the return values
    IF ( PRESENT(n_Channels) ) n_Channels = 0
    IF ( PRESENT(n_Profiles) ) n_Profiles = n_Input_Profiles


    ! Output an info message
    IF ( noisy ) THEN
      WRITE( msg,'("Number of profiles read from ",a,": ",i0)' ) TRIM(Filename), n_Input_Profiles
      CALL Display_Message( ROUTINE_NAME, 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 CRTM_Surface_Destroy( Surface )
      err_stat = FAILURE
      CALL Display_Message( ROUTINE_NAME, msg, err_stat )
    END SUBROUTINE Read_CleanUp

  END FUNCTION Read_Surface_Rank1


  FUNCTION Read_Surface_Rank2( &
    Filename  , &  ! Input
    Surface   , &  ! Output
    Quiet     , &  ! Optional input
    n_Channels, &  ! Optional output
    n_Profiles, &  ! Optional output
    Debug     ) &  ! Optional input (Debug output control)
  RESULT( err_stat )
    ! Arguments
    CHARACTER(*),            INTENT(IN)  :: Filename
    TYPE(CRTM_Surface_type), INTENT(OUT) :: Surface(:,:)  ! L x M
    LOGICAL,       OPTIONAL, INTENT(IN)  :: Quiet
    INTEGER,       OPTIONAL, INTENT(OUT) :: n_Channels
    INTEGER,       OPTIONAL, INTENT(OUT) :: n_Profiles
    LOGICAL,       OPTIONAL, INTENT(IN)  :: Debug
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_Surface_ReadFile(L x M)'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    LOGICAL :: noisy
    INTEGER :: io_stat
    INTEGER :: fid
    INTEGER :: l, n_File_Channels, n_Input_Channels
    INTEGER :: m, n_File_Profiles, n_Input_Profiles


    ! Set up
    err_stat = SUCCESS
    ! ...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 that the file exists
    IF ( .NOT. File_Exists( TRIM(Filename) ) ) THEN
      msg = 'File '//TRIM(Filename)//' not found.'
      CALL Read_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 Read_Cleanup(); RETURN
    END IF


    ! Read the dimensions
    READ( fid,IOSTAT=io_stat,IOMSG=io_msg ) n_File_Channels, n_File_Profiles
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading n_Clouds data dimension from '//TRIM(Filename)//' - '//TRIM(io_msg)
      CALL Read_Cleanup(); RETURN
    END IF
    ! ...Check if n_Channels in file is > size of output array
    n_Input_Channels = SIZE(Surface,DIM=1)
    IF ( n_File_Channels > n_Input_Channels ) THEN
      WRITE( msg,'("Number of channels, ",i0," > size of the output Surface", &
                  &" array dimension, ",i0,". Only the first ",i0, &
                  &" channels will be read.")' ) &
                  n_File_Channels, n_Input_Channels, n_Input_Channels
      CALL Display_Message( ROUTINE_NAME, TRIM(msg), WARNING )
    END IF
    n_Input_Channels = MIN(n_Input_Channels, n_File_Channels)
    ! ...Check if n_Profiles in file is > size of output array
    n_Input_Profiles = SIZE(Surface,DIM=2)
    IF ( n_File_Profiles > n_Input_Profiles ) THEN
      WRITE( msg, '( "Number of profiles, ",i0," > size of the output Surface", &
                    &" array dimension, ",i0,". Only the first ",i0, &
                    &" profiles will be read.")' ) &
                    n_File_Profiles, n_Input_Profiles, n_Input_Profiles
      CALL Display_Message( ROUTINE_NAME, TRIM(msg), WARNING )
    END IF
    n_Input_Profiles = MIN(n_Input_Profiles, n_File_Profiles)


    ! Loop over all the profiles and channels
    Profile_Loop: DO m = 1, n_Input_Profiles
      Channel_Loop: DO l = 1, n_Input_Channels
        err_stat = Read_Record( fid, Surface(l,m), &
                                Quiet = Quiet, &
                                Debug = Debug )
        IF ( err_stat /= SUCCESS ) THEN
          WRITE( msg,'("Error reading Surface element (",i0,",",i0,") from ",a)' ) &
                 l, m, TRIM(Filename)
          CALL Read_Cleanup(); RETURN
        END IF
      END DO Channel_Loop
    END DO Profile_Loop


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


    ! Set the return values
    IF ( PRESENT(n_Channels) ) n_Channels = n_Input_Channels
    IF ( PRESENT(n_Profiles) ) n_Profiles = n_Input_Profiles


    ! Output an info message
    IF ( noisy ) THEN
      WRITE( msg,'("Number of channels and profiles read from ",a,": ",i0,1x,i0)' ) &
             TRIM(Filename), n_Input_Channels, n_Input_Profiles
      CALL Display_Message( ROUTINE_NAME, 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 CRTM_Surface_Destroy( Surface )
      err_stat = FAILURE
      CALL Display_Message( ROUTINE_NAME, msg, err_stat )
    END SUBROUTINE Read_CleanUp

  END FUNCTION Read_Surface_Rank2


!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Surface_WriteFile
!
! PURPOSE:
!       Function to write CRTM Surface object files.
!
! CALLING SEQUENCE:
!       Error_Status = CRTM_Surface_WriteFile( Filename     , &
!                                              Surface      , &
!                                              Quiet = Quiet  )
!
! INPUTS:
!       Filename:     Character string specifying the name of the
!                     Surface format data file to write.
!                     UNITS:      N/A
!                     TYPE:       CHARACTER(*)
!                     DIMENSION:  Scalar
!                     ATTRIBUTES: INTENT(IN)
!
!       Surface:      CRTM Surface object array containing the Surface
!                     data. Note the following meanings attributed to the
!                     dimensions of the Surface array:
!                     Rank-1: M profiles.
!                             Only profile data are to be read in. The file
!                             does not contain channel information. The
!                             dimension of the array is understood to
!                             be the PROFILE dimension.
!                     Rank-2: L channels  x  M profiles
!                             Channel and profile data are to be read in.
!                             The file contains both channel and profile
!                             information. The first dimension of the
!                             array is the CHANNEL dimension, the second
!                             is the PROFILE dimension. This is to allow
!                             K-matrix structures to be read in with the
!                             same function.
!                     UNITS:      N/A
!                     TYPE:       CRTM_Surface_type
!                     DIMENSION:  Rank-1 (M) or Rank-2 (L x M)
!                     ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!       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
!
! SIDE EFFECTS:
!       - If the output file already exists, it is overwritten.
!       - If an error occurs during *writing*, the output file is deleted before
!         returning to the calling routine.
!
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION Write_Surface_Rank1( &
    Filename, &  ! Input
    Surface , &  ! Input
    Quiet   , &  ! Optional input
    Debug   ) &  ! Optional input (Debug output control)
  RESULT( err_stat )
    ! Arguments
    CHARACTER(*),            INTENT(IN) :: Filename
    TYPE(CRTM_Surface_type), INTENT(IN) :: Surface(:)  ! M
    LOGICAL,       OPTIONAL, INTENT(IN) :: Quiet
    LOGICAL,       OPTIONAL, INTENT(IN) :: Debug
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_Surface_WriteFile(M)'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    LOGICAL :: noisy
    INTEGER :: io_stat
    INTEGER :: fid
    INTEGER :: m, n_Output_Profiles

    ! Setup
    err_stat = SUCCESS
    ! ...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
    ! Dimensions
    n_Output_Profiles = SIZE(Surface)


    ! Open the file
    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


    ! Write the dimensions
    WRITE( fid,IOSTAT=io_stat,IOMSG=io_msg ) 0, n_Output_Profiles
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing dimensions to '//TRIM(Filename)//'- '//TRIM(io_msg)
      CALL Write_Cleanup(); RETURN
    END IF


    ! Write the data
    Profile_Loop: DO m = 1, n_Output_Profiles
      err_stat = Write_Record( fid, Surface(m), &
                               Quiet = Quiet, &
                               Debug = Debug )
      IF ( err_stat /= SUCCESS ) THEN
        WRITE( msg,'("Error writing Surface element (",i0,") to ",a)' ) m, TRIM(Filename)
        CALL Write_Cleanup(); RETURN
      END IF
    END DO Profile_Loop


    ! Close the file (if error, no delete)
    CLOSE( fid,STATUS='KEEP',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


    ! Output an info message
    IF ( noisy ) THEN
      WRITE( msg,'("Number of profiles written to ",a,": ",i0)' ) &
             TRIM(Filename), n_Output_Profiles
      CALL Display_Message( ROUTINE_NAME, 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 deleting 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 Write_Surface_Rank1


  FUNCTION Write_Surface_Rank2( &
    Filename, &  ! Input
    Surface , &  ! Input
    Quiet   , &  ! Optional input
    Debug   ) &  ! Optional input (Debug output control)
  RESULT( err_stat )
    ! Arguments
    CHARACTER(*),            INTENT(IN)  :: Filename
    TYPE(CRTM_Surface_type), INTENT(IN)  :: Surface(:,:)  ! L x M
    LOGICAL,       OPTIONAL, INTENT(IN)  :: Quiet
    LOGICAL,       OPTIONAL, INTENT(IN)  :: Debug
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_Surface_WriteFile(L x M)'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    LOGICAL :: noisy
    INTEGER :: io_stat
    INTEGER :: fid
    INTEGER :: l, n_Output_Channels
    INTEGER :: m, n_Output_Profiles

    ! Set up
    err_stat = SUCCESS
    ! ...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
    ! Dimensions
    n_Output_Channels = SIZE(Surface,DIM=1)
    n_Output_Profiles = SIZE(Surface,DIM=2)


    ! Open the file
    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


    ! Write the dimensions
    WRITE( fid,IOSTAT=io_stat,IOMSG=io_msg ) n_Output_Channels, n_Output_Profiles
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing dimensions to '//TRIM(Filename)//'- '//TRIM(io_msg)
      CALL Write_Cleanup(); RETURN
    END IF


    ! Write the data
    Profile_Loop: DO m = 1, n_Output_Profiles
      Channel_Loop: DO l = 1, n_Output_Channels
        err_stat = Write_Record( fid, Surface(l,m), &
                                 Quiet = Quiet, &
                                 Debug = Debug )
        IF ( err_stat /= SUCCESS ) THEN
          WRITE( msg,'("Error writing Surface element (",i0,",",i0,") to ",a)' ) &
                 l, m, TRIM(Filename)
          CALL Write_Cleanup(); RETURN
        END IF
      END DO Channel_Loop
    END DO Profile_Loop


    ! Close the file (if error, no delete)
    CLOSE( fid,STATUS='KEEP',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


    ! Output an info message
    IF ( noisy ) THEN
      WRITE( msg,'("Number of channels and profiles written to ",a,": ",i0,1x,i0 )' ) &
             TRIM(Filename), n_Output_Channels, n_Output_Profiles
      CALL Display_Message( ROUTINE_NAME, 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 deleting 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 Write_Surface_Rank2



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

!--------------------------------------------------------------------------------
!
! NAME:
!       CRTM_Surface_Equal
!
! PURPOSE:
!       Elemental function to test the equality of two CRTM_Surface objects.
!       Used in OPERATOR(==) interface block.
!
! CALLING SEQUENCE:
!       is_equal = CRTM_Surface_Equal( x, y )
!
!         or
!
!       IF ( x == y ) THEN
!         ...
!       END IF
!
! OBJECTS:
!       x, y:          Two CRTM Surface objects to be compared.
!                      UNITS:      N/A
!                      TYPE:       CRTM_Surface_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 CRTM_Surface_Equal( x, y ) RESULT( is_equal )
    TYPE(CRTM_Surface_type) , INTENT(IN)  :: x, y
    LOGICAL :: is_equal

    ! Check the gross surface type coverage
    is_equal = ( (x%Land_Coverage  .EqualTo. y%Land_Coverage ) .AND. &
                 (x%Water_Coverage .EqualTo. y%Water_Coverage) .AND. &
                 (x%Snow_Coverage  .EqualTo. y%Snow_Coverage ) .AND. &
                 (x%Ice_Coverage   .EqualTo. y%Ice_Coverage  )       )
    IF ( .NOT. is_equal ) RETURN

    ! Check the land surface type data
    is_equal = is_equal .AND. CRTM_LandSurface_Equal(x,y)
    IF ( .NOT. is_equal ) RETURN

    ! Check the water surface type data
    is_equal = is_equal .AND. CRTM_WaterSurface_Equal(x,y)
    IF ( .NOT. is_equal ) RETURN

    ! Check the snow surface type data
    is_equal = is_equal .AND. CRTM_SnowSurface_Equal(x,y)
    IF ( .NOT. is_equal ) RETURN

    ! Check the ice surface type data
    is_equal = is_equal .AND. CRTM_IceSurface_Equal(x,y)
    IF ( .NOT. is_equal ) RETURN

    ! Check the SensorData
    IF ( CRTM_SensorData_Associated(x%SensorData) .AND. &
         CRTM_SensorData_Associated(y%SensorData) ) THEN
      is_equal = is_equal .AND. (x%SensorData == y%SensorData)
    END IF

  END FUNCTION CRTM_Surface_Equal


!--------------------------------------------------------------------------------
!
! NAME:
!       CRTM_Surface_Add
!
! PURPOSE:
!       Pure function to add two CRTM Surface objects.
!       Used in OPERATOR(+) interface block.
!
! CALLING SEQUENCE:
!       sfcsum = CRTM_Surface_Add( sfc1, sfc2 )
!
!         or
!
!       sfcsum = sfc1 + sfc2
!
!
! INPUTS:
!       sfc1, sfc2: The Surface objects to add.
!                   UNITS:      N/A
!                   TYPE:       CRTM_Surface_type
!                   DIMENSION:  Scalar
!                   ATTRIBUTES: INTENT(IN OUT)
!
! RESULT:
!       sfcsum:     Surface structure containing the added components.
!                   UNITS:      N/A
!                   TYPE:       CRTM_Surface_type
!                   DIMENSION:  Scalar
!
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION CRTM_Surface_Add( sfc1, sfc2 ) RESULT( sfcsum )
    TYPE(CRTM_Surface_type), INTENT(IN) :: sfc1, sfc2
    TYPE(CRTM_Surface_type) :: sfcsum

    ! Copy the first structure
    sfcsum = sfc1

    ! And add its components to the second one
    sfcsum%Land_Temperature      = sfcsum%Land_Temperature      + sfc2%Land_Temperature
    sfcsum%Soil_Moisture_Content = sfcsum%Soil_Moisture_Content + sfc2%Soil_Moisture_Content
    sfcsum%Canopy_Water_Content  = sfcsum%Canopy_Water_Content  + sfc2%Canopy_Water_Content
    sfcsum%Vegetation_Fraction   = sfcsum%Vegetation_Fraction   + sfc2%Vegetation_Fraction
    sfcsum%Soil_Temperature      = sfcsum%Soil_Temperature      + sfc2%Soil_Temperature
    sfcsum%LAI                   = sfcsum%LAI                   + sfc2%LAI
    sfcsum%Water_Temperature     = sfcsum%Water_Temperature     + sfc2%Water_Temperature
    sfcsum%Wind_Speed            = sfcsum%Wind_Speed            + sfc2%Wind_Speed
    sfcsum%Wind_Direction        = sfcsum%Wind_Direction        + sfc2%Wind_Direction
    sfcsum%Salinity              = sfcsum%Salinity              + sfc2%Salinity
    sfcsum%Snow_Temperature      = sfcsum%Snow_Temperature      + sfc2%Snow_Temperature
    sfcsum%Snow_Depth            = sfcsum%Snow_Depth            + sfc2%Snow_Depth
    sfcsum%Snow_Density          = sfcsum%Snow_Density          + sfc2%Snow_Density
    sfcsum%Snow_Grain_Size       = sfcsum%Snow_Grain_Size       + sfc2%Snow_Grain_Size
    sfcsum%Ice_Temperature       = sfcsum%Ice_Temperature       + sfc2%Ice_Temperature
    sfcsum%Ice_Thickness         = sfcsum%Ice_Thickness         + sfc2%Ice_Thickness
    sfcsum%Ice_Density           = sfcsum%Ice_Density           + sfc2%Ice_Density
    sfcsum%Ice_Roughness         = sfcsum%Ice_Roughness         + sfc2%Ice_Roughness
    ! ...SensorData component
    IF ( CRTM_SensorData_Associated(sfc1%SensorData) .AND. &
         CRTM_SensorData_Associated(sfc2%SensorData)       ) THEN
      sfcsum%SensorData = sfcsum%SensorData + sfc2%SensorData
    END IF

  END FUNCTION CRTM_Surface_Add


!--------------------------------------------------------------------------------
!
! NAME:
!       CRTM_Surface_Subtract
!
! PURPOSE:
!       Pure function to subtract two CRTM Surface objects.
!       Used in OPERATOR(-) interface block.
!
! CALLING SEQUENCE:
!       sfcdiff = CRTM_Surface_Subtract( sfc1, sfc2 )
!
!         or
!
!       sfcdiff = sfc1 - sfc2
!
!
! INPUTS:
!       sfc1, sfc2: The Surface objects to subtract.
!                   UNITS:      N/A
!                   TYPE:       CRTM_Surface_type
!                   DIMENSION:  Scalar
!                   ATTRIBUTES: INTENT(IN OUT)
!
! RESULT:
!       sfcdiff:    Surface structure containing the differenced components.
!                   UNITS:      N/A
!                   TYPE:       CRTM_Surface_type
!                   DIMENSION:  Scalar
!
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION CRTM_Surface_Subtract( sfc1, sfc2 ) RESULT( sfcdiff )
    TYPE(CRTM_Surface_type), INTENT(IN) :: sfc1, sfc2
    TYPE(CRTM_Surface_type) :: sfcdiff

    ! Copy the first structure
    sfcdiff = sfc1

    ! And subtract the second one's components from it.
    sfcdiff%Land_Temperature      = sfcdiff%Land_Temperature      - sfc2%Land_Temperature
    sfcdiff%Soil_Moisture_Content = sfcdiff%Soil_Moisture_Content - sfc2%Soil_Moisture_Content
    sfcdiff%Canopy_Water_Content  = sfcdiff%Canopy_Water_Content  - sfc2%Canopy_Water_Content
    sfcdiff%Vegetation_Fraction   = sfcdiff%Vegetation_Fraction   - sfc2%Vegetation_Fraction
    sfcdiff%Soil_Temperature      = sfcdiff%Soil_Temperature      - sfc2%Soil_Temperature
    sfcdiff%LAI                   = sfcdiff%LAI                   - sfc2%LAI
    sfcdiff%Water_Temperature     = sfcdiff%Water_Temperature     - sfc2%Water_Temperature
    sfcdiff%Wind_Speed            = sfcdiff%Wind_Speed            - sfc2%Wind_Speed
    sfcdiff%Wind_Direction        = sfcdiff%Wind_Direction        - sfc2%Wind_Direction
    sfcdiff%Salinity              = sfcdiff%Salinity              - sfc2%Salinity
    sfcdiff%Snow_Temperature      = sfcdiff%Snow_Temperature      - sfc2%Snow_Temperature
    sfcdiff%Snow_Depth            = sfcdiff%Snow_Depth            - sfc2%Snow_Depth
    sfcdiff%Snow_Density          = sfcdiff%Snow_Density          - sfc2%Snow_Density
    sfcdiff%Snow_Grain_Size       = sfcdiff%Snow_Grain_Size       - sfc2%Snow_Grain_Size
    sfcdiff%Ice_Temperature       = sfcdiff%Ice_Temperature       - sfc2%Ice_Temperature
    sfcdiff%Ice_Thickness         = sfcdiff%Ice_Thickness         - sfc2%Ice_Thickness
    sfcdiff%Ice_Density           = sfcdiff%Ice_Density           - sfc2%Ice_Density
    sfcdiff%Ice_Roughness         = sfcdiff%Ice_Roughness         - sfc2%Ice_Roughness
    ! ...SensorData component
    IF ( CRTM_SensorData_Associated(sfc1%SensorData) .AND. &
         CRTM_SensorData_Associated(sfc2%SensorData)       ) THEN
      sfcdiff%SensorData = sfcdiff%SensorData - sfc2%SensorData
    END IF

  END FUNCTION CRTM_Surface_Subtract



!##################################################################################
!##################################################################################
!##                                                                              ##
!##     ## PROCEDURES BELOW WILL EVENTUALLY BE MOVED TO THEIR OWN MODULE ##      ##
!##                                                                              ##
!##################################################################################
!##################################################################################

! =============================
! LAND TYPE SPECIFIC PROCEDURES
! =============================
  ELEMENTAL SUBROUTINE CRTM_LandSurface_Zero( Sfc )
    TYPE(CRTM_Surface_type), INTENT(IN OUT) :: Sfc
    ! Zero land surface type data
    Sfc%Land_Temperature      = ZERO
    Sfc%Soil_Moisture_Content = ZERO
    Sfc%Canopy_Water_Content  = ZERO
    Sfc%Vegetation_Fraction   = ZERO
    Sfc%Soil_Temperature      = ZERO
    Sfc%LAI                   = ZERO
  END SUBROUTINE CRTM_LandSurface_Zero


  FUNCTION CRTM_LandSurface_IsValid( Sfc ) RESULT( IsValid )
    TYPE(CRTM_Surface_type), INTENT(IN) :: Sfc
    LOGICAL :: IsValid
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_LandSurface_IsValid'
    CHARACTER(ML) :: msg

    ! Setup
    IsValid = .TRUE.

    ! Check the data
    IF ( Sfc%Land_Type < 1 ) THEN
      msg = 'Invalid Land Surface type'
      CALL Display_Message( ROUTINE_NAME, TRIM(msg), INFORMATION )
      IsValid = .FALSE.
    ENDIF
    IF ( Sfc%Soil_Type < 1 .OR. &
         Sfc%Soil_Type > N_VALID_SOIL_TYPES ) THEN
      msg = 'Invalid Soil type'
      CALL Display_Message( ROUTINE_NAME, TRIM(msg), INFORMATION )
      IsValid = .FALSE.
    ENDIF
    IF ( Sfc%Vegetation_Type < 1 .OR. &
         Sfc%Vegetation_Type > N_VALID_VEGETATION_TYPES ) THEN
      msg = 'Invalid Vegetation type'
      CALL Display_Message( ROUTINE_NAME, TRIM(msg), INFORMATION )
      IsValid = .FALSE.
    ENDIF
    IF ( Sfc%Land_Temperature      < ZERO .OR. &
         Sfc%Soil_Moisture_Content < ZERO .OR. &
         Sfc%Canopy_Water_Content  < ZERO .OR. &
         Sfc%Vegetation_Fraction   < ZERO .OR. &
         Sfc%Soil_Temperature      < ZERO .OR. &
         Sfc%LAI                   < ZERO      ) THEN
      msg = 'Invalid Land Surface data'
      CALL Display_Message( ROUTINE_NAME, TRIM(msg), INFORMATION )
      IsValid = .FALSE.
    ENDIF

  END FUNCTION CRTM_LandSurface_IsValid


  SUBROUTINE CRTM_LandSurface_Inspect( Sfc )
    TYPE(CRTM_Surface_type), INTENT(IN) :: Sfc
    WRITE(*, '(3x,"Land type index      :",1x,i0)') Sfc%Land_Type
    WRITE(*, '(3x,"Land Temperature     :",1x,es13.6)') Sfc%Land_Temperature
    WRITE(*, '(3x,"Soil Moisture Content:",1x,es13.6)') Sfc%Soil_Moisture_Content
    WRITE(*, '(3x,"Canopy Water Content :",1x,es13.6)') Sfc%Canopy_Water_Content
    WRITE(*, '(3x,"Vegetation Fraction  :",1x,es13.6)') Sfc%Vegetation_Fraction
    WRITE(*, '(3x,"Soil Temperature     :",1x,es13.6)') Sfc%Soil_Temperature
    WRITE(*, '(3x,"Leaf Area Index      :",1x,es13.6)') Sfc%LAI
    WRITE(*, '(3x,"Soil type index      :",1x,i0)') Sfc%Soil_Type
    WRITE(*, '(3x,"Vegetation type index:",1x,i0)') Sfc%Vegetation_Type
  END SUBROUTINE CRTM_LandSurface_Inspect


  ELEMENTAL FUNCTION CRTM_LandSurface_Compare( x, y, n_SigFig ) RESULT( is_comparable )
    TYPE(CRTM_Surface_type), INTENT(IN) :: x, y
    INTEGER,       OPTIONAL, INTENT(IN) :: n_SigFig
    LOGICAL :: is_comparable
    ! Variables
    INTEGER :: n

    ! Set up
    is_comparable = .FALSE.
    IF ( PRESENT(n_SigFig) ) THEN
      n = ABS(n_SigFig)
    ELSE
      n = DEFAULT_N_SIGFIG
    END IF

    ! Check integers
    IF ( x%Land_Type       /= y%Land_Type .OR. &
         x%Soil_Type       /= y%Soil_Type .OR. &
         x%Vegetation_Type /= y%Vegetation_Type ) RETURN

    ! Check floats
    IF ( (.NOT. Compares_Within_Tolerance(x%Land_Temperature     ,y%Land_Temperature     ,n)) .OR. &
         (.NOT. Compares_Within_Tolerance(x%Soil_Moisture_Content,y%Soil_Moisture_Content,n)) .OR. &
         (.NOT. Compares_Within_Tolerance(x%Canopy_Water_Content ,y%Canopy_Water_Content ,n)) .OR. &
         (.NOT. Compares_Within_Tolerance(x%Vegetation_Fraction  ,y%Vegetation_Fraction  ,n)) .OR. &
         (.NOT. Compares_Within_Tolerance(x%Soil_Temperature     ,y%Soil_Temperature     ,n)) .OR. &
         (.NOT. Compares_Within_Tolerance(x%LAI                  ,y%LAI                  ,n)) ) RETURN

    ! If we get here, the structures are comparable
    is_comparable = .TRUE.

  END FUNCTION CRTM_LandSurface_Compare


  ELEMENTAL FUNCTION CRTM_LandSurface_Equal( x, y ) RESULT( is_equal )
    TYPE(CRTM_Surface_type) , INTENT(IN)  :: x, y
    LOGICAL :: is_equal
    is_equal = ( (x%Land_Type                ==     y%Land_Type            ) .AND. &
                 (x%Land_Temperature      .EqualTo. y%Land_Temperature     ) .AND. &
                 (x%Soil_Moisture_Content .EqualTo. y%Soil_Moisture_Content) .AND. &
                 (x%Canopy_Water_Content  .EqualTo. y%Canopy_Water_Content ) .AND. &
                 (x%Vegetation_Fraction   .EqualTo. y%Vegetation_Fraction  ) .AND. &
                 (x%Soil_Temperature      .EqualTo. y%Soil_Temperature     ) .AND. &
                 (x%LAI                   .EqualTo. y%LAI                  ) .AND. &
                 (x%Soil_Type                ==     y%Soil_Type            ) .AND. &
                 (x%Vegetation_Type          ==     y%Vegetation_Type      )       )
  END FUNCTION CRTM_LandSurface_Equal


! ==============================
! WATER TYPE SPECIFIC PROCEDURES
! ==============================
  ELEMENTAL SUBROUTINE CRTM_WaterSurface_Zero( Sfc )
    TYPE(CRTM_Surface_type), INTENT(IN OUT) :: Sfc
    ! Zero the water surface type data
    Sfc%Water_Temperature = ZERO
    Sfc%Wind_Speed        = ZERO
    Sfc%Wind_Direction    = ZERO
    Sfc%Salinity          = ZERO
  END SUBROUTINE CRTM_WaterSurface_Zero


  FUNCTION CRTM_WaterSurface_IsValid( Sfc ) RESULT( IsValid )
    TYPE(CRTM_Surface_type), INTENT(IN) :: Sfc
    LOGICAL :: IsValid
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_WaterSurface_IsValid'
    CHARACTER(ML) :: msg

    ! Setup
    IsValid = .TRUE.

    ! Check the data
    IF ( Sfc%Water_Type < 1 ) THEN
      msg = 'Invalid Water Surface type'
      CALL Display_Message( ROUTINE_NAME, TRIM(msg), INFORMATION )
      IsValid = .FALSE.
    ENDIF
    IF ( Sfc%Water_Temperature < ZERO .OR. &
         Sfc%Wind_Speed        < ZERO .OR. &
         Sfc%Wind_Direction    < ZERO .OR. &
         Sfc%Salinity          < ZERO      ) THEN
      msg = 'Invalid Water Surface data'
      CALL Display_Message( ROUTINE_NAME, TRIM(msg), INFORMATION )
      IsValid = .FALSE.
    END IF

  END FUNCTION CRTM_WaterSurface_IsValid


  SUBROUTINE CRTM_WaterSurface_Inspect( Sfc )
    TYPE(CRTM_Surface_type), INTENT(IN) :: Sfc
    WRITE(*, '(3x,"Water Type index :",1x,i0)') Sfc%Water_Type
    WRITE(*, '(3x,"Water Temperature:",1x,es13.6)') Sfc%Water_Temperature
    WRITE(*, '(3x,"Wind Speed       :",1x,es13.6)') Sfc%Wind_Speed
    WRITE(*, '(3x,"Wind Direction   :",1x,es13.6)') Sfc%Wind_Direction
    WRITE(*, '(3x,"Salinity         :",1x,es13.6)') Sfc%Salinity
  END SUBROUTINE CRTM_WaterSurface_Inspect


  ELEMENTAL FUNCTION CRTM_WaterSurface_Compare( x, y, n_SigFig ) RESULT( is_comparable )
    TYPE(CRTM_Surface_type), INTENT(IN) :: x, y
    INTEGER,       OPTIONAL, INTENT(IN) :: n_SigFig
    LOGICAL :: is_comparable
    ! Variables
    INTEGER :: n

    ! Set up
    is_comparable = .FALSE.
    IF ( PRESENT(n_SigFig) ) THEN
      n = ABS(n_SigFig)
    ELSE
      n = DEFAULT_N_SIGFIG
    END IF

    ! Check integers
    IF ( x%Water_Type /= y%Water_Type ) RETURN

    ! Check floats
    IF ( (.NOT. Compares_Within_Tolerance(x%Water_Temperature,y%Water_Temperature,n)) .OR. &
         (.NOT. Compares_Within_Tolerance(x%Wind_Speed       ,y%Wind_Speed       ,n)) .OR. &
         (.NOT. Compares_Within_Tolerance(x%Wind_Direction   ,y%Wind_Direction   ,n)) .OR. &
         (.NOT. Compares_Within_Tolerance(x%Salinity         ,y%Salinity         ,n)) ) RETURN

    ! If we get here, the structures are comparable
    is_comparable = .TRUE.

  END FUNCTION CRTM_WaterSurface_Compare


  ELEMENTAL FUNCTION CRTM_WaterSurface_Equal( x, y ) RESULT( is_equal )
    TYPE(CRTM_Surface_type) , INTENT(IN)  :: x, y
    LOGICAL :: is_equal
    is_equal = ( (x%Water_Type           ==     y%Water_Type       ) .AND. &
                 (x%Water_Temperature .EqualTo. y%Water_Temperature) .AND. &
                 (x%Wind_Speed        .EqualTo. y%Wind_Speed       ) .AND. &
                 (x%Wind_Direction    .EqualTo. y%Wind_Direction   ) .AND. &
                 (x%Salinity          .EqualTo. y%Salinity         )       )
  END FUNCTION CRTM_WaterSurface_Equal


! =============================
! SNOW TYPE SPECIFIC PROCEDURES
! =============================
  ELEMENTAL SUBROUTINE CRTM_SnowSurface_Zero( Sfc )
    TYPE(CRTM_Surface_type), INTENT(IN OUT) :: Sfc
    ! Zero the snow surface type data
    Sfc%Snow_Temperature = ZERO
    Sfc%Snow_Depth       = ZERO
    Sfc%Snow_Density     = ZERO
    Sfc%Snow_Grain_Size  = ZERO
  END SUBROUTINE CRTM_SnowSurface_Zero


  FUNCTION CRTM_SnowSurface_IsValid( Sfc ) RESULT( IsValid )
    TYPE(CRTM_Surface_type), INTENT(IN) :: Sfc
    LOGICAL :: IsValid
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_SnowSurface_IsValid'
    CHARACTER(ML) :: msg

    ! Setup
    IsValid = .TRUE.

    ! Check the data
    IF ( Sfc%Snow_Type < 1 ) THEN
      msg = 'Invalid Snow Surface type'
      CALL Display_Message( ROUTINE_NAME, TRIM(msg), INFORMATION )
      IsValid = .FALSE.
    ENDIF
    IF ( Sfc%Snow_Temperature < ZERO .OR. &
         Sfc%Snow_Depth       < ZERO .OR. &
         Sfc%Snow_Density     < ZERO .OR. &
         Sfc%Snow_Grain_Size  < ZERO      ) THEN
      msg = 'Invalid Snow Surface data'
      CALL Display_Message( ROUTINE_NAME, TRIM(msg), INFORMATION )
      IsValid = .FALSE.
    END IF

  END FUNCTION CRTM_SnowSurface_IsValid


  SUBROUTINE CRTM_SnowSurface_Inspect( Sfc )
    TYPE(CRTM_Surface_type), INTENT(IN) :: Sfc
    WRITE(*, '(3x,"Snow Type index :",1x,i0)') Sfc%Snow_Type
    WRITE(*, '(3x,"Snow Temperature:",1x,es13.6)') Sfc%Snow_Temperature
    WRITE(*, '(3x,"Snow Depth      :",1x,es13.6)') Sfc%Snow_Depth
    WRITE(*, '(3x,"Snow Density    :",1x,es13.6)') Sfc%Snow_Density
    WRITE(*, '(3x,"Snow Grain_Size :",1x,es13.6)') Sfc%Snow_Grain_Size
  END SUBROUTINE CRTM_SnowSurface_Inspect


  ELEMENTAL FUNCTION CRTM_SnowSurface_Compare( x, y, n_SigFig ) RESULT( is_comparable )
    TYPE(CRTM_Surface_type), INTENT(IN) :: x, y
    INTEGER,       OPTIONAL, INTENT(IN) :: n_SigFig
    LOGICAL :: is_comparable
    ! Variables
    INTEGER :: n

    ! Set up
    is_comparable = .FALSE.
    IF ( PRESENT(n_SigFig) ) THEN
      n = ABS(n_SigFig)
    ELSE
      n = DEFAULT_N_SIGFIG
    END IF

    ! Check integers
    IF ( x%Snow_Type /= y%Snow_Type ) RETURN

    ! Check floats
    IF ( (.NOT. Compares_Within_Tolerance(x%Snow_Temperature,y%Snow_Temperature,n)) .OR. &
         (.NOT. Compares_Within_Tolerance(x%Snow_Depth      ,y%Snow_Depth      ,n)) .OR. &
         (.NOT. Compares_Within_Tolerance(x%Snow_Density    ,y%Snow_Density    ,n)) .OR. &
         (.NOT. Compares_Within_Tolerance(x%Snow_Grain_Size ,y%Snow_Grain_Size ,n)) ) RETURN

    ! If we get here, the structures are comparable
    is_comparable = .TRUE.

  END FUNCTION CRTM_SnowSurface_Compare


  ELEMENTAL FUNCTION CRTM_SnowSurface_Equal( x, y ) RESULT( is_equal )
    TYPE(CRTM_Surface_type) , INTENT(IN)  :: x, y
    LOGICAL :: is_equal
    is_equal = ( (x%Snow_Type           ==     y%Snow_Type       ) .AND. &
                 (x%Snow_Temperature .EqualTo. y%Snow_Temperature) .AND. &
                 (x%Snow_Depth       .EqualTo. y%Snow_Depth      ) .AND. &
                 (x%Snow_Density     .EqualTo. y%Snow_Density    ) .AND. &
                 (x%Snow_Grain_Size  .EqualTo. y%Snow_Grain_Size )       )
  END FUNCTION CRTM_SnowSurface_Equal


! ============================
! ICE TYPE SPECIFIC PROCEDURES
! ============================
  ELEMENTAL SUBROUTINE CRTM_IceSurface_Zero( Sfc )
    TYPE(CRTM_Surface_type), INTENT(IN OUT) :: Sfc
    ! Zero the ice surface type data
    Sfc%Ice_Temperature = ZERO
    Sfc%Ice_Thickness   = ZERO
    Sfc%Ice_Density     = ZERO
    Sfc%Ice_Roughness   = ZERO
  END SUBROUTINE CRTM_IceSurface_Zero


  FUNCTION CRTM_IceSurface_IsValid( Sfc ) RESULT( IsValid )
    TYPE(CRTM_Surface_type), INTENT(IN) :: Sfc
    LOGICAL :: IsValid
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_IceSurface_IsValid'
    CHARACTER(ML) :: msg

    ! Setup
    IsValid = .TRUE.

    ! Check the data
    IF ( Sfc%Ice_Type < 1 ) THEN
      msg = 'Invalid Ice Surface type'
      CALL Display_Message( ROUTINE_NAME, TRIM(msg), INFORMATION )
      IsValid = .FALSE.
    ENDIF
    IF ( Sfc%Ice_Temperature < ZERO .OR. &
         Sfc%Ice_Thickness   < ZERO .OR. &
         Sfc%Ice_Density     < ZERO .OR. &
         Sfc%Ice_Roughness   < ZERO      ) THEN
      msg = 'Invalid Ice Surface data'
      CALL Display_Message( ROUTINE_NAME, TRIM(msg), INFORMATION )
      IsValid = .FALSE.
    END IF

  END FUNCTION CRTM_IceSurface_IsValid


  SUBROUTINE CRTM_IceSurface_Inspect( Sfc )
    TYPE(CRTM_Surface_type), INTENT(IN) :: Sfc
    WRITE(*, '(3x,"Ice Type index :",1x,i0)') Sfc%Ice_Type
    WRITE(*, '(3x,"Ice Temperature:",1x,es13.6)') Sfc%Ice_Temperature
    WRITE(*, '(3x,"Ice Thickness  :",1x,es13.6)') Sfc%Ice_Thickness
    WRITE(*, '(3x,"Ice Density    :",1x,es13.6)') Sfc%Ice_Density
    WRITE(*, '(3x,"Ice Roughness  :",1x,es13.6)') Sfc%Ice_Roughness
  END SUBROUTINE CRTM_IceSurface_Inspect


  ELEMENTAL FUNCTION CRTM_IceSurface_Compare( x, y, n_SigFig ) RESULT( is_comparable )
    TYPE(CRTM_Surface_type), INTENT(IN) :: x, y
    INTEGER,       OPTIONAL, INTENT(IN) :: n_SigFig
    LOGICAL :: is_comparable
    ! Variables
    INTEGER :: n

    ! Set up
    is_comparable = .FALSE.
    IF ( PRESENT(n_SigFig) ) THEN
      n = ABS(n_SigFig)
    ELSE
      n = DEFAULT_N_SIGFIG
    END IF

    ! Check integers
    IF ( x%Ice_Type /= y%Ice_Type ) RETURN

    ! Check floats
    IF ( (.NOT. Compares_Within_Tolerance(x%Ice_Temperature,y%Ice_Temperature,n)) .OR. &
         (.NOT. Compares_Within_Tolerance(x%Ice_Thickness  ,y%Ice_Thickness  ,n)) .OR. &
         (.NOT. Compares_Within_Tolerance(x%Ice_Density    ,y%Ice_Density    ,n)) .OR. &
         (.NOT. Compares_Within_Tolerance(x%Ice_Roughness  ,y%Ice_Roughness  ,n)) ) RETURN

    ! If we get here, the structures are comparable
    is_comparable = .TRUE.

  END FUNCTION CRTM_IceSurface_Compare


  ELEMENTAL FUNCTION CRTM_IceSurface_Equal( x, y ) RESULT( is_equal )
    TYPE(CRTM_Surface_type) , INTENT(IN)  :: x, y
    LOGICAL :: is_equal
    is_equal = ( (x%Ice_Type           ==     y%Ice_Type       ) .AND. &
                 (x%Ice_Temperature .EqualTo. y%Ice_Temperature) .AND. &
                 (x%Ice_Thickness   .EqualTo. y%Ice_Thickness  ) .AND. &
                 (x%Ice_Density     .EqualTo. y%Ice_Density    ) .AND. &
                 (x%Ice_Roughness   .EqualTo. y%Ice_Roughness  )       )
  END FUNCTION CRTM_IceSurface_Equal


!
! NAME:
!       Read_Record
!
! PURPOSE:
!       Utility function to read a single surface data record
!

  FUNCTION Read_Record( &
    fid        , &  ! Input
    sfc        , &  ! Output
    Quiet      , &  ! Optional input
    Debug      ) &  ! Optional input (Debug output control)
  RESULT( err_stat )
    ! Arguments
    INTEGER,                 INTENT(IN)  :: fid
    TYPE(CRTM_Surface_type), INTENT(OUT) :: sfc
    LOGICAL,       OPTIONAL, INTENT(IN)  :: Quiet
    LOGICAL,       OPTIONAL, INTENT(IN)  :: Debug
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_Surface_ReadFile(Record)'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    LOGICAL :: noisy
    INTEGER :: io_stat
    INTEGER :: Coverage_Type
    INTEGER :: n_Channels

    ! Set up
    err_stat = SUCCESS
    ! ...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


    ! Read the gross surface type coverage
    READ( fid,IOSTAT=io_stat,IOMSG=io_msg ) &
      Coverage_Type, &
      sfc%Land_Coverage, &
      sfc%Water_Coverage, &
      sfc%Snow_Coverage, &
      sfc%Ice_Coverage
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading gross surface type data - '//TRIM(io_msg)
      CALL Read_Record_Cleanup(); RETURN
    END IF
    ! ...Check the coverage fractions
    IF ( .NOT. CRTM_Surface_IsCoverageValid(sfc) ) THEN
      msg = 'Invalid surface coverage fraction(s) found'
      CALL Read_Record_Cleanup(); RETURN
    END IF
    ! ...Check the coverge surface type
    IF ( CRTM_Surface_CoverageType( sfc ) /= Coverage_Type ) THEN
      msg = 'Coverage surface type, '//&
            TRIM(SURFACE_TYPE_NAME(CRTM_Surface_CoverageType(sfc)))//&
            ', inconsistent with that specified in file.'
      CALL Read_Record_Cleanup(); RETURN
    END IF


    ! Read the surface type independent data
    READ( fid,IOSTAT=io_stat,IOMSG=io_msg ) sfc%Wind_Speed
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading surface type independent data - '//TRIM(io_msg)
      CALL Read_Record_Cleanup(); RETURN
    END IF


    ! Read the land surface type data
    READ( fid,IOSTAT=io_stat,IOMSG=io_msg ) &
      sfc%Land_Type, &
      sfc%Land_Temperature, &
      sfc%Soil_Moisture_Content, &
      sfc%Canopy_Water_Content , &
      sfc%Vegetation_Fraction, &
      sfc%Soil_Temperature, &
      sfc%Lai
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading land surface type data - '//TRIM(io_msg)
      CALL Read_Record_Cleanup(); RETURN
    END IF


    ! Read the water surface type data
    READ( fid,IOSTAT=io_stat,IOMSG=io_msg ) &
      sfc%Water_Type, &
      sfc%Water_Temperature, &
      sfc%Wind_Direction, &
      sfc%Salinity
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading water surface type data - '//TRIM(io_msg)
      CALL Read_Record_Cleanup(); RETURN
    END IF


    ! Read the snow surface type data
    READ( fid,IOSTAT=io_stat,IOMSG=io_msg ) &
      sfc%Snow_Type, &
      sfc%Snow_Temperature, &
      sfc%Snow_Depth, &
      sfc%Snow_Density, &
      sfc%Snow_Grain_Size
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading snow surface type data - '//TRIM(io_msg)
      CALL Read_Record_Cleanup(); RETURN
    END IF


    ! Read the ice surface type data
    READ( fid,IOSTAT=io_stat,IOMSG=io_msg ) &
      sfc%Ice_Type, &
      sfc%Ice_Temperature, &
      sfc%Ice_Thickness, &
      sfc%Ice_Density, &
      sfc%Ice_Roughness
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading ice surface type data - '//TRIM(io_msg)
      CALL Read_Record_Cleanup(); RETURN
    END IF


    ! Read the SensorData
    ! ...The dimensions
    READ( fid,IOSTAT=io_stat,IOMSG=io_msg ) n_Channels
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading SensorData dimensions - '//TRIM(io_msg)
      CALL Read_Record_Cleanup(); RETURN
    END IF
    ! ...The data
    IF ( n_Channels > 0 ) THEN
      CALL CRTM_SensorData_Create(sfc%SensorData, n_Channels )
      IF ( .NOT. CRTM_SensorData_Associated(sfc%SensorData) ) THEN
        msg = 'Error creating SensorData object.'
        CALL Read_Record_Cleanup(); RETURN
      END IF
      READ( fid,IOSTAT=io_stat,IOMSG=io_msg ) &
        sfc%SensorData%Sensor_ID       , &
        sfc%SensorData%WMO_Satellite_ID, &
        sfc%SensorData%WMO_Sensor_ID   , &
        sfc%SensorData%Sensor_Channel  , &
        sfc%SensorData%Tb
      IF ( io_stat /= 0 ) THEN
        msg = 'Error reading SensorData  - '//TRIM(io_msg)
        CALL Read_Record_Cleanup(); RETURN
      END IF
    END IF

  CONTAINS

    SUBROUTINE Read_Record_Cleanup()
      CALL CRTM_Surface_Destroy( sfc )
      CLOSE( fid,IOSTAT=io_stat,IOMSG=io_msg )
      IF ( io_stat /= SUCCESS ) &
        msg = TRIM(msg)//'; Error closing file during error cleanup - '//TRIM(io_msg)
      err_stat = FAILURE
      CALL Display_Message( ROUTINE_NAME, msg, err_stat )
    END SUBROUTINE Read_Record_Cleanup

  END FUNCTION Read_Record


!
! NAME:
!       Write_Record
!
! PURPOSE:
!       Utility function to write a single surface data record
!

  FUNCTION Write_Record( &
    fid  , &  ! Input
    sfc  , &  ! Input
    Quiet, &  ! Optional input
    Debug) &  ! Optional input (Debug output control)
  RESULT( err_stat )
    ! Arguments
    INTEGER,                 INTENT(IN) :: fid
    TYPE(CRTM_Surface_type), INTENT(IN) :: sfc
    LOGICAL,       OPTIONAL, INTENT(IN) :: Quiet
    LOGICAL,       OPTIONAL, INTENT(IN) :: Debug
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_Surface_WriteFile(Record)'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    LOGICAL :: noisy
    INTEGER :: io_stat


    ! Set up
    err_stat = SUCCESS
    ! ...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
    

    ! Write the gross surface type coverage
    WRITE( fid,IOSTAT=io_stat,IOMSG=io_msg ) &
      CRTM_Surface_CoverageType(sfc), &
      sfc%Land_Coverage, &
      sfc%Water_Coverage, &
      sfc%Snow_Coverage, &
      sfc%Ice_Coverage
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing gross surface type data - '//TRIM(io_msg)
      CALL Write_Record_Cleanup(); RETURN
    END IF


    ! Write the surface type independent data
    WRITE( fid,IOSTAT=io_stat,IOMSG=io_msg ) sfc%Wind_Speed
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing surface type independent data - '//TRIM(io_msg)
      CALL Write_Record_Cleanup(); RETURN
    END IF


    ! Write the land surface type data
    WRITE( fid,IOSTAT=io_stat,IOMSG=io_msg ) &
      sfc%Land_Type, &
      sfc%Land_Temperature, &
      sfc%Soil_Moisture_Content, &
      sfc%Canopy_Water_Content, &
      sfc%Vegetation_Fraction, &
      sfc%Soil_Temperature, &
      sfc%Lai
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing land surface type data - '//TRIM(io_msg)
      CALL Write_Record_Cleanup(); RETURN
    END IF


    ! Write the water surface type data
    WRITE( fid,IOSTAT=io_stat,IOMSG=io_msg ) &
      sfc%Water_Type, &
      sfc%Water_Temperature, &
      sfc%Wind_Direction, &
      sfc%Salinity
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing water surface type data - '//TRIM(io_msg)
      CALL Write_Record_Cleanup(); RETURN
    END IF


    ! Write the snow surface type data
    WRITE( fid,IOSTAT=io_stat,IOMSG=io_msg ) &
      sfc%Snow_Type, &
      sfc%Snow_Temperature, &
      sfc%Snow_Depth, &
      sfc%Snow_Density, &
      sfc%Snow_Grain_Size
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing snow surface type data - '//TRIM(io_msg)
      CALL Write_Record_Cleanup(); RETURN
    END IF


    ! Write the ice surface type data
    WRITE( fid,IOSTAT=io_stat,IOMSG=io_msg ) &
      sfc%Ice_Type, &
      sfc%Ice_Temperature, &
      sfc%Ice_Thickness, &
      sfc%Ice_Density, &
      sfc%Ice_Roughness
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing ice surface type data - '//TRIM(io_msg)
      CALL Write_Record_Cleanup(); RETURN
    END IF


    ! Write the SensorData object
    ! ...The dimensions
    WRITE( fid,IOSTAT=io_stat,IOMSG=io_msg ) sfc%SensorData%n_Channels
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing SensorData dimensions - '//TRIM(io_msg)
      CALL Write_Record_Cleanup(); RETURN
    END IF
    ! ...The data
    IF ( sfc%SensorData%n_Channels > 0 ) THEN
      WRITE( fid,IOSTAT=io_stat,IOMSG=io_msg ) &
        sfc%SensorData%Sensor_ID       , &
        sfc%SensorData%WMO_Satellite_ID, &
        sfc%SensorData%WMO_Sensor_ID   , &
        sfc%SensorData%Sensor_Channel  , &
        sfc%SensorData%Tb
      IF ( io_stat /= 0 ) THEN
        msg = 'Error writing SensorData - '//TRIM(io_msg)
        CALL Write_Record_Cleanup(); RETURN
      END IF
    END IF

  CONTAINS

    SUBROUTINE Write_Record_Cleanup()
      CLOSE( fid,STATUS=WRITE_ERROR_STATUS,IOSTAT=io_stat,IOMSG=io_msg )
      IF ( io_stat /= SUCCESS ) &
        msg = TRIM(msg)//'; Error closing file during error cleanup - '//TRIM(io_msg)
      err_stat = FAILURE
      CALL Display_Message( ROUTINE_NAME, msg, err_stat )
    END SUBROUTINE Write_Record_Cleanup

  END FUNCTION Write_Record

END MODULE CRTM_Surface_Define
