<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
!
! MWwaterCoeff_Define
!
! Module defining the MWwaterCoeff object.
!
!
! CREATION HISTORY:
! Written by: Paul van Delst, 10-Nov-2011
! paul.vandelst@noaa.gov
<A NAME='MWWATERCOEFF_DEFINE'><A href='../../html_code/crtm/MWwaterCoeff_Define.f90.html#MWWATERCOEFF_DEFINE' TARGET='top_target'><IMG SRC="../../gif/bar_purple.gif" border=0></A>
MODULE MWwaterCoeff_Define 2,9
! -----------------
! Environment setup
! -----------------
! Module use
USE Type_Kinds
, ONLY: fp, Long, Double
USE Message_Handler , ONLY: SUCCESS, FAILURE, INFORMATION, Display_Message
USE Compare_Float_Numbers, ONLY: OPERATOR(.EqualTo.)
USE File_Utility , ONLY: File_Open, File_Exists
USE Binary_File_Utility , ONLY: Open_Binary_File , &
WriteGAtts_Binary_File, &
ReadGAtts_Binary_File
USE FitCoeff_Define
USE MWwaterLUT_Define
! Disable implicit typing
IMPLICIT NONE
! ------------
! Visibilities
! ------------
! Everything private by default
PRIVATE
! Datatypes
PUBLIC :: MWwaterCoeff_type
! Operators
PUBLIC :: OPERATOR(==)
! Procedures
PUBLIC :: MWwaterCoeff_Associated
PUBLIC :: MWwaterCoeff_Destroy
PUBLIC :: MWwaterCoeff_Create
PUBLIC :: MWwaterCoeff_Inspect
PUBLIC :: MWwaterCoeff_ValidRelease
PUBLIC :: MWwaterCoeff_Info
PUBLIC :: MWwaterCoeff_DefineVersion
PUBLIC :: MWwaterCoeff_ReadFile
PUBLIC :: MWwaterCoeff_WriteFile
! ---------------------
! Procedure overloading
! ---------------------
<A NAME='OPERATOR'><A href='../../html_code/crtm/MWwaterCoeff_Define.f90.html#OPERATOR' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
INTERFACE OPERATOR(==)
MODULE PROCEDURE
END INTERFACE OPERATOR(==)
! -----------------
! Module parameters
! -----------------
CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = &
'$Id: MWwaterCoeff_Define.f90 29405 2013-06-20 20:19:52Z paul.vandelst@noaa.gov $'
! Release and version
INTEGER, PARAMETER :: MWWATERCOEFF_RELEASE = 1 ! This determines structure and file formats.
INTEGER, PARAMETER :: MWWATERCOEFF_VERSION = 1 ! This is just the default data version.
! Close status for write errors
CHARACTER(*), PARAMETER :: WRITE_ERROR_STATUS = 'DELETE'
! Data indicators
INTEGER, PARAMETER :: DATA_MISSING = 0
INTEGER, PARAMETER :: DATA_PRESENT = 1
! String lengths
INTEGER, PARAMETER :: ML = 256 ! Message length
INTEGER, PARAMETER :: SL = 80 ! String length
! ---------------------------------
! MWwaterCoeff data type definition
! ---------------------------------
!:tdoc+:
TYPE :: MWwaterCoeff_type
! Allocation indicator
LOGICAL :: Is_Allocated = .FALSE.
! Release and version information
INTEGER(Long) :: Release = MWWATERCOEFF_RELEASE
INTEGER(Long) :: Version = MWWATERCOEFF_VERSION
! Derived type components
TYPE(FitCoeff_1D_type) :: FCCoeff ! Foam coverage fitting coefficients
TYPE(FitCoeff_1D_type) :: FRCoeff ! Foam reflectivity fitting coefficients
TYPE(FitCoeff_3D_type) :: RCCoeff ! Reflection correction fitting coefficients
TYPE(FitCoeff_3D_type) :: AZCoeff ! Azimuth emissivity fitting coefficients
TYPE(FitCoeff_1D_type) :: SSCCoeff ! Small-scale correction fitting coefficients
TYPE(FitCoeff_3D_type) :: LSCCoeff ! Large-scale correction fitting coefficients
TYPE(MWwaterLUT_type) :: LUT ! Emissivity look-up table
END TYPE MWwaterCoeff_type
!:tdoc-:
CONTAINS
!################################################################################
!################################################################################
!## ##
!## ## PUBLIC PROCEDURES ## ##
!## ##
!################################################################################
!################################################################################
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! MWwaterCoeff_Associated
!
! PURPOSE:
! Pure function to test the status of the allocatable components
! of the MWwaterCoeff structure.
!
! CALLING SEQUENCE:
! Status = MWwaterCoeff_Associated( MWwaterCoeff )
!
! OBJECTS:
! MWwaterCoeff: Structure which is to have its member's
! status tested.
! UNITS: N/A
! TYPE: MWwaterCoeff_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
! Status: The return value is a logical value indicating the
! status of the components.
! .TRUE. - if ALL of the MWwaterCoeff allocatable members
! are in use.
! .FALSE. - if ANY of the MWwaterCoeff allocatable members
! are not in use.
! UNITS: N/A
! TYPE: LOGICAL
! DIMENSION: Scalar
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='MWWATERCOEFF_ASSOCIATED'><A href='../../html_code/crtm/MWwaterCoeff_Define.f90.html#MWWATERCOEFF_ASSOCIATED' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
PURE FUNCTION MWwaterCoeff_Associated( self ) RESULT( Status ) 1
TYPE(MWwaterCoeff_type), INTENT(IN) :: self
LOGICAL :: Status
Status = self%Is_Allocated
END FUNCTION MWwaterCoeff_Associated
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! MWwaterCoeff_Destroy
!
! PURPOSE:
! Pure subroutine to re-initialize MWwaterCoeff objects.
!
! CALLING SEQUENCE:
! CALL MWwaterCoeff_Destroy( MWwaterCoeff )
!
! OBJECTS:
! MWwaterCoeff: Re-initialized MWwaterCoeff structure.
! UNITS: N/A
! TYPE: MWwaterCoeff_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='MWWATERCOEFF_DESTROY'><A href='../../html_code/crtm/MWwaterCoeff_Define.f90.html#MWWATERCOEFF_DESTROY' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
PURE SUBROUTINE MWwaterCoeff_Destroy( self ) 2
TYPE(MWwaterCoeff_type), INTENT(OUT) :: self
self%Is_Allocated = .FALSE.
END SUBROUTINE MWwaterCoeff_Destroy
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! MWwaterCoeff_Create
!
! PURPOSE:
! Pure subroutine to create a valid instance of an MWwaterCoeff object.
!
! CALLING SEQUENCE:
! CALL MWwaterCoeff_Create( MWwaterCoeff )
!
! OBJECTS:
! MWwaterCoeff: MWwaterCoeff object structure.
! UNITS: N/A
! TYPE: MWwaterCoeff_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='MWWATERCOEFF_CREATE'><A href='../../html_code/crtm/MWwaterCoeff_Define.f90.html#MWWATERCOEFF_CREATE' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
PURE SUBROUTINE MWwaterCoeff_Create( & 1
self ) ! Output
! Arguments
TYPE(MWwaterCoeff_type), INTENT(IN OUT) :: self
! Set allocation indicator
self%Is_Allocated = .TRUE.
END SUBROUTINE MWwaterCoeff_Create
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! MWwaterCoeff_Inspect
!
! PURPOSE:
! Subroutine to print the contents of a MWwaterCoeff object to stdout.
!
! CALLING SEQUENCE:
! CALL MWwaterCoeff_Inspect( MWwaterCoeff )
!
! OBJECTS:
! MWwaterCoeff: MWwaterCoeff object to display.
! UNITS: N/A
! TYPE: MWwaterCoeff_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='MWWATERCOEFF_INSPECT'><A href='../../html_code/crtm/MWwaterCoeff_Define.f90.html#MWWATERCOEFF_INSPECT' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE MWwaterCoeff_Inspect( self, pause ),7
TYPE(MWwaterCoeff_type), INTENT(IN) :: self
LOGICAL, OPTIONAL, INTENT(IN) :: pause
LOGICAL :: wait
wait = .FALSE.
IF ( PRESENT(pause) ) wait = pause
WRITE(*,'(1x,"MWwaterCoeff OBJECT")')
! Release/version info
WRITE(*,'(3x,"Release.Version : ",i0,".",i0)') self%Release, self%Version
IF ( .NOT. MWwaterCoeff_Associated(self) ) RETURN
! Derived types
IF ( FitCoeff_Associated(self%FCCoeff ) ) THEN
WRITE(*,'(1x,"Foam coverage cofficients, ")',ADVANCE='NO')
CALL FitCoeff_Inspect(self%FCCoeff )
END IF
IF ( FitCoeff_Associated(self%FRCoeff ) ) THEN
WRITE(*,'(1x,"Foam reflectivity cofficients, ")',ADVANCE='NO')
CALL FitCoeff_Inspect(self%FRCoeff )
END IF
IF ( FitCoeff_Associated(self%RCCoeff) ) THEN
WRITE(*,'(1x,"Reflection correction cofficients, ")',ADVANCE='NO')
CALL FitCoeff_Inspect(self%RCCoeff)
END IF
IF ( FitCoeff_Associated(self%AZCoeff) ) THEN
WRITE(*,'(1x,"Azimuth emissivity coefficients, ")',ADVANCE='NO')
CALL FitCoeff_Inspect(self%AZCoeff)
END IF
IF ( FitCoeff_Associated(self%SSCCoeff) ) THEN
WRITE(*,'(1x,"Small-scale correction coefficients, ")',ADVANCE='NO')
CALL FitCoeff_Inspect(self%SSCCoeff)
END IF
IF ( FitCoeff_Associated(self%LSCCoeff) ) THEN
WRITE(*,'(1x,"Large-scale correction coefficients, ")',ADVANCE='NO')
CALL FitCoeff_Inspect(self%LSCCoeff)
END IF
IF ( MWwaterLUT_Associated(self%LUT) ) THEN
WRITE(*,'(1x,"Emissivity look-up table, ")',ADVANCE='NO')
CALL MWwaterLUT_Inspect(self%LUT,pause=pause)
END IF
END SUBROUTINE MWwaterCoeff_Inspect
!----------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! MWwaterCoeff_ValidRelease
!
! PURPOSE:
! Function to check the MWwaterCoeff Release value.
!
! CALLING SEQUENCE:
! IsValid = MWwaterCoeff_ValidRelease( MWwaterCoeff )
!
! INPUTS:
! MWwaterCoeff: MWwaterCoeff object for which the Release component
! is to be checked.
! UNITS: N/A
! TYPE: MWwaterCoeff_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
! IsValid: Logical value defining the release validity.
! UNITS: N/A
! TYPE: LOGICAL
! DIMENSION: Scalar
!
!:sdoc-:
!----------------------------------------------------------------------------------
<A NAME='MWWATERCOEFF_VALIDRELEASE'><A href='../../html_code/crtm/MWwaterCoeff_Define.f90.html#MWWATERCOEFF_VALIDRELEASE' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
FUNCTION MWwaterCoeff_ValidRelease( self ) RESULT( IsValid ),2
! Arguments
TYPE(MWwaterCoeff_type), INTENT(IN) :: self
! Function result
LOGICAL :: IsValid
! Local parameters
CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'MWwaterCoeff_ValidRelease'
! Local variables
CHARACTER(ML) :: msg
! Set up
IsValid = .TRUE.
! Check release is not too old
IF ( self%Release < MWWATERCOEFF_RELEASE ) THEN
IsValid = .FALSE.
WRITE( msg,'("An MWwaterCoeff data update is needed. ", &
&"MWwaterCoeff release is ",i0,". Valid release is ",i0,"." )' ) &
self%Release, MWWATERCOEFF_RELEASE
CALL Display_Message( ROUTINE_NAME, msg, INFORMATION ); RETURN
END IF
! Check release is not too new
IF ( self%Release > MWWATERCOEFF_RELEASE ) THEN
IsValid = .FALSE.
WRITE( msg,'("An MWwaterCoeff software update is needed. ", &
&"MWwaterCoeff release is ",i0,". Valid release is ",i0,"." )' ) &
self%Release, MWWATERCOEFF_RELEASE
CALL Display_Message( ROUTINE_NAME, msg, INFORMATION ); RETURN
END IF
END FUNCTION MWwaterCoeff_ValidRelease
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! MWwaterCoeff_Info
!
! PURPOSE:
! Subroutine to return a string containing version and dimension
! information about a MWwaterCoeff object.
!
! CALLING SEQUENCE:
! CALL MWwaterCoeff_Info( MWwaterCoeff, Info )
!
! OBJECTS:
! MWwaterCoeff: MWwaterCoeff object about which info is required.
! UNITS: N/A
! TYPE: MWwaterCoeff_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
! Info: String containing version and dimension information
! about the MWwaterCoeff object.
! UNITS: N/A
! TYPE: CHARACTER(*)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='MWWATERCOEFF_INFO'><A href='../../html_code/crtm/MWwaterCoeff_Define.f90.html#MWWATERCOEFF_INFO' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE MWwaterCoeff_Info( self, Info ) 2
! Arguments
TYPE(MWwaterCoeff_type), INTENT(IN) :: self
CHARACTER(*), INTENT(OUT) :: Info
! Parameters
INTEGER, PARAMETER :: CARRIAGE_RETURN = 13
INTEGER, PARAMETER :: LINEFEED = 10
! Local variables
CHARACTER(2000) :: Long_String
! Write the required data to the local string
WRITE( Long_String, &
'(a,1x,"MWwaterCoeff RELEASE.VERSION: ",i0,".",i0 )' ) &
ACHAR(CARRIAGE_RETURN)//ACHAR(LINEFEED), &
self%Release, self%Version
! Trim the output based on the
! dummy argument string length
Info = Long_String(1:MIN(LEN(Info), LEN_TRIM(Long_String)))
END SUBROUTINE MWwaterCoeff_Info
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! MWwaterCoeff_DefineVersion
!
! PURPOSE:
! Subroutine to return the module version information.
!
! CALLING SEQUENCE:
! CALL MWwaterCoeff_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-:
!--------------------------------------------------------------------------------
<A NAME='MWWATERCOEFF_DEFINEVERSION'><A href='../../html_code/crtm/MWwaterCoeff_Define.f90.html#MWWATERCOEFF_DEFINEVERSION' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE MWwaterCoeff_DefineVersion( Id )
CHARACTER(*), INTENT(OUT) :: Id
Id = MODULE_VERSION_ID
END SUBROUTINE MWwaterCoeff_DefineVersion
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! MWwaterCoeff_SetValue
!
! PURPOSE:
! Subroutine to set the contents of a valid MWwaterCoeff object.
!
! CALLING SEQUENCE:
! CALL MWwaterCoeff_SetValue( MWwaterCoeff, &
! FCCoeff = FCCoeff , &
! FRCoeff = FRCoeff , &
! RCCoeff = RCCoeff , &
! AZCoeff = AZCoeff , &
! SSCCoeff = SSCCoeff , &
! LSCCoeff = LSCCoeff , &
! MWwaterLUT = MWwaterLUT )
! OBJECTS:
! MWwaterCoeff: Valid, allocated MWwaterCoeff object for which
! values are to be set.
! UNITS: N/A
! TYPE: MWwaterCoeff_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
! OPTIONAL INPUTS:
! FCCoeff: Object containing the foam coverage fitting coefficients.
! UNITS: N/A
! TYPE: FitCoeff_1D_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
! FRCoeff: Object containing the foam reflectivity fitting
! coefficients.
! UNITS: N/A
! TYPE: FitCoeff_1D_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
! RCCoeff: Object containing the reflection correction fitting
! coefficients.
! UNITS: N/A
! TYPE: FitCoeff_3D_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
! AZCoeff: Object containing the azimuth emissivity fitting
! coefficients.
! UNITS: N/A
! TYPE: FitCoeff_3D_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
! SSCCoeff: Object containing the small-scale correction fitting
! coefficients.
! UNITS: N/A
! TYPE: FitCoeff_1D_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
! LSCCoeff: Object containing the large-scale correction fitting
! coefficients.
! UNITS: N/A
! TYPE: FitCoeff_3D_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
! MWwaterLUT: Object containing the emissivity look-up table.
! UNITS: N/A
! TYPE: MWwaterLUT_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='MWWATERCOEFF_SETVALUE'><A href='../../html_code/crtm/MWwaterCoeff_Define.f90.html#MWWATERCOEFF_SETVALUE' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE MWwaterCoeff_SetValue( &
self , & ! In/Output
FCCoeff , & ! Optional input
FRCoeff , & ! Optional input
RCCoeff , & ! Optional input
AZCoeff , & ! Optional input
SSCCoeff , & ! Optional input
LSCCoeff , & ! Optional input
MWwaterLUT ) ! Optional input
! Arguments
TYPE(MWwaterCoeff_type) , INTENT(IN OUT) :: self
TYPE(FitCoeff_1D_type), OPTIONAL, INTENT(IN) :: FCCoeff
TYPE(FitCoeff_1D_type), OPTIONAL, INTENT(IN) :: FRCoeff
TYPE(FitCoeff_3D_type), OPTIONAL, INTENT(IN) :: RCCoeff
TYPE(FitCoeff_3D_type), OPTIONAL, INTENT(IN) :: AZCoeff
TYPE(FitCoeff_1D_type), OPTIONAL, INTENT(IN) :: SSCCoeff
TYPE(FitCoeff_3D_type), OPTIONAL, INTENT(IN) :: LSCCoeff
TYPE(MWwaterLUT_type) , OPTIONAL, INTENT(IN) :: MWwaterLUT
IF ( PRESENT(FCCoeff ) ) self%FCCoeff = FCCoeff
IF ( PRESENT(FRCoeff ) ) self%FRCoeff = FRCoeff
IF ( PRESENT(RCCoeff ) ) self%RCCoeff = RCCoeff
IF ( PRESENT(AZCoeff ) ) self%AZCoeff = AZCoeff
IF ( PRESENT(SSCCoeff ) ) self%SSCCoeff = SSCCoeff
IF ( PRESENT(LSCCoeff ) ) self%LSCCoeff = LSCCoeff
IF ( PRESENT(MWwaterLUT) ) self%LUT = MWwaterLUT
END SUBROUTINE MWwaterCoeff_SetValue
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! MWwaterCoeff_GetValue
!
! PURPOSE:
! Subroutine to get the contents of a valid MWwaterCoeff object.
!
! CALLING SEQUENCE:
! CALL MWwaterCoeff_GetValue( MWwaterCoeff, &
! FCCoeff = FCCoeff , &
! FRCoeff = FRCoeff , &
! RCCoeff = RCCoeff , &
! AZCoeff = AZCoeff , &
! SSCCoeff = SSCCoeff , &
! LSCCoeff = LSCCoeff , &
! MWwaterLUT = MWwaterLUT )
!
! OBJECTS:
! MWwaterCoeff: Valid, allocated MWwaterCoeff object from which
! values are to be retrieved.
! UNITS: N/A
! TYPE: MWwaterCoeff_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
! OPTIONAL OUTPUTS:
! FCCoeff: Object containing the foam coverage fitting coefficients.
! UNITS: N/A
! TYPE: FitCoeff_1D_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(OUT), OPTIONAL
!
! FRCoeff: Object containing the foam reflectivity fitting
! coefficients.
! UNITS: N/A
! TYPE: FitCoeff_1D_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(OUT), OPTIONAL
!
! RCCoeff: Object containing the reflection correction fitting
! coefficients.
! UNITS: N/A
! TYPE: FitCoeff_3D_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(OUT), OPTIONAL
!
! AZCoeff: Object containing the azimuth emissivity fitting
! coefficients.
! UNITS: N/A
! TYPE: FitCoeff_3D_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(OUT), OPTIONAL
!
! SSCCoeff: Object containing the small-scale correction fitting
! coefficients.
! UNITS: N/A
! TYPE: FitCoeff_1D_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(OUT), OPTIONAL
!
! LSCCoeff: Object containing the large-scale correction fitting
! coefficients.
! UNITS: N/A
! TYPE: FitCoeff_3D_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(OUT), OPTIONAL
!
! MWwaterLUT: Object containing the emissivity look-up table.
! UNITS: N/A
! TYPE: MWwaterLUT_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='MWWATERCOEFF_GETVALUE'><A href='../../html_code/crtm/MWwaterCoeff_Define.f90.html#MWWATERCOEFF_GETVALUE' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE MWwaterCoeff_GetValue( &
self , & ! Input
FCCoeff , & ! Optional output
FRCoeff , & ! Optional output
RCCoeff , & ! Optional output
AZCoeff , & ! Optional output
SSCCoeff , & ! Optional output
LSCCoeff , & ! Optional output
MWwaterLUT ) ! Optional output
! Arguments
TYPE(MWwaterCoeff_type) , INTENT(IN) :: self
TYPE(FitCoeff_1D_type), OPTIONAL, INTENT(OUT) :: FCCoeff
TYPE(FitCoeff_1D_type), OPTIONAL, INTENT(OUT) :: FRCoeff
TYPE(FitCoeff_3D_type), OPTIONAL, INTENT(OUT) :: RCCoeff
TYPE(FitCoeff_3D_type), OPTIONAL, INTENT(OUT) :: AZCoeff
TYPE(FitCoeff_1D_type), OPTIONAL, INTENT(OUT) :: SSCCoeff
TYPE(FitCoeff_3D_type), OPTIONAL, INTENT(OUT) :: LSCCoeff
TYPE(MWwaterLUT_type) , OPTIONAL, INTENT(OUT) :: MWwaterLUT
IF ( PRESENT(FCCoeff ) ) FCCoeff = self%FCCoeff
IF ( PRESENT(FRCoeff ) ) FRCoeff = self%FRCoeff
IF ( PRESENT(RCCoeff ) ) RCCoeff = self%RCCoeff
IF ( PRESENT(AZCoeff ) ) AZCoeff = self%AZCoeff
IF ( PRESENT(SSCCoeff ) ) SSCCoeff = self%SSCCoeff
IF ( PRESENT(LSCCoeff ) ) LSCCoeff = self%LSCCoeff
IF ( PRESENT(MWwaterLUT) ) MWwaterLUT = self%LUT
END SUBROUTINE MWwaterCoeff_GetValue
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! MWwaterCoeff_ReadFile
!
! PURPOSE:
! Function to read MWwaterCoeff object files.
!
! CALLING SEQUENCE:
! Error_Status = MWwaterCoeff_ReadFile( &
! MWwaterCoeff , &
! Filename , &
! No_Close = No_Close, &
! Quiet = Quiet , &
! Title = Title , &
! History = History , &
! Comment = Comment )
!
! OBJECTS:
! MWwaterCoeff: MWwaterCoeff object containing the data read from file.
! UNITS: N/A
! TYPE: MWwaterCoeff_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(OUT)
!
! INPUTS:
! Filename: Character string specifying the name of a
! MWwaterCoeff data file to read.
! UNITS: N/A
! TYPE: CHARACTER(*)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
! No_Close: Set this logical argument to *NOT* close the datafile
! upon exiting this routine. This option is required if
! the MWwaterCoeff data is embedded within another file.
! If == .FALSE., File is closed upon function exit [DEFAULT].
! == .TRUE., File is NOT closed upon function exit
! If not specified, default is .FALSE.
! UNITS: N/A
! TYPE: LOGICAL
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
! Quiet: Set this logical argument to suppress INFORMATION
! messages being printed to stdout
! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
! == .TRUE., INFORMATION messages are SUPPRESSED.
! If not specified, default is .FALSE.
! UNITS: N/A
! TYPE: LOGICAL
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
! OPTIONAL OUTPUTS:
! Title: Character string containing a succinct description
! of what is in the dataset.
! UNITS: N/A
! TYPE: CHARACTER(*)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(OUT), OPTIONAL
!
! History: Character string containing dataset creation
! history.
! UNITS: N/A
! TYPE: CHARACTER(*)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(OUT), OPTIONAL
!
! Comment: Character string containing any comments about
! the dataset.
! UNITS: N/A
! TYPE: CHARACTER(*)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(OUT), OPTIONAL
!
! FUNCTION RESULT:
! Error_Status: The return value is an integer defining the error status.
! The error codes are defined in the Message_Handler module.
! If == SUCCESS, the file read was successful
! == FAILURE, an unrecoverable error occurred.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
!
!:sdoc-:
!------------------------------------------------------------------------------
<A NAME='MWWATERCOEFF_READFILE'><A href='../../html_code/crtm/MWwaterCoeff_Define.f90.html#MWWATERCOEFF_READFILE' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
FUNCTION MWwaterCoeff_ReadFile( & 1,21
MWwaterCoeff, & ! Output
Filename , & ! Input
No_Close , & ! Optional input
Quiet , & ! Optional input
Title , & ! Optional output
History , & ! Optional output
Comment , & ! Optional output
Debug ) & ! Optional input (Debug output control)
RESULT( err_stat )
! Arguments
TYPE(MWwaterCoeff_type), INTENT(OUT) :: MWwaterCoeff
CHARACTER(*), INTENT(IN) :: Filename
LOGICAL , OPTIONAL, INTENT(IN) :: No_Close
LOGICAL , OPTIONAL, INTENT(IN) :: Quiet
CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title
CHARACTER(*), OPTIONAL, INTENT(OUT) :: History
CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment
LOGICAL , OPTIONAL, INTENT(IN) :: Debug
! Function result
INTEGER :: err_stat
! Function parameters
CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'MWwaterCoeff_ReadFile'
! Function variables
CHARACTER(ML) :: msg
CHARACTER(ML) :: io_msg
LOGICAL :: close_file
LOGICAL :: noisy
INTEGER :: io_stat
INTEGER :: fid
INTEGER(Long) :: lut_present
TYPE(MWwaterCoeff_type) :: dummy
! Setup
err_stat = SUCCESS
! ...Check No_Close argument
close_file = .TRUE.
IF ( PRESENT(No_Close) ) close_file = .NOT. No_Close
! ...Check Quiet argument
noisy = .TRUE.
IF ( PRESENT(Quiet) ) noisy = .NOT. Quiet
! ...Override Quiet settings if debug set.
IF ( PRESENT(Debug) ) THEN
IF ( Debug ) noisy = .TRUE.
END IF
! Check if the file is open.
IF ( File_Open( Filename ) ) THEN
! ...Inquire for the logical unit number
INQUIRE( FILE=Filename, NUMBER=fid )
! ...Ensure it's valid
IF ( fid < 0 ) THEN
msg = 'Error inquiring '//TRIM(Filename)//' for its FileID'
CALL Read_CleanUp(); RETURN
END IF
ELSE
! ...Open the file if it exists
IF ( File_Exists( Filename ) ) THEN
err_stat = Open_Binary_File( Filename, fid )
IF ( err_Stat /= SUCCESS ) THEN
msg = 'Error opening '//TRIM(Filename)
CALL Read_CleanUp(); RETURN
END IF
ELSE
msg = 'File '//TRIM(Filename)//' not found.'
CALL Read_CleanUp(); RETURN
END IF
END IF
! Read and check the release and version
READ( fid, IOSTAT=io_stat, IOMSG=io_msg ) &
dummy%Release, &
dummy%Version
IF ( io_stat /= 0 ) THEN
msg = 'Error reading Release/Version - '//TRIM(io_msg)
CALL Read_Cleanup(); RETURN
END IF
IF ( .NOT. MWwaterCoeff_ValidRelease( dummy ) ) THEN
msg = 'MWwaterCoeff Release check failed.'
CALL Read_Cleanup(); RETURN
END IF
! Create instance of the structure
CALL MWwaterCoeff_Create(MWwaterCoeff)
! ...Explicitly set the version
MWwaterCoeff%Version = dummy%Version
! Read the global attributes
err_stat = ReadGAtts_Binary_File( &
fid, &
Title = Title , &
History = History, &
Comment = Comment )
IF ( err_stat /= SUCCESS ) THEN
msg = 'Error reading global attributes'
CALL Read_Cleanup(); RETURN
END IF
! Read the coefficient data
! ...Read the foam coverage coefficients
err_stat = FitCoeff_ReadFile( &
MWwaterCoeff%FCCoeff, &
Filename, &
No_Close = .TRUE., &
Quiet = Quiet , &
Debug = Debug )
IF ( err_stat /= SUCCESS ) THEN
msg = 'Error reading foam coverage coefficient data.'
CALL Read_Cleanup(); RETURN
END IF
! ...Read the foam reflectivity coefficients
err_stat = FitCoeff_ReadFile( &
MWwaterCoeff%FRCoeff, &
Filename, &
No_Close = .TRUE., &
Quiet = Quiet , &
Debug = Debug )
IF ( err_stat /= SUCCESS ) THEN
msg = 'Error reading foam reflectivity coefficient data.'
CALL Read_Cleanup(); RETURN
END IF
! ...Read the reflection correction coefficients
err_stat = FitCoeff_ReadFile( &
MWwaterCoeff%RCCoeff, &
Filename, &
No_Close = .TRUE., &
Quiet = Quiet , &
Debug = Debug )
IF ( err_stat /= SUCCESS ) THEN
msg = 'Error reading reflection correction coefficient data'
CALL Read_Cleanup(); RETURN
END IF
! ...Read the azimuth emissivity coefficients
err_stat = FitCoeff_ReadFile( &
MWwaterCoeff%AZCoeff, &
Filename, &
No_Close = .TRUE., &
Quiet = Quiet , &
Debug = Debug )
IF ( err_stat /= SUCCESS ) THEN
msg = 'Error reading azimuth emissivity coefficient data.'
CALL Read_Cleanup(); RETURN
END IF
! ...Read the small-scale correction coefficients
err_stat = FitCoeff_ReadFile( &
MWwaterCoeff%SSCCoeff, &
Filename, &
No_Close = .TRUE., &
Quiet = Quiet , &
Debug = Debug )
IF ( err_stat /= SUCCESS ) THEN
msg = 'Error reading small-scale correction coefficient data.'
CALL Read_Cleanup(); RETURN
END IF
! ...Read the large-scale correction coefficients
err_stat = FitCoeff_ReadFile( &
MWwaterCoeff%LSCCoeff, &
Filename, &
No_Close = .TRUE., &
Quiet = Quiet , &
Debug = Debug )
IF ( err_stat /= SUCCESS ) THEN
msg = 'Error reading large-scale correction coefficient data.'
CALL Read_Cleanup(); RETURN
END IF
! Read the emissivity look-up table if it's present
! ...Read the data indicator
READ( fid, IOSTAT=io_stat, IOMSG=io_msg ) lut_present
IF ( io_stat /= 0 ) THEN
msg = 'Error reading emissivity look-up table data indicator - '//TRIM(io_msg)
CALL Read_Cleanup(); RETURN
END IF
! ...Read the LUT data
IF ( lut_present == DATA_PRESENT ) THEN
err_stat = MWwaterLUT_ReadFile( &
MWwaterCoeff%LUT, &
Filename, &
No_Close = .TRUE., &
Quiet = Quiet , &
Debug = Debug )
IF ( err_stat /= SUCCESS ) THEN
msg = 'Error reading emissivity look-up table data.'
CALL Read_Cleanup(); RETURN
END IF
END IF
! Close the file
IF ( close_file ) THEN
CLOSE( fid, IOSTAT=io_stat, IOMSG=io_msg )
IF ( io_stat /= 0 ) THEN
msg = 'Error closing '//TRIM(Filename)//' - '//TRIM(io_msg)
CALL Read_Cleanup(); RETURN
END IF
END IF
! Output an info message
IF ( noisy ) THEN
CALL MWwaterCoeff_Info( MWwaterCoeff, msg )
CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION )
END IF
CONTAINS
<A NAME='READ_CLEANUP'><A href='../../html_code/crtm/MWwaterCoeff_Define.f90.html#READ_CLEANUP' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE Read_CleanUp() 334,61
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 MWwaterCoeff_Destroy( MWwaterCoeff )
err_stat = FAILURE
CALL Display_Message( ROUTINE_NAME, msg, err_stat )
END SUBROUTINE Read_CleanUp
END FUNCTION MWwaterCoeff_ReadFile
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! MWwaterCoeff_WriteFile
!
! PURPOSE:
! Function to write MWwaterCoeff object files.
!
! CALLING SEQUENCE:
! Error_Status = MWwaterCoeff_WriteFile( &
! MWwaterCoeff , &
! Filename , &
! No_Close = No_Close, &
! Quiet = Quiet , &
! Title = Title , &
! History = History , &
! Comment = Comment )
!
! OBJECTS:
! MWwaterCoeff: MWwaterCoeff object containing the data to write to file.
! UNITS: N/A
! TYPE: MWwaterCoeff_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! INPUTS:
! Filename: Character string specifying the name of a
! MWwaterCoeff format data file to write.
! UNITS: N/A
! TYPE: CHARACTER(*)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
! No_Close: Set this logical argument to *NOT* close the datafile
! upon exiting this routine. This option is required if
! the MWwaterCoeff data is to be embedded within another file.
! If == .FALSE., File is closed upon function exit [DEFAULT].
! == .TRUE., File is NOT closed upon function exit
! If not specified, default is .FALSE.
! UNITS: N/A
! TYPE: LOGICAL
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
! Quiet: Set this logical argument to suppress INFORMATION
! messages being printed to stdout
! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
! == .TRUE., INFORMATION messages are SUPPRESSED.
! If not specified, default is .FALSE.
! UNITS: N/A
! TYPE: LOGICAL
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
! Title: Character string containing a succinct description
! of what is in the dataset.
! UNITS: N/A
! TYPE: CHARACTER(*)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
! History: Character string containing dataset creation
! history.
! UNITS: N/A
! TYPE: CHARACTER(*)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
! Comment: Character string containing any comments about
! the dataset.
! UNITS: N/A
! TYPE: CHARACTER(*)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
! FUNCTION RESULT:
! Error_Status: The return value is an integer defining the error status.
! The error codes are defined in the Message_Handler module.
! If == SUCCESS, the file write was successful
! == FAILURE, an unrecoverable error occurred.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
!
!:sdoc-:
!------------------------------------------------------------------------------
<A NAME='MWWATERCOEFF_WRITEFILE'><A href='../../html_code/crtm/MWwaterCoeff_Define.f90.html#MWWATERCOEFF_WRITEFILE' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
FUNCTION MWwaterCoeff_WriteFile( &,19
MWwaterCoeff, & ! Input
Filename , & ! Input
No_Close , & ! Optional input
Quiet , & ! Optional input
Title , & ! Optional input
History , & ! Optional input
Comment , & ! Optional input
Debug ) & ! Optional input (Debug output control)
RESULT( err_stat )
! Arguments
TYPE(MWwaterCoeff_type), INTENT(IN) :: MWwaterCoeff
CHARACTER(*), INTENT(IN) :: Filename
LOGICAL , OPTIONAL, INTENT(IN) :: No_Close
LOGICAL , OPTIONAL, INTENT(IN) :: Quiet
CHARACTER(*), OPTIONAL, INTENT(IN) :: Title
CHARACTER(*), OPTIONAL, INTENT(IN) :: History
CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment
LOGICAL , OPTIONAL, INTENT(IN) :: Debug
! Function result
INTEGER :: err_stat
! Function parameters
CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'MWwaterCoeff_WriteFile'
! Function variables
CHARACTER(ML) :: msg
CHARACTER(ML) :: io_msg
LOGICAL :: close_file
LOGICAL :: noisy
INTEGER :: io_stat
INTEGER :: fid
INTEGER(Long) :: lut_present
! Setup
err_stat = SUCCESS
! ...Check No_Close argument
close_file = .TRUE.
IF ( PRESENT(No_Close) ) close_file = .NOT. No_Close
! ...Check Quiet argument
noisy = .TRUE.
IF ( PRESENT(Quiet) ) noisy = .NOT. Quiet
! ...Override Quiet settings if debug set.
IF ( PRESENT(Debug) ) THEN
IF ( Debug ) noisy = .TRUE.
END IF
! ...Check there is data to write
IF ( .NOT. MWwaterCoeff_Associated( MWwaterCoeff ) ) THEN
msg = 'MWwaterCoeff object is empty.'
CALL Write_Cleanup(); RETURN
END IF
! Check if the file is open.
IF ( File_Open( FileName ) ) THEN
! ...Inquire for the logical unit number
INQUIRE( FILE=Filename, NUMBER=fid )
! ...Ensure it's valid
IF ( fid < 0 ) THEN
msg = 'Error inquiring '//TRIM(Filename)//' for its FileID'
CALL Write_CleanUp(); RETURN
END IF
ELSE
! ...Open the file for output
err_stat = Open_Binary_File( Filename, fid, For_Output=.TRUE. )
IF ( err_Stat /= SUCCESS ) THEN
msg = 'Error opening '//TRIM(Filename)
CALL Write_CleanUp(); RETURN
END IF
END IF
! Write the release and version
WRITE( fid, IOSTAT=io_stat, IOMSG=io_msg ) &
MWwaterCoeff%Release, &
MWwaterCoeff%Version
IF ( io_stat /= 0 ) THEN
msg = 'Error writing Release/Version - '//TRIM(io_msg)
CALL Write_Cleanup(); RETURN
END IF
! Write the global attributes
err_stat = WriteGAtts_Binary_File( &
fid, &
Write_Module = MODULE_VERSION_ID, &
Title = Title , &
History = History, &
Comment = Comment )
IF ( err_stat /= SUCCESS ) THEN
msg = 'Error writing global attributes'
CALL Write_Cleanup(); RETURN
END IF
! Write the coefficient data
! ...Write the foam coverage coefficients
err_stat = FitCoeff_WriteFile( &
MWwaterCoeff%FCCoeff, &
Filename, &
No_Close = .TRUE., &
Quiet = Quiet , &
Debug = Debug )
IF ( err_stat /= SUCCESS ) THEN
msg = 'Error writing foam coverage coefficient data.'
CALL Write_Cleanup(); RETURN
END IF
! ...Write the foam reflectivity coefficients
err_stat = FitCoeff_WriteFile( &
MWwaterCoeff%FRCoeff, &
Filename, &
No_Close = .TRUE., &
Quiet = Quiet , &
Debug = Debug )
IF ( err_stat /= SUCCESS ) THEN
msg = 'Error writing foam reflectivity coefficient data.'
CALL Write_Cleanup(); RETURN
END IF
! ...Write the reflection correction coefficients
err_stat = FitCoeff_WriteFile( &
MWwaterCoeff%RCCoeff, &
Filename, &
No_Close = .TRUE., &
Quiet = Quiet , &
Debug = Debug )
IF ( err_stat /= SUCCESS ) THEN
msg = 'Error writing reflection correction coefficient data'
CALL Write_Cleanup(); RETURN
END IF
! ...Write the azimuth emissivity coefficients
err_stat = FitCoeff_WriteFile( &
MWwaterCoeff%AZCoeff, &
Filename, &
No_Close = .TRUE., &
Quiet = Quiet , &
Debug = Debug )
IF ( err_stat /= SUCCESS ) THEN
msg = 'Error writing azimuth emissivity coefficient data.'
CALL Write_Cleanup(); RETURN
END IF
! ...Write the small-scale correction coefficients
err_stat = FitCoeff_WriteFile( &
MWwaterCoeff%SSCCoeff, &
Filename, &
No_Close = .TRUE., &
Quiet = Quiet , &
Debug = Debug )
IF ( err_stat /= SUCCESS ) THEN
msg = 'Error writing small-scale correction coefficient data.'
CALL Write_Cleanup(); RETURN
END IF
! ...Write the large-scale correction coefficients
err_stat = FitCoeff_WriteFile( &
MWwaterCoeff%LSCCoeff, &
Filename, &
No_Close = .TRUE., &
Quiet = Quiet , &
Debug = Debug )
IF ( err_stat /= SUCCESS ) THEN
msg = 'Error writing large-scale correction coefficient data.'
CALL Write_Cleanup(); RETURN
END IF
! Write the emissivity look-up table if it's present
IF ( MWwaterLUT_Associated( MWwaterCoeff%LUT ) ) THEN
lut_present = DATA_PRESENT
ELSE
lut_present = DATA_MISSING
END IF
! ...Write the data indicator
WRITE( fid, IOSTAT=io_stat, IOMSG=io_msg ) lut_present
IF ( io_stat /= 0 ) THEN
msg = 'Error writing emissivity look-up table data indicator - '//TRIM(io_msg)
CALL Write_Cleanup(); RETURN
END IF
! ...Write the LUT data
IF ( lut_present == DATA_PRESENT ) THEN
err_stat = MWwaterLUT_WriteFile( &
MWwaterCoeff%LUT, &
Filename, &
No_Close = .TRUE., &
Quiet = Quiet , &
Debug = Debug )
IF ( err_stat /= SUCCESS ) THEN
msg = 'Error writing emissivity look-up table data.'
CALL Write_Cleanup(); RETURN
END IF
END IF
! Close the file
IF ( close_file ) THEN
CLOSE( fid, IOSTAT=io_stat, IOMSG=io_msg )
IF ( io_stat /= 0 ) THEN
msg = 'Error closing '//TRIM(Filename)//' - '//TRIM(io_msg)
CALL Write_Cleanup(); RETURN
END IF
END IF
! Output an info message
IF ( noisy ) THEN
CALL MWwaterCoeff_Info( MWwaterCoeff, msg )
CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION )
END IF
CONTAINS
<A NAME='WRITE_CLEANUP'><A href='../../html_code/crtm/MWwaterCoeff_Define.f90.html#WRITE_CLEANUP' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE Write_Cleanup() 283,32
IF ( File_Open(Filename) ) THEN
CLOSE( fid, STATUS=WRITE_ERROR_STATUS, IOSTAT=io_stat, IOMSG=io_msg )
IF ( io_stat /= 0 ) &
msg = TRIM(msg)//'; Error closing 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 MWwaterCoeff_WriteFile
!################################################################################
!################################################################################
!## ##
!## ## PRIVATE PROCEDURES ## ##
!## ##
!################################################################################
!################################################################################
!--------------------------------------------------------------------------------
!
! NAME:
! MWwaterCoeff_Equal
!
! PURPOSE:
! Pure function to test the equality of two MWwaterCoeff objects.
! Used in OPERATOR(==) interface block.
!
! CALLING SEQUENCE:
! is_equal = MWwaterCoeff_Equal( x, y )
!
! or
!
! IF ( x == y ) THEN
! ...
! END IF
!
! OBJECTS:
! x, y: Two MWwaterCoeff objects to be compared.
! UNITS: N/A
! TYPE: MWwaterCoeff_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
! is_equal: Logical value indicating whether the inputs are equal.
! UNITS: N/A
! TYPE: LOGICAL
! DIMENSION: Scalar
!
!--------------------------------------------------------------------------------
<A NAME='MWWATERCOEFF_EQUAL'><A href='../../html_code/crtm/MWwaterCoeff_Define.f90.html#MWWATERCOEFF_EQUAL' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
PURE FUNCTION MWwaterCoeff_Equal( x, y ) RESULT( is_equal ) 1
TYPE(MWwaterCoeff_type), INTENT(IN) :: x, y
LOGICAL :: is_equal
! Set up
is_equal = .FALSE.
! Check the object association status
IF ( (.NOT. MWwaterCoeff_Associated(x)) .OR. &
(.NOT. MWwaterCoeff_Associated(y)) ) RETURN
! Check contents
! ...Release/version info
IF ( (x%Release /= y%Release) .OR. &
(x%Version /= y%Version) ) RETURN
! ...Structures
IF ( FitCoeff_Associated( x%FCCoeff ) .NEQV. FitCoeff_Associated( x%FCCoeff ) ) RETURN
IF ( FitCoeff_Associated( x%FCCoeff ) .AND. FitCoeff_Associated( x%FCCoeff ) ) THEN
IF ( .NOT. (x%FCCoeff == y%FCCoeff) ) RETURN
END IF
IF ( FitCoeff_Associated( x%FRCoeff ) .NEQV. FitCoeff_Associated( x%FRCoeff ) ) RETURN
IF ( FitCoeff_Associated( x%FRCoeff ) .AND. FitCoeff_Associated( x%FRCoeff ) ) THEN
IF ( .NOT. (x%FRCoeff == y%FRCoeff) ) RETURN
END IF
IF ( FitCoeff_Associated( x%RCCoeff ) .NEQV. FitCoeff_Associated( x%RCCoeff ) ) RETURN
IF ( FitCoeff_Associated( x%RCCoeff ) .AND. FitCoeff_Associated( x%RCCoeff ) ) THEN
IF ( .NOT. (x%RCCoeff == y%RCCoeff) ) RETURN
END IF
IF ( FitCoeff_Associated( x%AZCoeff ) .NEQV. FitCoeff_Associated( x%AZCoeff ) ) RETURN
IF ( FitCoeff_Associated( x%AZCoeff ) .AND. FitCoeff_Associated( x%AZCoeff ) ) THEN
IF ( .NOT. (x%AZCoeff == y%AZCoeff) ) RETURN
END IF
IF ( FitCoeff_Associated( x%SSCCoeff ) .NEQV. FitCoeff_Associated( x%SSCCoeff ) ) RETURN
IF ( FitCoeff_Associated( x%SSCCoeff ) .AND. FitCoeff_Associated( x%SSCCoeff ) ) THEN
IF ( .NOT. (x%SSCCoeff == y%SSCCoeff) ) RETURN
END IF
IF ( FitCoeff_Associated( x%LSCCoeff ) .NEQV. FitCoeff_Associated( x%LSCCoeff ) ) RETURN
IF ( FitCoeff_Associated( x%LSCCoeff ) .AND. FitCoeff_Associated( x%LSCCoeff ) ) THEN
IF ( .NOT. (x%LSCCoeff == y%LSCCoeff) ) RETURN
END IF
IF ( MWwaterLUT_Associated( x%LUT ) .NEQV. MWwaterLUT_Associated( x%LUT ) ) RETURN
IF ( MWwaterLUT_Associated( x%LUT ) .AND. MWwaterLUT_Associated( x%LUT ) ) THEN
IF ( .NOT. (x%LUT == y%LUT) ) RETURN
END IF
! If we get here everything is equal
is_equal = .TRUE.
END FUNCTION MWwaterCoeff_Equal
END MODULE MWwaterCoeff_Define