CRTM_Cloud_Define.f90

Go to the documentation of this file.

!
! CRTM_Cloud_Define
!
! Module defining the CRTM Cloud 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
!                       20-Feb-2004
!

MODULE crtm_cloud_define


  ! -----------------
  ! Environment setup
  ! -----------------
  ! Intrinsic modules
  USE iso_fortran_env      , ONLY: output_unit
  ! 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
  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE
  ! Cloud Parameters
  PUBLIC :: n_valid_cloud_categories
  PUBLIC :: invalid_cloud
  PUBLIC ::   water_cloud
  PUBLIC ::     ice_cloud
  PUBLIC ::    rain_cloud
  PUBLIC ::    snow_cloud
  PUBLIC :: graupel_cloud
  PUBLIC ::    hail_cloud
  PUBLIC :: cloud_category_name
  ! Datatypes
  PUBLIC :: crtm_cloud_type
  ! Operators
  PUBLIC :: OPERATOR(==)
  PUBLIC :: OPERATOR(+)
  PUBLIC :: OPERATOR(-)
  ! Procedures
  PUBLIC :: crtm_cloud_categoryname
  PUBLIC :: crtm_cloud_categoryid
  PUBLIC :: crtm_cloud_categorylist
  PUBLIC :: crtm_cloud_associated
  PUBLIC :: crtm_cloud_destroy
  PUBLIC :: crtm_cloud_create
  PUBLIC :: crtm_cloud_addlayercopy
  PUBLIC :: crtm_cloud_zero
  PUBLIC :: crtm_cloud_isvalid
  PUBLIC :: crtm_cloud_inspect
  PUBLIC :: crtm_cloud_defineversion
  PUBLIC :: crtm_cloud_compare
  PUBLIC :: crtm_cloud_setlayers
  PUBLIC :: crtm_cloud_inquirefile
  PUBLIC :: crtm_cloud_readfile
  PUBLIC :: crtm_cloud_writefile


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

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

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

  INTERFACE crtm_cloud_inspect
    MODULE PROCEDURE scalar_inspect
    MODULE PROCEDURE rank1_inspect
    MODULE PROCEDURE rank2_inspect
  END INTERFACE crtm_cloud_inspect


  ! -----------------
  ! Module parameters
  ! -----------------
  CHARACTER(*), PARAMETER :: module_version_id = &
  '$Id: CRTM_Cloud_Define.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
  ! The valid cloud categories and names
  INTEGER, PARAMETER :: n_valid_cloud_categories = 6
  INTEGER, PARAMETER :: invalid_cloud = 0
  INTEGER, PARAMETER ::   water_cloud = 1
  INTEGER, PARAMETER ::     ice_cloud = 2
  INTEGER, PARAMETER ::    rain_cloud = 3
  INTEGER, PARAMETER ::    snow_cloud = 4
  INTEGER, PARAMETER :: graupel_cloud = 5
  INTEGER, PARAMETER ::    hail_cloud = 6
  INTEGER, PARAMETER :: cloud_category_list(0:n_valid_cloud_categories) = &
    [ invalid_cloud, &
        water_cloud, &
          ice_cloud, &
         rain_cloud, &
         snow_cloud, &
      graupel_cloud, &
         hail_cloud  ]
  CHARACTER(*), PARAMETER :: cloud_category_name(0:n_valid_cloud_categories) = &
    [ 'Invalid', &
      'Water  ', &
      'Ice    ', &
      'Rain   ', &
      'Snow   ', &
      'Graupel', &
      'Hail   '  ]
  ! 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'


  ! --------------------------
  ! Cloud data type definition
  ! --------------------------
  !:tdoc+:
  TYPE :: crtm_cloud_type
    ! Allocation indicator
    LOGICAL :: is_allocated = .false.
    ! Dimension values
    INTEGER :: max_layers = 0  ! K dimension.
    INTEGER :: n_layers   = 0  ! Kuse dimension.
    ! Number of added layers
    INTEGER :: n_added_layers = 0
    ! Cloud type
    INTEGER :: Type = invalid_cloud
    ! Cloud state variables
    REAL(fp), ALLOCATABLE :: effective_radius(:)   ! K. Units are microns
    REAL(fp), ALLOCATABLE :: effective_variance(:) ! K. Units are microns^2
    REAL(fp), ALLOCATABLE :: water_content(:)      ! K. Units are kg/m^2
  END TYPE crtm_cloud_type
  !:tdoc-:


CONTAINS


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

  PURE FUNCTION crtm_cloud_categoryid(cloud) RESULT(id)
    TYPE(crtm_cloud_type), INTENT(IN) :: cloud
    INTEGER :: id
    id = cloud%type
    IF ( id < 1 .OR. id > n_valid_cloud_categories ) id = invalid_cloud
  END FUNCTION crtm_cloud_categoryid

  PURE FUNCTION crtm_cloud_categoryname(cloud) RESULT(name)
    TYPE(crtm_cloud_type), INTENT(IN) :: cloud
    CHARACTER(LEN(CLOUD_CATEGORY_NAME(1))) :: name
    INTEGER  :: id
    id = crtm_cloud_categoryid(cloud)
    name = cloud_category_name(id)
  END FUNCTION crtm_cloud_categoryname

  FUNCTION crtm_cloud_categorylist(list) RESULT(err_stat)
    INTEGER, ALLOCATABLE, INTENT(OUT) :: list(:)
    INTEGER :: err_stat
    CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Cloud_CategoryList'
    CHARACTER(ML) :: alloc_msg, msg
    INTEGER :: alloc_stat
    err_stat = success
    ALLOCATE( list(0:n_valid_cloud_categories), stat=alloc_stat, errmsg=alloc_msg )
    IF ( alloc_stat /= 0 ) THEN
      err_stat = failure
      msg = 'Cloud category list result not allocated -'//trim(alloc_msg)
      CALL display_message( routine_name, msg, err_stat )
      RETURN
    END IF
    list = cloud_category_list
  END FUNCTION crtm_cloud_categorylist
  
  
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Cloud_Associated
!
! PURPOSE:
!       Elemental function to test the status of the allocatable components
!       of a CRTM Cloud object.
!
! CALLING SEQUENCE:
!       Status = CRTM_Cloud_Associated( Cloud )
!
! OBJECTS:
!       Cloud:   Cloud structure which is to have its member's
!                status tested.
!                UNITS:      N/A
!                TYPE:       CRTM_Cloud_type
!                DIMENSION:  Scalar or any rank
!                ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       Status:  The return value is a logical value indicating the
!                status of the Cloud 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 Cloud argument
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION crtm_cloud_associated( Cloud ) RESULT( Status )
    TYPE(crtm_cloud_type), INTENT(IN) :: cloud
    LOGICAL :: status
    status = cloud%Is_Allocated
  END FUNCTION crtm_cloud_associated


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

  ELEMENTAL SUBROUTINE crtm_cloud_destroy( Cloud )
    TYPE(crtm_cloud_type), INTENT(OUT) :: cloud
    cloud%Is_Allocated = .false.
  END SUBROUTINE crtm_cloud_destroy


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Cloud_Create
!
! PURPOSE:
!       Elemental subroutine to create an instance of the CRTM Cloud object.
!
! CALLING SEQUENCE:
!       CALL CRTM_Cloud_Create( Cloud, n_Layers )
!
! OBJECTS:
!       Cloud:        Cloud structure.
!                     UNITS:      N/A
!                     TYPE:       CRTM_Cloud_type
!                     DIMENSION:  Scalar or any rank
!                     ATTRIBUTES: INTENT(OUT)
!
! INPUTS:
!       n_Layers:     Number of layers for which there is cloud data.
!                     Must be > 0.
!                     UNITS:      N/A
!                     TYPE:       INTEGER
!                     DIMENSION:  Same as Cloud object
!                     ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE crtm_cloud_create( Cloud, n_Layers )
    ! Arguments
    TYPE(crtm_cloud_type), INTENT(OUT) :: cloud
    INTEGER,               INTENT(IN)  :: n_layers
    ! Local variables
    INTEGER :: alloc_stat

    ! Check input
    IF ( n_layers < 1 ) RETURN

    ! Perform the allocation
    ALLOCATE( cloud%Effective_Radius( n_layers ), &
              cloud%Effective_Variance( n_layers ), &
              cloud%Water_Content( n_layers ), &
              stat = alloc_stat )
    IF ( alloc_stat /= 0 ) RETURN

    ! Initialise
    ! ...Dimensions
    cloud%Max_Layers = n_layers
    cloud%n_Layers   = n_layers
    ! ...Arrays
    cloud%Effective_Radius   = zero
    cloud%Effective_Variance = zero
    cloud%Water_Content      = zero

    ! Set allocation indicator
    cloud%Is_Allocated = .true.

  END SUBROUTINE crtm_cloud_create


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Cloud_AddLayerCopy
!
! PURPOSE:
!       Elemental function to copy an instance of the CRTM Cloud object
!       with additional layers added to the TOA of the input.
!
! CALLING SEQUENCE:
!       cld_out = CRTM_Cloud_AddLayerCopy( cld, n_Added_Layers )
!
! OBJECTS:
!       cld:             Cloud structure to copy.
!                        UNITS:      N/A
!                        TYPE:       CRTM_Cloud_type
!                        DIMENSION:  Scalar or any rank
!                        ATTRIBUTES: INTENT(OUT)
!
! INPUTS:
!       n_Added_Layers:  Number of layers to add to the function result.
!                        UNITS:      N/A
!                        TYPE:       INTEGER
!                        DIMENSION:  Same as Cloud object
!                        ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       cld_out:         Copy of the input Cloud structure with space for
!                        extra layers added to TOA.
!                        UNITS:      N/A
!                        TYPE:       CRTM_Cloud_type
!                        DIMENSION:  Same as input.
!                        ATTRIBUTES: INTENT(OUT)
!
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION crtm_cloud_addlayercopy( &
    cld, &
    n_Added_Layers ) &
  result( cld_out )
    ! Arguments
    TYPE(crtm_cloud_type), INTENT(IN) :: cld
    INTEGER,               INTENT(IN) :: n_added_layers
    ! Function result
    TYPE(crtm_cloud_type) :: cld_out
    ! Local variables
    INTEGER :: na, no, nt

    ! Set the number of extra layers
    na = max(n_added_layers,0)

    ! Create the output structure
    CALL crtm_cloud_create( cld_out, &
                            cld%n_Layers+na )
    IF ( .NOT. crtm_cloud_associated(cld_out) ) RETURN

    ! Assign data
    cld_out%n_Added_Layers = cld%n_Added_Layers+na
    ! ...Layer independent data
    cld_out%Type = cld%Type
    ! ...Layer dependent data
    no = cld%n_Layers
    nt = cld_out%n_Layers
    cld_out%Effective_Radius(na+1:nt)   = cld%Effective_Radius(1:no)
    cld_out%Effective_Variance(na+1:nt) = cld%Effective_Variance(1:no)
    cld_out%Water_Content(na+1:nt)      = cld%Water_Content(1:no)

  END FUNCTION crtm_cloud_addlayercopy


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Cloud_Zero
!
! PURPOSE:
!       Elemental subroutine to zero out the data arrays in a CRTM Cloud object.
!
! CALLING SEQUENCE:
!       CALL CRTM_Cloud_Zero( Cloud )
!
! OBJECTS:
!       Cloud:         CRTM Cloud structure in which the data arrays are
!                      to be zeroed out.
!                      UNITS:      N/A
!                      TYPE:       CRTM_Cloud_type
!                      DIMENSION:  Scalar or any rank
!                      ATTRIBUTES: INTENT(IN OUT)
!
! COMMENTS:
!       - The dimension components of the structure are *NOT* set to zero.
!       - The cloud type component is *NOT* reset.
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE crtm_cloud_zero( Cloud )
    TYPE(crtm_cloud_type), INTENT(IN OUT) :: cloud
    ! Do nothing if structure is unused
    IF ( .NOT. crtm_cloud_associated(cloud) ) RETURN
    ! Only zero out the data arrays
    cloud%Effective_Radius   = zero
    cloud%Effective_Variance = zero
    cloud%Water_Content      = zero
  END SUBROUTINE crtm_cloud_zero


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

  FUNCTION crtm_cloud_isvalid( Cloud ) RESULT( IsValid )
    TYPE(crtm_cloud_type), INTENT(IN) :: cloud
    LOGICAL :: isvalid
    CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Cloud_IsValid'
    CHARACTER(ML) :: msg

    ! Setup
    isvalid = .false.
    ! ...Check if structure is used
    IF ( .NOT. crtm_cloud_associated(cloud) ) THEN
      msg = 'Cloud structure not allocated'
      CALL display_message( routine_name, trim(msg), information )
      RETURN
    ENDIF
    IF ( cloud%n_Layers < 1 ) THEN
      msg = 'Cloud structure dimension invalid'
      CALL display_message( routine_name, trim(msg), information )
      RETURN
    ENDIF

    ! Check data
    ! ...Change default so all entries can be checked
    isvalid = .true.
    ! ...The type of cloud
    IF ( cloud%Type < 1 .OR. cloud%Type > n_valid_cloud_categories ) THEN
      msg = 'Invalid cloud type'
      CALL display_message( routine_name, trim(msg), information )
      isvalid = .false.
    ENDIF
    ! ...Data limits. Only checking negative values
    IF ( any(cloud%Effective_Radius < zero ) ) THEN
      msg = 'Negative cloud effective radius found'
      CALL display_message( routine_name, trim(msg), information )
      isvalid = .false.
    ENDIF
    IF ( any(cloud%Effective_Variance < zero ) ) THEN
      msg = 'Negative cloud effective variance found'
      CALL display_message( routine_name, trim(msg), information )
      isvalid = .false.
    ENDIF
    IF ( any(cloud%Water_Content < zero ) ) THEN
      msg = 'Negative cloud water content found'
      CALL display_message( routine_name, trim(msg), information )
      isvalid = .false.
    ENDIF

  END FUNCTION crtm_cloud_isvalid


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Cloud_Inspect
!
! PURPOSE:
!       Subroutine to print the contents of a CRTM Cloud object to stdout.
!
! CALLING SEQUENCE:
!       CALL CRTM_Cloud_Inspect( Cloud, Unit=unit )
!
! INPUTS:
!       Cloud:  CRTM Cloud object to display.
!               UNITS:      N/A
!               TYPE:       CRTM_Cloud_type
!               DIMENSION:  Scalar, Rank-1, or Rank-2 array
!               ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!       Unit:   Unit number for an already open file to which the output
!               will be written.
!               If the argument is specified and the file unit is not
!               connected, the output goes to stdout.
!               UNITS:      N/A
!               TYPE:       INTEGER
!               DIMENSION:  Scalar
!               ATTRIBUTES: INTENT(IN), OPTIONAL
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE scalar_inspect( Cloud, Unit )
    TYPE(CRTM_Cloud_type), INTENT(IN) :: Cloud
    INTEGER,     OPTIONAL, INTENT(IN) :: Unit
    ! Local variables
    INTEGER :: fid
    
    ! Setup
    fid = output_unit
    IF ( PRESENT(unit) ) THEN
      IF ( file_open(unit) ) fid = unit
    END IF

    
    WRITE(fid,'(1x,"CLOUD OBJECT")')
    WRITE(fid,'(3x,"n_Layers :",1x,i0)') cloud%n_Layers
    WRITE(fid,'(3x,"Category :",1x,a)') crtm_cloud_categoryname(cloud)
    IF ( .NOT. crtm_cloud_associated(cloud) ) RETURN
    WRITE(fid,'(3x,"Effective radius:")')
    WRITE(fid,'(5(1x,es13.6,:))') cloud%Effective_Radius
    WRITE(fid,'(3x,"Water content:")')
    WRITE(fid,'(5(1x,es13.6,:))') cloud%Water_Content
  END SUBROUTINE scalar_inspect

  SUBROUTINE rank1_inspect( Cloud, Unit )
    TYPE(CRTM_Cloud_type), INTENT(IN) :: Cloud(:)
    INTEGER,     OPTIONAL, INTENT(IN) :: Unit
    INTEGER :: fid
    INTEGER :: i
    fid = output_unit
    IF ( PRESENT(unit) ) THEN
      IF ( file_open(unit) ) fid = unit
    END IF
    DO i = 1, SIZE(cloud)
      WRITE(fid, fmt='(1x,"RANK-1 INDEX:",i0," - ")', advance='NO') i
      CALL scalar_inspect(cloud(i), unit=unit)
    END DO
  END SUBROUTINE rank1_inspect

  SUBROUTINE rank2_inspect( Cloud, Unit )
    TYPE(CRTM_Cloud_type), INTENT(IN) :: Cloud(:,:)
    INTEGER,     OPTIONAL, INTENT(IN) :: Unit
    INTEGER :: fid
    INTEGER :: i, j
    fid = output_unit
    IF ( PRESENT(unit) ) THEN
      IF ( file_open(unit) ) fid = unit
    END IF
    DO j = 1, SIZE(cloud,2)
      DO i = 1, SIZE(cloud,1)
        WRITE(fid, fmt='(1x,"RANK-2 INDEX:",i0,",",i0," - ")', advance='NO') i,j
        CALL scalar_inspect(cloud(i,j), unit=unit)
      END DO
    END DO
  END SUBROUTINE rank2_inspect


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


!------------------------------------------------------------------------------
!:sdoc+:
! NAME:
!       CRTM_Cloud_Compare
!
! PURPOSE:
!       Elemental function to compare two CRTM_Cloud objects to within
!       a user specified number of significant figures.
!
! CALLING SEQUENCE:
!       is_comparable = CRTM_Cloud_Compare( x, y, n_SigFig=n_SigFig )
!
! OBJECTS:
!       x, y:          Two CRTM Cloud objects to be compared.
!                      UNITS:      N/A
!                      TYPE:       CRTM_Cloud_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_cloud_compare( &
    x, &
    y, &
    n_SigFig ) &
  result( is_comparable )
    TYPE(crtm_cloud_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 the structure association status
    IF ( (.NOT. crtm_cloud_associated(x)) .OR. &
         (.NOT. crtm_cloud_associated(y)) ) RETURN

    ! Check scalars
    IF ( (x%n_Layers /= y%n_Layers) .OR. &
         (x%Type     /= y%Type    ) ) RETURN

    ! Check arrays
    IF ( (.NOT. all(compares_within_tolerance(x%Effective_Radius  ,y%Effective_Radius  ,n))) .OR. &
         (.NOT. all(compares_within_tolerance(x%Effective_Variance,y%Effective_Variance,n))) .OR. &
         (.NOT. all(compares_within_tolerance(x%Water_Content     ,y%Water_Content     ,n))) ) RETURN

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

  END FUNCTION crtm_cloud_compare


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Cloud_SetLayers
!
! PURPOSE:
!       Elemental subroutine to set the working number of layers to use
!       in a CRTM Cloud object.
!
! CALLING SEQUENCE:
!      CALL CRTM_Cloud_SetLayers( Cloud, n_Layers )
!
! OBJECT:
!       Cloud:        CRTM Cloud object which is to have its working number
!                     of layers updated.
!                     UNITS:      N/A
!                     TYPE:       CRTM_Cloud_type
!                     DIMENSION:  Scalar or any rank
!                     ATTRIBUTES: INTENT(IN OUT)
!
! INPUTS:
!       n_Layers:     The value to set the n_Layers component of the
!                     Cloud object.
!                     UNITS:      N/A
!                     TYPE:       CRTM_Cloud_type
!                     DIMENSION:  Conformable with the Cloud object argument
!                     ATTRIBUTES: INTENT(IN)
!
! COMMENTS:
!       - The object is zeroed upon output.
!
!       - If n_Layers <= Cloud%Max_Layers, then only the dimension value
!         of the object is changed.
!
!       - If n_Layers > Cloud%Max_Layers, then the object is reallocated
!         to the required number of layers.
!
!:sdoc-:
!--------------------------------------------------------------------------------

  ELEMENTAL SUBROUTINE crtm_cloud_setlayers( Cloud, n_Layers )
    TYPE(crtm_cloud_type), INTENT(IN OUT) :: cloud
    INTEGER,               INTENT(IN)     :: n_layers
    IF ( n_layers < cloud%Max_Layers ) THEN
      cloud%n_Layers = n_layers
      CALL crtm_cloud_zero(cloud)
    ELSE
      CALL crtm_cloud_create( cloud, n_layers )
    END IF
  END SUBROUTINE crtm_cloud_setlayers


!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Cloud_InquireFile
!
! PURPOSE:
!       Function to inquire CRTM Cloud object files.
!
! CALLING SEQUENCE:
!       Error_Status = CRTM_Cloud_InquireFile( Filename           , &
!                                              n_Clouds = n_Clouds  )
!
! INPUTS:
!       Filename:       Character string specifying the name of a
!                       CRTM Cloud data file to read.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
! OPTIONAL OUTPUTS:
!       n_Clouds:       The number of Cloud 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_cloud_inquirefile( &
    Filename, &  ! Input
    n_Clouds) &  ! Optional output
  result( err_stat )
    ! Arguments
    CHARACTER(*),           INTENT(IN)  :: filename
    INTEGER     , OPTIONAL, INTENT(OUT) :: n_clouds
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Cloud_InquireFile'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    INTEGER :: io_stat
    INTEGER :: fid
    INTEGER :: nc

    ! Setup
    err_stat = success


    ! Open the cloud data 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 clouds dimension
    READ( fid,iostat=io_stat,iomsg=io_msg ) nc
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading n_Clouds dimension 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_clouds) ) n_clouds = nc

  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_cloud_inquirefile


!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Cloud_ReadFile
!
! PURPOSE:
!       Function to read CRTM Cloud object files.
!
! CALLING SEQUENCE:
!       Error_Status = CRTM_Cloud_ReadFile( Filename           , &
!                                           Cloud              , &
!                                           Quiet    = Quiet   , &
!                                           No_Close = No_Close, &
!                                           n_Clouds = n_Clouds  )
!
! INPUTS:
!       Filename:       Character string specifying the name of a
!                       Cloud format data file to read.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
!       Cloud:          CRTM Cloud object array containing the Cloud data.
!                       UNITS:      N/A
!                       TYPE:       CRTM_Cloud_type
!                       DIMENSION:  Rank-1
!                       ATTRIBUTES: INTENT(OUT), ALLOCATABLE
!
! 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
!
!       No_Close:       Set this logical argument to NOT close the file upon exit.
!                       If == .FALSE., the input file is closed upon exit [DEFAULT]
!                          == .TRUE.,  the input file is NOT closed upon exit.
!                       If not specified, default is .FALSE.
!                       UNITS:      N/A
!                       TYPE:       LOGICAL
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN), OPTIONAL
!
! OPTIONAL OUTPUTS:
!       n_Clouds:       The actual number of cloud profiles read in.
!                       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 crtm_cloud_readfile( &
    Filename, &  ! Input
    Cloud   , &  ! Output
    Quiet   , &  ! Optional input
    No_Close, &  ! Optional input
    n_Clouds, &  ! Optional output
    Debug   ) &  ! Optional input (Debug output control)
  result( err_stat )
    ! Arguments
    CHARACTER(*),                        INTENT(IN)  :: filename
    TYPE(crtm_cloud_type) , ALLOCATABLE, INTENT(OUT) :: cloud(:)
    LOGICAL,      OPTIONAL,              INTENT(IN)  :: quiet
    LOGICAL,      OPTIONAL,              INTENT(IN)  :: no_close
    INTEGER,      OPTIONAL,              INTENT(OUT) :: n_clouds
    LOGICAL,      OPTIONAL,              INTENT(IN)  :: debug
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Cloud_ReadFile'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    CHARACTER(ML) :: alloc_msg
    INTEGER :: io_stat
    INTEGER :: alloc_stat
    LOGICAL :: noisy
    LOGICAL :: yes_close
    INTEGER :: fid
    INTEGER :: m
    INTEGER :: nc

    ! Setup
    err_stat = success
    ! ...Check Quiet argument
    noisy = .true.
    IF ( PRESENT(quiet) ) noisy = .NOT. quiet
    ! ...Check file close argument
    yes_close = .true.
    IF ( PRESENT(no_close) ) yes_close = .NOT. no_close
    ! ...Override Quiet settings if debug set.
    IF ( PRESENT(debug) ) noisy = debug


    ! Check if the file is open
    IF ( file_open( filename ) ) THEN
      ! Yes, the file is already open
      ! ...Get the file id
      INQUIRE( file=filename,number=fid )
      IF ( fid == -1 ) THEN
        msg = 'Error inquiring '//trim(filename)//' for its unit number'
        CALL read_cleanup(); RETURN
      END IF
    ELSE
      ! No, the file is not open
      ! ...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
    END IF


    ! Read the number of clouds dimension
    READ( fid,iostat=io_stat,iomsg=io_msg ) nc
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading n_Clouds data dimension from '//trim(filename)//' - '//trim(io_msg)
      CALL read_cleanup(); RETURN
    END IF
    ! ...Allocate the return structure array
    ALLOCATE(cloud(nc), stat=alloc_stat, errmsg=alloc_msg)
    IF ( alloc_stat /= 0 ) THEN
      msg = 'Error allocating Cloud array - '//trim(alloc_msg)
      CALL read_cleanup(); RETURN
    END IF


    ! Read the cloud data
    cloud_loop: DO m = 1, nc
      err_stat = read_record( fid, cloud(m) )
      IF ( err_stat /= success ) THEN
        WRITE( msg,'("Error reading Cloud element #",i0," from ",a)' ) m, trim(filename)
        CALL read_cleanup(); RETURN
      END IF
    END DO cloud_loop


    ! Close the file
    IF ( yes_close ) 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


    ! Set the optional return values
    IF ( PRESENT(n_clouds) ) n_clouds = nc


    ! Output an info message
    IF ( noisy ) THEN
      WRITE( msg,'("Number of clouds read from ",a,": ",i0)' ) trim(filename), nc
      CALL display_message( routine_name, msg, information )
    END IF

  CONTAINS

    SUBROUTINE read_cleanup()
      IF ( file_open(fid) ) THEN
        CLOSE( fid,iostat=io_stat,iomsg=io_msg )
        IF ( io_stat /= 0 ) &
          msg = trim(msg)//'; Error closing input file during error cleanup - '//trim(io_msg)
      END IF
      IF ( ALLOCATED(cloud) ) THEN 
        DEALLOCATE(cloud, stat=alloc_stat, errmsg=alloc_msg)
        IF ( alloc_stat /= 0 ) &
          msg = trim(msg)//'; Error deallocating Cloud array during error cleanup - '//&
                trim(alloc_msg)
      END IF
      err_stat = failure
      CALL display_message( routine_name, msg, err_stat )
    END SUBROUTINE read_cleanup

  END FUNCTION crtm_cloud_readfile


!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Cloud_WriteFile
!
! PURPOSE:
!       Function to write CRTM Cloud object files.
!
! CALLING SEQUENCE:
!       Error_Status = CRTM_Cloud_WriteFile( Filename           , &
!                                            Cloud              , &
!                                            Quiet    = Quiet   , &
!                                            No_Close = No_Close  )
!
! INPUTS:
!       Filename:       Character string specifying the name of the
!                       Cloud format data file to write.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       Cloud:          CRTM Cloud object array containing the Cloud data.
!                       UNITS:      N/A
!                       TYPE:       CRTM_Cloud_type
!                       DIMENSION:  Rank-1
!                       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
!
!       No_Close:       Set this logical argument to NOT close the file upon exit.
!                       If == .FALSE., the input file is closed upon exit [DEFAULT]
!                          == .TRUE.,  the input file is NOT closed upon exit.
!                       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 crtm_cloud_writefile( &
    Filename, &  ! Input
    Cloud   , &  ! Input
    Quiet   , &  ! Optional input
    No_Close, &  ! Optional input
    Debug   ) &  ! Optional input (Debug output control)
  result( err_stat )
    ! Arguments
    CHARACTER(*),           INTENT(IN)  :: filename
    TYPE(crtm_cloud_type) , INTENT(IN)  :: cloud(:)
    LOGICAL,      OPTIONAL, INTENT(IN)  :: quiet
    LOGICAL,      OPTIONAL, INTENT(IN)  :: no_close
    LOGICAL,      OPTIONAL, INTENT(IN)  :: debug
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Cloud_WriteFile'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    INTEGER :: io_stat
    LOGICAL :: noisy
    LOGICAL :: yes_close
    INTEGER :: fid
    INTEGER :: m, nc

    ! Setup
    err_stat = success
    ! ...Check Quiet argument
    noisy = .true.
    IF ( PRESENT(quiet) ) noisy = .NOT. quiet
    ! ...Check file close argument
    yes_close = .true.
    IF ( PRESENT(no_close) ) yes_close = .NOT. no_close
    ! ...Override Quiet settings if debug set.
    IF ( PRESENT(debug) ) noisy = debug


    ! Check the Cloud structure dimensions
    IF ( any(cloud%n_Layers < 1) ) THEN
      msg = 'Dimensions of Cloud structures are < or = 0.'
      CALL write_cleanup(); RETURN
    END IF


    ! Check if the file is open
    IF ( file_open( filename ) ) THEN
      ! Yes, the file is already open
      INQUIRE( file=filename,number=fid )
      IF ( fid == -1 ) THEN
        msg = 'Error inquiring '//trim(filename)//' for its unit number'
        CALL write_cleanup(); RETURN
      END IF
    ELSE
      ! No, the file is not open
      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 number of clouds dimension
    nc = SIZE(cloud)
    WRITE( fid,iostat=io_stat,iomsg=io_msg ) nc
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing n_Clouds data dimension to '//trim(filename)//'- '//trim(io_msg)
      CALL write_cleanup(); RETURN
    END IF


    ! Write the cloud data
    cloud_loop: DO m = 1, nc
      err_stat = write_record( fid, cloud(m) )
      IF ( err_stat /= success ) THEN
        WRITE( msg,'("Error writing Cloud element #",i0," to ",a)' ) m, trim(filename)
        CALL write_cleanup(); RETURN
      END IF
    END DO cloud_loop


    ! Close the file (if error, no delete)
    IF ( yes_close ) THEN
      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
    END IF


    ! Output an info message
    IF ( noisy ) THEN
      WRITE( msg,'("Number of clouds written to ",a,": ",i0)' ) trim(filename), nc
      CALL display_message( routine_name, msg, information )
    END IF

  CONTAINS

    SUBROUTINE write_cleanup()
      IF ( file_open(fid) ) 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 crtm_cloud_writefile



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

!------------------------------------------------------------------------------
!
! NAME:
!       CRTM_Cloud_Equal
!
! PURPOSE:
!       Elemental function to test the equality of two CRTM_Cloud objects.
!       Used in OPERATOR(==) interface block.
!
! CALLING SEQUENCE:
!       is_equal = CRTM_Cloud_Equal( x, y )
!
!         or
!
!       IF ( x == y ) THEN
!         ...
!       END IF
!
! OBJECTS:
!       x, y:          Two CRTM Cloud objects to be compared.
!                      UNITS:      N/A
!                      TYPE:       CRTM_Cloud_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_cloud_equal( x, y ) RESULT( is_equal )
    TYPE(crtm_cloud_type) , INTENT(IN)  :: x, y
    LOGICAL :: is_equal
    ! Variables
    INTEGER :: n

    ! Set up
    is_equal = .false.

    ! Check the structure association status
    IF ( (.NOT. crtm_cloud_associated(x)) .OR. &
         (.NOT. crtm_cloud_associated(y))      ) RETURN

    ! Check contents
    ! ...Scalars
    IF ( (x%n_Layers /= y%n_Layers) .OR. (x%Type /= y%Type) ) RETURN
    ! ...Arrays
    n = x%n_Layers
    IF ( all(x%Effective_Radius(1:n)   .equalto. y%Effective_Radius(1:n)  ) .AND. &
         all(x%Effective_Variance(1:n) .equalto. y%Effective_Variance(1:n)) .AND. &
         all(x%Water_Content(1:n)      .equalto. y%Water_Content(1:n)     )       ) &
      is_equal = .true.

  END FUNCTION crtm_cloud_equal


!--------------------------------------------------------------------------------
!
! NAME:
!       CRTM_Cloud_Add
!
! PURPOSE:
!       Pure function to add two CRTM Cloud objects.
!       Used in OPERATOR(+) interface block.
!
! CALLING SEQUENCE:
!       cldsum = CRTM_Cloud_Add( cld1, cld2 )
!
!         or
!
!       cldsum = cld1 + cld2
!
!
! INPUTS:
!       cld1, cld2: The Cloud objects to add.
!                   UNITS:      N/A
!                   TYPE:       CRTM_Cloud_type
!                   DIMENSION:  Scalar or any rank
!                   ATTRIBUTES: INTENT(IN OUT)
!
! RESULT:
!       cldsum:     Cloud structure containing the added components.
!                   UNITS:      N/A
!                   TYPE:       CRTM_Cloud_type
!                   DIMENSION:  Same as input
!
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION crtm_cloud_add( cld1, cld2 ) RESULT( cldsum )
    TYPE(crtm_cloud_type), INTENT(IN) :: cld1, cld2
    TYPE(crtm_cloud_type) :: cldsum
    ! Variables
    INTEGER :: n

    ! Check input
    ! ...If input structures not used, do nothing
    IF ( .NOT. crtm_cloud_associated( cld1 ) .OR. &
         .NOT. crtm_cloud_associated( cld2 )      ) RETURN
    ! ...If input structure for different clouds, or sizes, do nothing
    IF ( cld1%Type           /= cld2%Type           .OR. &
         cld1%n_Layers       /= cld2%n_Layers       .OR. &
         cld1%n_Added_Layers /= cld2%n_Added_Layers      ) RETURN

    ! Copy the first structure
    cldsum = cld1

    ! And add its components to the second one
    n = cld1%n_Layers
    cldsum%Effective_Radius(1:n)   = cldsum%Effective_Radius(1:n)   + cld2%Effective_Radius(1:n)
    cldsum%Effective_Variance(1:n) = cldsum%Effective_Variance(1:n) + cld2%Effective_Variance(1:n)
    cldsum%Water_Content(1:n)      = cldsum%Water_Content(1:n)      + cld2%Water_Content(1:n)

  END FUNCTION crtm_cloud_add


!--------------------------------------------------------------------------------
!
! NAME:
!       CRTM_Cloud_Subtract
!
! PURPOSE:
!       Pure function to subtract two CRTM Cloud objects.
!       Used in OPERATOR(-) interface block.
!
! CALLING SEQUENCE:
!       clddiff = CRTM_Cloud_Subtract( cld1, cld2 )
!
!         or
!
!       clddiff = cld1 - cld2
!
!
! INPUTS:
!       cld1, cld2: The Cloud objects to difference.
!                   UNITS:      N/A
!                   TYPE:       CRTM_Cloud_type
!                   DIMENSION:  Scalar or any rank
!                   ATTRIBUTES: INTENT(IN OUT)
!
! RESULT:
!       clddiff:    Cloud structure containing the differenced components.
!                   UNITS:      N/A
!                   TYPE:       CRTM_Cloud_type
!                   DIMENSION:  Same as input
!
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION crtm_cloud_subtract( cld1, cld2 ) RESULT( clddiff )
    TYPE(crtm_cloud_type), INTENT(IN) :: cld1, cld2
    TYPE(crtm_cloud_type) :: clddiff
    ! Variables
    INTEGER :: n

    ! Check input
    ! ...If input structures not used, do nothing
    IF ( .NOT. crtm_cloud_associated( cld1 ) .OR. &
         .NOT. crtm_cloud_associated( cld2 )      ) RETURN
    ! ...If input structure for different clouds, or sizes, do nothing
    IF ( cld1%Type           /= cld2%Type           .OR. &
         cld1%n_Layers       /= cld2%n_Layers       .OR. &
         cld1%n_Added_Layers /= cld2%n_Added_Layers      ) RETURN

    ! Copy the first structure
    clddiff = cld1

    ! And subtract the second one's components from it
    n = cld1%n_Layers
    clddiff%Effective_Radius(1:n)   = clddiff%Effective_Radius(1:n)   - cld2%Effective_Radius(1:n)
    clddiff%Effective_Variance(1:n) = clddiff%Effective_Variance(1:n) - cld2%Effective_Variance(1:n)
    clddiff%Water_Content(1:n)      = clddiff%Water_Content(1:n)      - cld2%Water_Content(1:n)

  END FUNCTION crtm_cloud_subtract


!
! NAME:
!       Read_Record
!
! PURPOSE:
!       Utility function to read a single CRTM Cloud object in binary format
!

  FUNCTION read_record( &
    fid  , &  ! Input
    cloud) &  ! Output
  result( err_stat )
    ! Arguments
    INTEGER               , INTENT(IN)  :: fid
    TYPE(crtm_cloud_type) , INTENT(OUT) :: cloud
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Cloud_ReadFile(Record)'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    INTEGER :: io_stat
    INTEGER :: n_layers

    ! Set up
    err_stat = success


    ! Read the dimensions
    READ( fid,iostat=io_stat,iomsg=io_msg ) n_layers
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading n_Layers dimension - '//trim(io_msg)
      CALL read_record_cleanup(); RETURN
    END IF


    ! Allocate the structure
    CALL crtm_cloud_create( cloud, n_layers )
    IF ( .NOT. crtm_cloud_associated( cloud ) ) THEN
      msg = 'Cloud object allocation failed.'
      CALL read_record_cleanup(); RETURN
    END IF


    ! Read the cloud data
    READ( fid,iostat=io_stat,iomsg=io_msg ) &
      cloud%Type, &
      cloud%Effective_Radius, &
      cloud%Effective_Variance, &
      cloud%Water_Content
    IF ( io_stat /= 0 ) THEN
      msg = 'Error reading Cloud data - '//trim(io_msg)
      CALL read_record_cleanup(); RETURN
    END IF

  CONTAINS

    SUBROUTINE read_record_cleanup()
      CALL crtm_cloud_destroy( cloud )
      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:
!       Function to write a single CRTM Cloud object in binary format
!

  FUNCTION write_record( &
    fid   , &  ! Input
    cloud ) &  ! Input
  result( err_stat )
    ! Arguments
    INTEGER               , INTENT(IN)  :: fid
    TYPE(crtm_cloud_type) , INTENT(IN)  :: cloud
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Cloud_WriteFile(Record)'
    ! Function variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: io_msg
    INTEGER :: io_stat

    ! Setup
    err_stat = success
    IF ( .NOT. crtm_cloud_associated( cloud ) ) THEN
      msg = 'Input Cloud object is not used.'
      CALL write_record_cleanup(); RETURN
    END IF


    ! Write the dimensions
    WRITE( fid,iostat=io_stat,iomsg=io_msg ) cloud%n_Layers
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing dimensions - '//trim(io_msg)
      CALL write_record_cleanup(); RETURN
    END IF


    ! Write the data
    WRITE( fid,iostat=io_stat,iomsg=io_msg ) &
      cloud%Type, &
      cloud%Effective_Radius(1:cloud%n_Layers), &
      cloud%Effective_Variance(1:cloud%n_Layers), &
      cloud%Water_Content(1:cloud%n_Layers)
    IF ( io_stat /= 0 ) THEN
      msg = 'Error writing Cloud data - '//trim(io_msg)
      CALL write_record_cleanup(); RETURN
    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'
      err_stat = failure
      CALL display_message( routine_name, trim(msg), err_stat )
    END SUBROUTINE write_record_cleanup

  END FUNCTION write_record

END MODULE crtm_cloud_define