<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
!
! CRTM_GeometryInfo_Define
!
! Module defining the CRTM GeometryInfo container object.
!
!
!
! CREATION HISTORY:
! Written by: Paul van Delst, 19-May-2004
! paul.vandelst@noaa.gov
!
<A NAME='CRTM_GEOMETRYINFO_DEFINE'><A href='../../html_code/crtm/CRTM_GeometryInfo_Define.f90.html#CRTM_GEOMETRYINFO_DEFINE' TARGET='top_target'><IMG SRC="../../gif/bar_purple.gif" border=0></A>
MODULE CRTM_GeometryInfo_Define 33,11
! ------------------
! Environment set up
! ------------------
! 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_Parameters , ONLY: EARTH_RADIUS , &
SATELLITE_HEIGHT , &
DIFFUSIVITY_RADIAN, &
SECANT_DIFFUSIVITY
USE CRTM_Geometry_Define , ONLY: CRTM_Geometry_type, &
OPERATOR(==), &
OPERATOR(-) , &
CRTM_Geometry_Destroy , &
CRTM_Geometry_SetValue , &
CRTM_Geometry_GetValue , &
CRTM_Geometry_IsValid , &
CRTM_Geometry_Inspect , &
CRTM_Geometry_ReadRecord , &
CRTM_Geometry_WriteRecord
! Disable implicit typing
IMPLICIT NONE
! ------------
! Visibilities
! ------------
! Everything private by default
PRIVATE
! Operators
PUBLIC :: OPERATOR(==)
PUBLIC :: OPERATOR(-)
! Geometry entities
! ...Structures
PUBLIC :: CRTM_Geometry_type
! GeometryInfo enitities
! ...Structures
PUBLIC :: CRTM_GeometryInfo_type
! ...Procedures
PUBLIC :: CRTM_GeometryInfo_Destroy
PUBLIC :: CRTM_GeometryInfo_SetValue
PUBLIC :: CRTM_GeometryInfo_GetValue
PUBLIC :: CRTM_GeometryInfo_IsValid
PUBLIC :: CRTM_GeometryInfo_Inspect
PUBLIC :: CRTM_GeometryInfo_DefineVersion
PUBLIC :: CRTM_GeometryInfo_InquireFile
PUBLIC :: CRTM_GeometryInfo_ReadFile
PUBLIC :: CRTM_GeometryInfo_WriteFile
! ---------------------
! Procedure overloading
! ---------------------
<A NAME='OPERATOR'><A href='../../html_code/crtm/CRTM_GeometryInfo_Define.f90.html#OPERATOR' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
INTERFACE OPERATOR(==)
MODULE PROCEDURE
END INTERFACE OPERATOR(==)
<A NAME='OPERATOR'><A href='../../html_code/crtm/CRTM_GeometryInfo_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: CRTM_GeometryInfo_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'
! ---------------------------------
! GeometryInfo data type definition
! ---------------------------------
!:tdoc+:
TYPE :: CRTM_GeometryInfo_type
! Structure for user Input
TYPE(CRTM_Geometry_type) :: user
! Derived from User Input
! ...Default distance ratio
REAL(fp) :: Distance_Ratio = EARTH_RADIUS/(EARTH_RADIUS + SATELLITE_HEIGHT)
! ...Sensor angle information
REAL(fp) :: Sensor_Scan_Radian = ZERO
REAL(fp) :: Sensor_Zenith_Radian = ZERO
REAL(fp) :: Sensor_Azimuth_Radian = ZERO
REAL(fp) :: Secant_Sensor_Zenith = ZERO
REAL(fp) :: Cosine_Sensor_Zenith = ZERO
! ...Zenith angle used in the transmittance algorithms
REAL(fp) :: Trans_Zenith_Radian = ZERO
REAL(fp) :: Secant_Trans_Zenith = ZERO
! ...Source angle information
REAL(fp) :: Source_Zenith_Radian = ZERO
REAL(fp) :: Source_Azimuth_Radian = ZERO
REAL(fp) :: Secant_Source_Zenith = ZERO
! ...Flux angle information
REAL(fp) :: Flux_Zenith_Radian = DIFFUSIVITY_RADIAN
REAL(fp) :: Secant_Flux_Zenith = SECANT_DIFFUSIVITY
! ...Square of ratio between mean and actual sun-earth (AU) distances
REAL(fp) :: AU_ratio2 = ONE
END TYPE CRTM_GeometryInfo_type
!:tdoc-:
CONTAINS
!##################################################################################
!##################################################################################
!## ##
!## ## PUBLIC MODULE ROUTINES ## ##
!## ##
!##################################################################################
!##################################################################################
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! CRTM_GeometryInfo_Destroy
!
! PURPOSE:
! Elemental subroutine to re-initialize a CRTM GeometryInfo objects.
!
! CALLING SEQUENCE:
! CALL CRTM_GeometryInfo_Destroy( gInfo )
!
! OBJECTS:
! gInfo: Re-initialized GeometryInfo structure.
! UNITS: N/A
! TYPE: CRTM_GeometryInfo_type
! DIMENSION: Scalar or any rank
! ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='CRTM_GEOMETRYINFO_DESTROY'><A href='../../html_code/crtm/CRTM_GeometryInfo_Define.f90.html#CRTM_GEOMETRYINFO_DESTROY' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
ELEMENTAL SUBROUTINE CRTM_GeometryInfo_Destroy( gInfo ) 2,1
TYPE(CRTM_GeometryInfo_type), INTENT(OUT) :: gInfo
CALL CRTM_Geometry_Destroy(gInfo%user)
END SUBROUTINE CRTM_GeometryInfo_Destroy
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! CRTM_GeometryInfo_SetValue
!
! PURPOSE:
! Elemental subroutine to set the values of CRTM GeometryInfo
! object components.
!
! CALLING SEQUENCE:
! CALL CRTM_GeometryInfo_SetValue( gInfo, &
! Geometry = Geometry , &
! iFOV = iFOV , &
! Longitude = Longitude , &
! Latitude = Latitude , &
! Surface_Altitude = Surface_Altitude , &
! Sensor_Scan_Angle = Sensor_Scan_Angle , &
! Sensor_Zenith_Angle = Sensor_Zenith_Angle , &
! Sensor_Azimuth_Angle = Sensor_Azimuth_Angle , &
! Source_Zenith_Angle = Source_Zenith_Angle , &
! Source_Azimuth_Angle = Source_Azimuth_Angle , &
! Flux_Zenith_Angle = Flux_Zenith_Angle , &
! Year = Year , &
! Month = Month , &
! Day = Day , &
! Distance_Ratio = Distance_Ratio , &
! Sensor_Scan_Radian = Sensor_Scan_Radian , &
! Sensor_Zenith_Radian = Sensor_Zenith_Radian , &
! Sensor_Azimuth_Radian = Sensor_Azimuth_Radian, &
! Secant_Sensor_Zenith = Secant_Sensor_Zenith , &
! Cosine_Sensor_Zenith = Cosine_Sensor_Zenith , &
! Source_Zenith_Radian = Source_Zenith_Radian , &
! Source_Azimuth_Radian = Source_Azimuth_Radian, &
! Secant_Source_Zenith = Secant_Source_Zenith , &
! Flux_Zenith_Radian = Flux_Zenith_Radian , &
! Secant_Flux_Zenith = Secant_Flux_Zenith , &
! Trans_Zenith_Radian = Trans_Zenith_Radian , &
! Secant_Trans_Zenith = Secant_Trans_Zenith , &
! AU_ratio2 = AU_ratio2 )
!
! OBJECTS:
! gInfo: GeometryInfo object from which component values
! are to be retrieved.
! UNITS: N/A
! TYPE: CRTM_Geometry_type
! DIMENSION: Scalar or any rank
! ATTRIBUTES: INTENT(IN OUT)
!
! OPTIONAL INPUTS:
! Geometry: Geometry object.
! UNITS: N/A
! TYPE: CRTM_Geometry_type
! DIMENSION: Scalar or same as gInfo input
! ATTRIBUTES: INTENT(IN)
!
! All other gInfo components as listed in the calling sequence.
! NOTE: If the Geometry argument as well as any of the arguments iFOV to
! Flux_Zenith_Angle are specified, the latter values override any
! contained in the passed Geometry object.
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='CRTM_GEOMETRYINFO_SETVALUE'><A href='../../html_code/crtm/CRTM_GeometryInfo_Define.f90.html#CRTM_GEOMETRYINFO_SETVALUE' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
ELEMENTAL SUBROUTINE CRTM_GeometryInfo_SetValue( & 4,1
gInfo , & ! Input
Geometry , & ! Optional input
iFOV , & ! Optional input
Longitude , & ! Optional input
Latitude , & ! Optional input
Surface_Altitude , & ! Optional input
Sensor_Scan_Angle , & ! Optional input
Sensor_Zenith_Angle , & ! Optional input
Sensor_Azimuth_Angle , & ! Optional input
Source_Zenith_Angle , & ! Optional input
Source_Azimuth_Angle , & ! Optional input
Flux_Zenith_Angle , & ! Optional input
Year , & ! Optional input
Month , & ! Optional input
Day , & ! Optional input
Distance_Ratio , & ! Optional input
Sensor_Scan_Radian , & ! Optional input
Sensor_Zenith_Radian , & ! Optional input
Sensor_Azimuth_Radian, & ! Optional input
Secant_Sensor_Zenith , & ! Optional input
Cosine_Sensor_Zenith , & ! Optional input
Source_Zenith_Radian , & ! Optional input
Source_Azimuth_Radian, & ! Optional input
Secant_Source_Zenith , & ! Optional input
Flux_Zenith_Radian , & ! Optional input
Secant_Flux_Zenith , & ! Optional input
Trans_Zenith_Radian , & ! Optional input
Secant_Trans_Zenith , & ! Optional input
AU_ratio2 ) ! Optional input
! Arguments
TYPE(CRTM_GeometryInfo_type), INTENT(IN OUT) :: gInfo
TYPE(CRTM_Geometry_type), OPTIONAL, INTENT(IN) :: Geometry
INTEGER , OPTIONAL, INTENT(IN) :: iFOV
REAL(fp), OPTIONAL, INTENT(IN) :: Longitude
REAL(fp), OPTIONAL, INTENT(IN) :: Latitude
REAL(fp), OPTIONAL, INTENT(IN) :: Surface_Altitude
REAL(fp), OPTIONAL, INTENT(IN) :: Sensor_Scan_Angle
REAL(fp), OPTIONAL, INTENT(IN) :: Sensor_Zenith_Angle
REAL(fp), OPTIONAL, INTENT(IN) :: Sensor_Azimuth_Angle
REAL(fp), OPTIONAL, INTENT(IN) :: Source_Zenith_Angle
REAL(fp), OPTIONAL, INTENT(IN) :: Source_Azimuth_Angle
REAL(fp), OPTIONAL, INTENT(IN) :: Flux_Zenith_Angle
INTEGER, OPTIONAL, INTENT(IN) :: Year
INTEGER, OPTIONAL, INTENT(IN) :: Month
INTEGER, OPTIONAL, INTENT(IN) :: Day
REAL(fp), OPTIONAL, INTENT(IN) :: Distance_Ratio
REAL(fp), OPTIONAL, INTENT(IN) :: Sensor_Scan_Radian
REAL(fp), OPTIONAL, INTENT(IN) :: Sensor_Zenith_Radian
REAL(fp), OPTIONAL, INTENT(IN) :: Sensor_Azimuth_Radian
REAL(fp), OPTIONAL, INTENT(IN) :: Secant_Sensor_Zenith
REAL(fp), OPTIONAL, INTENT(IN) :: Cosine_Sensor_Zenith
REAL(fp), OPTIONAL, INTENT(IN) :: Source_Zenith_Radian
REAL(fp), OPTIONAL, INTENT(IN) :: Source_Azimuth_Radian
REAL(fp), OPTIONAL, INTENT(IN) :: Secant_Source_Zenith
REAL(fp), OPTIONAL, INTENT(IN) :: Flux_Zenith_Radian
REAL(fp), OPTIONAL, INTENT(IN) :: Secant_Flux_Zenith
REAL(fp), OPTIONAL, INTENT(IN) :: Trans_Zenith_Radian
REAL(fp), OPTIONAL, INTENT(IN) :: Secant_Trans_Zenith
REAL(fp), OPTIONAL, INTENT(IN) :: AU_ratio2
! Get values
IF ( PRESENT(Geometry) ) gInfo%user = Geometry
CALL CRTM_Geometry_SetValue( gInfo%user, &
iFOV = iFOV , &
Longitude = Longitude , &
Latitude = Latitude , &
Surface_Altitude = Surface_Altitude , &
Sensor_Scan_Angle = Sensor_Scan_Angle , &
Sensor_Zenith_Angle = Sensor_Zenith_Angle , &
Sensor_Azimuth_Angle = Sensor_Azimuth_Angle, &
Source_Zenith_Angle = Source_Zenith_Angle , &
Source_Azimuth_Angle = Source_Azimuth_Angle, &
Flux_Zenith_Angle = Flux_Zenith_Angle , &
Year = Year , &
Month = Month , &
Day = Day )
IF ( PRESENT(Distance_Ratio ) ) gInfo%Distance_Ratio = Distance_Ratio
IF ( PRESENT(Sensor_Scan_Radian ) ) gInfo%Sensor_Scan_Radian = Sensor_Scan_Radian
IF ( PRESENT(Sensor_Zenith_Radian ) ) gInfo%Sensor_Zenith_Radian = Sensor_Zenith_Radian
IF ( PRESENT(Sensor_Azimuth_Radian) ) gInfo%Sensor_Azimuth_Radian = Sensor_Azimuth_Radian
IF ( PRESENT(Secant_Sensor_Zenith ) ) gInfo%Secant_Sensor_Zenith = Secant_Sensor_Zenith
IF ( PRESENT(Cosine_Sensor_Zenith ) ) gInfo%Cosine_Sensor_Zenith = Cosine_Sensor_Zenith
IF ( PRESENT(Source_Zenith_Radian ) ) gInfo%Source_Zenith_Radian = Source_Zenith_Radian
IF ( PRESENT(Source_Azimuth_Radian) ) gInfo%Source_Azimuth_Radian = Source_Azimuth_Radian
IF ( PRESENT(Secant_Source_Zenith ) ) gInfo%Secant_Source_Zenith = Secant_Source_Zenith
IF ( PRESENT(Flux_Zenith_Radian ) ) gInfo%Flux_Zenith_Radian = Flux_Zenith_Radian
IF ( PRESENT(Secant_Flux_Zenith ) ) gInfo%Secant_Flux_Zenith = Secant_Flux_Zenith
IF ( PRESENT(Trans_Zenith_Radian ) ) gInfo%Trans_Zenith_Radian = Trans_Zenith_Radian
IF ( PRESENT(Secant_Trans_Zenith ) ) gInfo%Secant_Trans_Zenith = Secant_Trans_Zenith
IF ( PRESENT(AU_ratio2 ) ) gInfo%AU_ratio2 = AU_ratio2
END SUBROUTINE CRTM_GeometryInfo_SetValue
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! CRTM_GeometryInfo_GetValue
!
! PURPOSE:
! Elemental subroutine to get the values of CRTM GeometryInfo
! object components.
!
! CALLING SEQUENCE:
! CALL CRTM_GeometryInfo_GetValue( gInfo, &
! Geometry = Geometry , &
! iFOV = iFOV , &
! Longitude = Longitude , &
! Latitude = Latitude , &
! Surface_Altitude = Surface_Altitude , &
! Sensor_Scan_Angle = Sensor_Scan_Angle , &
! Sensor_Zenith_Angle = Sensor_Zenith_Angle , &
! Sensor_Azimuth_Angle = Sensor_Azimuth_Angle , &
! Source_Zenith_Angle = Source_Zenith_Angle , &
! Source_Azimuth_Angle = Source_Azimuth_Angle , &
! Flux_Zenith_Angle = Flux_Zenith_Angle , &
! Year = Year , &
! Month = Month , &
! Day = Day , &
! Distance_Ratio = Distance_Ratio , &
! Sensor_Scan_Radian = Sensor_Scan_Radian , &
! Sensor_Zenith_Radian = Sensor_Zenith_Radian , &
! Sensor_Azimuth_Radian = Sensor_Azimuth_Radian, &
! Secant_Sensor_Zenith = Secant_Sensor_Zenith , &
! Cosine_Sensor_Zenith = Cosine_Sensor_Zenith , &
! Source_Zenith_Radian = Source_Zenith_Radian , &
! Source_Azimuth_Radian = Source_Azimuth_Radian, &
! Secant_Source_Zenith = Secant_Source_Zenith , &
! Flux_Zenith_Radian = Flux_Zenith_Radian , &
! Secant_Flux_Zenith = Secant_Flux_Zenith , &
! Trans_Zenith_Radian = Trans_Zenith_Radian , &
! Secant_Trans_Zenith = Secant_Trans_Zenith , &
! AU_ratio2 = AU_ratio2 )
! OBJECTS:
! gInfo: Geometry object from which component values
! are to be retrieved.
! UNITS: N/A
! TYPE: CRTM_Geometry_type
! DIMENSION: Scalar or any rank
! ATTRIBUTES: INTENT(IN OUT)
!
! OPTIONAL OUTPUTS:
! Geometry: Geometry object.
! UNITS: N/A
! TYPE: CRTM_Geometry_type
! DIMENSION: Scalar or same as gInfo input
! ATTRIBUTES: INTENT(OUT)
!
! All other gInfo components as listed in the calling sequence.
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='CRTM_GEOMETRYINFO_GETVALUE'><A href='../../html_code/crtm/CRTM_GeometryInfo_Define.f90.html#CRTM_GEOMETRYINFO_GETVALUE' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
ELEMENTAL SUBROUTINE CRTM_GeometryInfo_GetValue( & 16,1
gInfo , & ! Input
Geometry , & ! Optional output
iFOV , & ! Optional output
Longitude , & ! Optional output
Latitude , & ! Optional output
Surface_Altitude , & ! Optional output
Sensor_Scan_Angle , & ! Optional output
Sensor_Zenith_Angle , & ! Optional output
Sensor_Azimuth_Angle , & ! Optional output
Source_Zenith_Angle , & ! Optional output
Source_Azimuth_Angle , & ! Optional output
Flux_Zenith_Angle , & ! Optional output
Year , & ! Optional output
Month , & ! Optional output
Day , & ! Optional output
Distance_Ratio , & ! Optional output
Sensor_Scan_Radian , & ! Optional output
Sensor_Zenith_Radian , & ! Optional output
Sensor_Azimuth_Radian, & ! Optional output
Secant_Sensor_Zenith , & ! Optional output
Cosine_Sensor_Zenith , & ! Optional output
Source_Zenith_Radian , & ! Optional output
Source_Azimuth_Radian, & ! Optional output
Secant_Source_Zenith , & ! Optional output
Flux_Zenith_Radian , & ! Optional output
Secant_Flux_Zenith , & ! Optional output
Trans_Zenith_Radian , & ! Optional output
Secant_Trans_Zenith , & ! Optional output
AU_ratio2 ) ! Optional output
! Arguments
TYPE(CRTM_GeometryInfo_type), INTENT(IN) :: gInfo
TYPE(CRTM_Geometry_type), OPTIONAL, INTENT(OUT) :: Geometry
INTEGER , OPTIONAL, INTENT(OUT) :: iFOV
REAL(fp), OPTIONAL, INTENT(OUT) :: Longitude
REAL(fp), OPTIONAL, INTENT(OUT) :: Latitude
REAL(fp), OPTIONAL, INTENT(OUT) :: Surface_Altitude
REAL(fp), OPTIONAL, INTENT(OUT) :: Sensor_Scan_Angle
REAL(fp), OPTIONAL, INTENT(OUT) :: Sensor_Zenith_Angle
REAL(fp), OPTIONAL, INTENT(OUT) :: Sensor_Azimuth_Angle
REAL(fp), OPTIONAL, INTENT(OUT) :: Source_Zenith_Angle
REAL(fp), OPTIONAL, INTENT(OUT) :: Source_Azimuth_Angle
REAL(fp), OPTIONAL, INTENT(OUT) :: Flux_Zenith_Angle
INTEGER, OPTIONAL, INTENT(OUT) :: Year
INTEGER, OPTIONAL, INTENT(OUT) :: Month
INTEGER, OPTIONAL, INTENT(OUT) :: Day
REAL(fp), OPTIONAL, INTENT(OUT) :: Distance_Ratio
REAL(fp), OPTIONAL, INTENT(OUT) :: Sensor_Scan_Radian
REAL(fp), OPTIONAL, INTENT(OUT) :: Sensor_Zenith_Radian
REAL(fp), OPTIONAL, INTENT(OUT) :: Sensor_Azimuth_Radian
REAL(fp), OPTIONAL, INTENT(OUT) :: Secant_Sensor_Zenith
REAL(fp), OPTIONAL, INTENT(OUT) :: Cosine_Sensor_Zenith
REAL(fp), OPTIONAL, INTENT(OUT) :: Source_Zenith_Radian
REAL(fp), OPTIONAL, INTENT(OUT) :: Source_Azimuth_Radian
REAL(fp), OPTIONAL, INTENT(OUT) :: Secant_Source_Zenith
REAL(fp), OPTIONAL, INTENT(OUT) :: Flux_Zenith_Radian
REAL(fp), OPTIONAL, INTENT(OUT) :: Secant_Flux_Zenith
REAL(fp), OPTIONAL, INTENT(OUT) :: Trans_Zenith_Radian
REAL(fp), OPTIONAL, INTENT(OUT) :: Secant_Trans_Zenith
REAL(fp), OPTIONAL, INTENT(OUT) :: AU_ratio2
! Get values
IF ( PRESENT(Geometry) ) Geometry = gInfo%user
CALL CRTM_Geometry_GetValue( gInfo%user, &
iFOV = iFOV , &
Longitude = Longitude , &
Latitude = Latitude , &
Surface_Altitude = Surface_Altitude , &
Sensor_Scan_Angle = Sensor_Scan_Angle , &
Sensor_Zenith_Angle = Sensor_Zenith_Angle , &
Sensor_Azimuth_Angle = Sensor_Azimuth_Angle, &
Source_Zenith_Angle = Source_Zenith_Angle , &
Source_Azimuth_Angle = Source_Azimuth_Angle, &
Flux_Zenith_Angle = Flux_Zenith_Angle , &
Year = Year , &
Month = Month , &
Day = Day )
IF ( PRESENT(Distance_Ratio ) ) Distance_Ratio = gInfo%Distance_Ratio
IF ( PRESENT(Sensor_Scan_Radian ) ) Sensor_Scan_Radian = gInfo%Sensor_Scan_Radian
IF ( PRESENT(Sensor_Zenith_Radian ) ) Sensor_Zenith_Radian = gInfo%Sensor_Zenith_Radian
IF ( PRESENT(Sensor_Azimuth_Radian) ) Sensor_Azimuth_Radian = gInfo%Sensor_Azimuth_Radian
IF ( PRESENT(Secant_Sensor_Zenith ) ) Secant_Sensor_Zenith = gInfo%Secant_Sensor_Zenith
IF ( PRESENT(Cosine_Sensor_Zenith ) ) Cosine_Sensor_Zenith = gInfo%Cosine_Sensor_Zenith
IF ( PRESENT(Source_Zenith_Radian ) ) Source_Zenith_Radian = gInfo%Source_Zenith_Radian
IF ( PRESENT(Source_Azimuth_Radian) ) Source_Azimuth_Radian = gInfo%Source_Azimuth_Radian
IF ( PRESENT(Secant_Source_Zenith ) ) Secant_Source_Zenith = gInfo%Secant_Source_Zenith
IF ( PRESENT(Flux_Zenith_Radian ) ) Flux_Zenith_Radian = gInfo%Flux_Zenith_Radian
IF ( PRESENT(Secant_Flux_Zenith ) ) Secant_Flux_Zenith = gInfo%Secant_Flux_Zenith
IF ( PRESENT(Trans_Zenith_Radian ) ) Trans_Zenith_Radian = gInfo%Trans_Zenith_Radian
IF ( PRESENT(Secant_Trans_Zenith ) ) Secant_Trans_Zenith = gInfo%Secant_Trans_Zenith
IF ( PRESENT(AU_ratio2 ) ) AU_ratio2 = gInfo%AU_ratio2
END SUBROUTINE CRTM_GeometryInfo_GetValue
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! CRTM_GeometryInfo_IsValid
!
! PURPOSE:
! Non-pure function to perform some simple validity checks on a
! CRTM GeometryInfo container object.
!
! If invalid data is found, a message is printed to stdout.
!
! CALLING SEQUENCE:
! result = CRTM_GeometryInfo_IsValid( gInfo )
!
! or
!
! IF ( CRTM_GeometryInfo_IsValid( gInfo ) ) THEN....
!
! OBJECTS:
! gInfo: CRTM GeometryInfo object which is to have its
! contents checked.
! UNITS: N/A
! TYPE: CRTM_GeometryInfo_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
! result: Logical variable indicating whether or not the input
! passed the check.
! If == .FALSE., GeometryInfo object is unused or contains
! invalid data.
! == .TRUE., GeometryInfo object can be used in CRTM.
! UNITS: N/A
! TYPE: LOGICAL
! DIMENSION: Scalar
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='CRTM_GEOMETRYINFO_ISVALID'><A href='../../html_code/crtm/CRTM_GeometryInfo_Define.f90.html#CRTM_GEOMETRYINFO_ISVALID' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
FUNCTION CRTM_GeometryInfo_IsValid( gInfo ) RESULT( IsValid ),1
TYPE(CRTM_GeometryInfo_type), INTENT(IN) :: gInfo
LOGICAL :: IsValid
IsValid = CRTM_Geometry_IsValid( gInfo%user )
END FUNCTION CRTM_GeometryInfo_IsValid
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! CRTM_GeometryInfo_Inspect
!
! PURPOSE:
! Subroutine to print the contents of a CRTM GeometryInfo container object
! to stdout.
!
! CALLING SEQUENCE:
! CALL CRTM_GeometryInfo_Inspect( gInfo )
!
! INPUTS:
! gInfo: CRTM GeometryInfo object to display.
! UNITS: N/A
! TYPE: CRTM_GeometryInfo_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------
<A NAME='CRTM_GEOMETRYINFO_INSPECT'><A href='../../html_code/crtm/CRTM_GeometryInfo_Define.f90.html#CRTM_GEOMETRYINFO_INSPECT' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE CRTM_GeometryInfo_Inspect( gInfo ),1
TYPE(CRTM_GeometryInfo_type), INTENT(IN) :: gInfo
CHARACTER(*), PARAMETER :: RFMT = 'es13.6'
WRITE(*, '(1x,"GeometryInfo OBJECT")')
WRITE(*, '(3x,"Distance ratio :",1x,'//RFMT//')') gInfo%Distance_Ratio
! ...Sensor angle information
WRITE(*, '(3x,"Sensor scan radian :",1x,'//RFMT//')') gInfo%Sensor_Scan_Radian
WRITE(*, '(3x,"Sensor zenith radian :",1x,'//RFMT//')') gInfo%Sensor_Zenith_Radian
WRITE(*, '(3x,"Sensor azimuth radian :",1x,'//RFMT//')') gInfo%Sensor_Azimuth_Radian
WRITE(*, '(3x,"Secant sensor zenith :",1x,'//RFMT//')') gInfo%Secant_Sensor_Zenith
WRITE(*, '(3x,"Cosine sensor zenith :",1x,'//RFMT//')') gInfo%Cosine_Sensor_Zenith
! ...Transmittance algorithm sensor angle information
WRITE(*, '(3x,"Trans zenith radian :",1x,'//RFMT//')') gInfo%Trans_Zenith_Radian
WRITE(*, '(3x,"Secant trans zenith :",1x,'//RFMT//')') gInfo%Secant_Trans_Zenith
! ...Source angle information
WRITE(*, '(3x,"Source zenith radian :",1x,'//RFMT//')') gInfo%Source_Zenith_Radian
WRITE(*, '(3x,"Source azimuth radian :",1x,'//RFMT//')') gInfo%Source_Azimuth_Radian
WRITE(*, '(3x,"Secant source zenith :",1x,'//RFMT//')') gInfo%Secant_Source_Zenith
! ...Flux angle information
WRITE(*, '(3x,"Flux zenith radian :",1x,'//RFMT//')') gInfo%Flux_Zenith_Radian
WRITE(*, '(3x,"Secant flux zenith :",1x,'//RFMT//')') gInfo%Secant_Flux_Zenith
! ...AU ratio information
WRITE(*, '(3x,"AU ratio^2 :",1x,'//RFMT//')') gInfo%AU_ratio2
! The contained object
CALL CRTM_Geometry_Inspect(gInfo%user)
END SUBROUTINE CRTM_GeometryInfo_Inspect
!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! CRTM_GeometryInfo_DefineVersion
!
! PURPOSE:
! Subroutine to return the module version information.
!
! CALLING SEQUENCE:
! CALL CRTM_GeometryInfo_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-:
!--------------------------------------------------------------------------------
<A NAME='CRTM_GEOMETRYINFO_DEFINEVERSION'><A href='../../html_code/crtm/CRTM_GeometryInfo_Define.f90.html#CRTM_GEOMETRYINFO_DEFINEVERSION' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE CRTM_GeometryInfo_DefineVersion( Id )
CHARACTER(*), INTENT(OUT) :: Id
Id = MODULE_VERSION_ID
END SUBROUTINE CRTM_GeometryInfo_DefineVersion
!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! CRTM_GeometryInfo_InquireFile
!
! PURPOSE:
! Function to inquire CRTM GeometryInfo object files.
!
! CALLING SEQUENCE:
! Error_Status = CRTM_GeometryInfo_InquireFile( &
! Filename , &
! n_Profiles = n_Profiles )
!
! INPUTS:
! Filename: Character string specifying the name of a
! CRTM GeometryInfo data file to read.
! UNITS: N/A
! TYPE: CHARACTER(*)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OPTIONAL OUTPUTS:
! n_Profiles: The number of profiles for which there is geometry
! information 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-:
!------------------------------------------------------------------------------
<A NAME='CRTM_GEOMETRYINFO_INQUIREFILE'><A href='../../html_code/crtm/CRTM_GeometryInfo_Define.f90.html#CRTM_GEOMETRYINFO_INQUIREFILE' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
FUNCTION CRTM_GeometryInfo_InquireFile( &,5
Filename , & ! Input
n_Profiles) & ! Optional output
RESULT( err_stat )
! Arguments
CHARACTER(*), INTENT(IN) :: Filename
INTEGER , OPTIONAL, INTENT(OUT) :: n_Profiles
! Function result
INTEGER :: err_stat
! Function parameters
CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_GeometryInfo_InquireFile'
! Function variables
CHARACTER(ML) :: msg
CHARACTER(ML) :: io_msg
INTEGER :: io_stat
INTEGER :: fid
INTEGER :: 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 profiles
READ( fid,IOSTAT=io_stat,IOMSG=io_msg ) 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_Profiles) ) n_Profiles = m
CONTAINS
<A NAME='INQUIRE_CLEANUP'><A href='../../html_code/crtm/CRTM_GeometryInfo_Define.f90.html#INQUIRE_CLEANUP' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE Inquire_CleanUp() 158,27
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_GeometryInfo_InquireFile
!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! CRTM_GeometryInfo_ReadFile
!
! PURPOSE:
! Function to read CRTM GeometryInfo object files.
!
! CALLING SEQUENCE:
! Error_Status = CRTM_GeometryInfo_ReadFile( &
! Filename , &
! GeometryInfo , &
! Quiet = Quiet , &
! n_Profiles = n_Profiles )
!
! INPUTS:
! Filename: Character string specifying the name of an
! a GeometryInfo data file to read.
! UNITS: N/A
! TYPE: CHARACTER(*)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
! GeometryInfo: CRTM GeometryInfo object array containing the
! data read from file.
! UNITS: N/A
! TYPE: CRTM_Geometry_type
! DIMENSION: Rank-1
! 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_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-:
!------------------------------------------------------------------------------
<A NAME='CRTM_GEOMETRYINFO_READFILE'><A href='../../html_code/crtm/CRTM_GeometryInfo_Define.f90.html#CRTM_GEOMETRYINFO_READFILE' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
FUNCTION CRTM_GeometryInfo_ReadFile( &,9
Filename , & ! Input
GeometryInfo, & ! Output
Quiet , & ! Optional input
n_Profiles , & ! Optional output
Debug ) & ! Optional input (Debug output control)
RESULT( err_stat )
! Arguments
CHARACTER(*), INTENT(IN) :: Filename
TYPE(CRTM_GeometryInfo_type), INTENT(OUT) :: GeometryInfo(:)
LOGICAL, OPTIONAL, INTENT(IN) :: Quiet
INTEGER, OPTIONAL, INTENT(OUT) :: n_Profiles
LOGICAL, OPTIONAL, INTENT(IN) :: Debug
! Function result
INTEGER :: err_stat
! Function parameters
CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_Geometry_ReadFile'
! Function variables
CHARACTER(ML) :: msg
CHARACTER(ML) :: io_msg
LOGICAL :: noisy
INTEGER :: io_stat
INTEGER :: fid
INTEGER :: m, ng
! 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) ) noisy = Debug
! ...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 ) ng
IF ( io_stat /= 0 ) THEN
msg = 'Error reading data dimension from '//TRIM(Filename)//' - '//TRIM(io_msg)
CALL Read_Cleanup(); RETURN
END IF
! ...Check if output array large enough
IF ( ng > SIZE(GeometryInfo) ) THEN
WRITE( msg,'("Number of entries, ",i0," > size of the output ",&
&"GeometryInfo object array, ",i0,".")' ) ng, SIZE(GeometryInfo)
CALL Read_Cleanup(); RETURN
END IF
! Loop over all the profiles
GeometryInfo_Loop: DO m = 1, ng
err_stat = Read_Record( fid, GeometryInfo(m) )
IF ( err_stat /= SUCCESS ) THEN
WRITE( msg,'("Error reading GeometryInfo element #",i0," from ",a)' ) m, TRIM(Filename)
CALL Read_Cleanup(); RETURN
END IF
END DO GeometryInfo_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_Profiles) ) n_Profiles = ng
! Output an info message
IF ( noisy ) THEN
WRITE( msg,'("Number of profiles read from ",a,": ",i0)' ) TRIM(Filename), ng
CALL Display_Message( ROUTINE_NAME, msg, INFORMATION )
END IF
CONTAINS
<A NAME='READ_CLEANUP'><A href='../../html_code/crtm/CRTM_GeometryInfo_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(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
CALL CRTM_GeometryInfo_Destroy( GeometryInfo )
err_stat = FAILURE
CALL Display_Message( ROUTINE_NAME, msg, err_stat )
END SUBROUTINE Read_CleanUp
END FUNCTION CRTM_GeometryInfo_ReadFile
!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
! CRTM_GeometryInfo_WriteFile
!
! PURPOSE:
! Function to write CRTM GeometryInfo object files.
!
! CALLING SEQUENCE:
! Error_Status = CRTM_GeometryInfo_WriteFile( &
! Filename , &
! Geometry , &
! Quiet = Quiet )
!
! INPUTS:
! Filename: Character string specifying the name of the
! GeometryInfo format data file to write.
! UNITS: N/A
! TYPE: CHARACTER(*)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! GeometryInfo: CRTM GeometryInfo object array containing the
! data to write.
! UNITS: N/A
! TYPE: CRTM_Geometry_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
!
! 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-:
!------------------------------------------------------------------------------
<A NAME='CRTM_GEOMETRYINFO_WRITEFILE'><A href='../../html_code/crtm/CRTM_GeometryInfo_Define.f90.html#CRTM_GEOMETRYINFO_WRITEFILE' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
FUNCTION CRTM_GeometryInfo_WriteFile( &,7
Filename , & ! Input
GeometryInfo, & ! Input
Quiet , & ! Optional input
Debug ) & ! Optional input (Debug output control)
RESULT( err_stat )
! Arguments
CHARACTER(*), INTENT(IN) :: Filename
TYPE(CRTM_GeometryInfo_type), INTENT(IN) :: GeometryInfo(:)
LOGICAL, OPTIONAL, INTENT(IN) :: Quiet
LOGICAL, OPTIONAL, INTENT(IN) :: Debug
! Function result
INTEGER :: err_stat
! Function parameters
CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_GeometryInfo_WriteFile'
! Function variables
CHARACTER(ML) :: msg
CHARACTER(ML) :: io_msg
LOGICAL :: noisy
INTEGER :: io_stat
INTEGER :: fid
INTEGER :: m, ng
! 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) ) noisy = Debug
! 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
ng = SIZE(GeometryInfo)
WRITE( fid, IOSTAT=io_stat ) ng
IF ( io_stat /= 0 ) THEN
msg = 'Error writing data dimension to '//TRIM(Filename)//'- '//TRIM(io_msg)
CALL Write_Cleanup(); RETURN
END IF
! Write the data
GeometryInfo_Loop: DO m = 1, ng
err_stat = Write_Record( fid, GeometryInfo(m) )
IF ( err_stat /= SUCCESS ) THEN
WRITE( msg,'("Error writing GeometryInfo element #",i0," to ",a)' ) m, TRIM(Filename)
CALL Write_Cleanup(); RETURN
END IF
END DO GeometryInfo_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), ng
CALL Display_Message( ROUTINE_NAME, msg, INFORMATION )
END IF
CONTAINS
<A NAME='WRITE_CLEANUP'><A href='../../html_code/crtm/CRTM_GeometryInfo_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(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_GeometryInfo_WriteFile
!##################################################################################
!##################################################################################
!## ##
!## ## PRIVATE MODULE ROUTINES ## ##
!## ##
!##################################################################################
!##################################################################################
!--------------------------------------------------------------------------------
!
! NAME:
! CRTM_GeometryInfo_Equal
!
! PURPOSE:
! Elemental function to test the equality of two CRTM_GeometryInfo objects.
! Used in OPERATOR(==) interface block.
!
! CALLING SEQUENCE:
! is_equal = CRTM_GeometryInfo_Equal( x, y )
!
! or
!
! IF ( x == y ) THEN
! ...
! END IF
!
! OBJECTS:
! x, y: Two CRTM GeometryInfo objects to be compared.
! UNITS: N/A
! TYPE: CRTM_GeometryInfo_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.
!
!--------------------------------------------------------------------------------
<A NAME='CRTM_GEOMETRYINFO_EQUAL'><A href='../../html_code/crtm/CRTM_GeometryInfo_Define.f90.html#CRTM_GEOMETRYINFO_EQUAL' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
ELEMENTAL FUNCTION CRTM_GeometryInfo_Equal( x, y ) RESULT( is_equal ) 1
TYPE(CRTM_GeometryInfo_type) , INTENT(IN) :: x, y
LOGICAL :: is_equal
is_equal = ( (x%user == y%user ) .AND. &
(x%Distance_Ratio .EqualTo. y%Distance_Ratio ) .AND. &
(x%Sensor_Scan_Radian .EqualTo. y%Sensor_Scan_Radian ) .AND. &
(x%Sensor_Zenith_Radian .EqualTo. y%Sensor_Zenith_Radian ) .AND. &
(x%Sensor_Azimuth_Radian .EqualTo. y%Sensor_Azimuth_Radian) .AND. &
(x%Secant_Sensor_Zenith .EqualTo. y%Secant_Sensor_Zenith ) .AND. &
(x%Trans_Zenith_Radian .EqualTo. y%Trans_Zenith_Radian ) .AND. &
(x%Secant_Trans_Zenith .EqualTo. y%Secant_Trans_Zenith ) .AND. &
(x%Cosine_Sensor_Zenith .EqualTo. y%Cosine_Sensor_Zenith ) .AND. &
(x%Source_Zenith_Radian .EqualTo. y%Source_Zenith_Radian ) .AND. &
(x%Source_Azimuth_Radian .EqualTo. y%Source_Azimuth_Radian) .AND. &
(x%Secant_Source_Zenith .EqualTo. y%Secant_Source_Zenith ) .AND. &
(x%Flux_Zenith_Radian .EqualTo. y%Flux_Zenith_Radian ) .AND. &
(x%Secant_Flux_Zenith .EqualTo. y%Secant_Flux_Zenith ) .AND. &
(x%AU_ratio2 .EqualTo. y%AU_ratio2 ) )
END FUNCTION CRTM_GeometryInfo_Equal
!--------------------------------------------------------------------------------
!
! NAME:
! CRTM_GeometryInfo_Subtract
!
! PURPOSE:
! Pure function to subtract two CRTM GeometryInfo objects.
! Used in OPERATOR(-) interface block.
!
! CALLING SEQUENCE:
! gidiff = CRTM_GeometryInfo_Subtract( gi1, gi2 )
!
! or
!
! gidiff = gi1 - gi2
!
!
! INPUTS:
! gi1, gi2: The GeometryInfo objects to difference.
! UNITS: N/A
! TYPE: CRTM_GeometryInfo_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN OUT)
!
! RESULT:
! gidiff: GeometryInfo object containing the differenced components.
! UNITS: N/A
! TYPE: CRTM_GeometryInfo_type
! DIMENSION: Scalar
!
!--------------------------------------------------------------------------------
<A NAME='CRTM_GEOMETRYINFO_SUBTRACT'><A href='../../html_code/crtm/CRTM_GeometryInfo_Define.f90.html#CRTM_GEOMETRYINFO_SUBTRACT' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
ELEMENTAL FUNCTION CRTM_GeometryInfo_Subtract( gi1, gi2 ) RESULT( gidiff ) 1
TYPE(CRTM_GeometryInfo_type), INTENT(IN) :: gi1, gi2
TYPE(CRTM_GeometryInfo_type) :: gidiff
! Copy the first structure
gidiff = gi1
! And subtract the second one's components from it
! ...Contained objects
gidiff%user = gidiff%user - gi2%user
! ...Individual components
gidiff%Distance_Ratio = gidiff%Distance_Ratio - gi2%Distance_Ratio
gidiff%Sensor_Scan_Radian = gidiff%Sensor_Scan_Radian - gi2%Sensor_Scan_Radian
gidiff%Sensor_Zenith_Radian = gidiff%Sensor_Zenith_Radian - gi2%Sensor_Zenith_Radian
gidiff%Sensor_Azimuth_Radian = gidiff%Sensor_Azimuth_Radian - gi2%Sensor_Azimuth_Radian
gidiff%Secant_Sensor_Zenith = gidiff%Secant_Sensor_Zenith - gi2%Secant_Sensor_Zenith
gidiff%Cosine_Sensor_Zenith = gidiff%Cosine_Sensor_Zenith - gi2%Cosine_Sensor_Zenith
gidiff%Trans_Zenith_Radian = gidiff%Trans_Zenith_Radian - gi2%Trans_Zenith_Radian
gidiff%Secant_Trans_Zenith = gidiff%Secant_Trans_Zenith - gi2%Secant_Trans_Zenith
gidiff%Source_Zenith_Radian = gidiff%Source_Zenith_Radian - gi2%Source_Zenith_Radian
gidiff%Source_Azimuth_Radian = gidiff%Source_Azimuth_Radian - gi2%Source_Azimuth_Radian
gidiff%Secant_Source_Zenith = gidiff%Secant_Source_Zenith - gi2%Secant_Source_Zenith
gidiff%Flux_Zenith_Radian = gidiff%Flux_Zenith_Radian - gi2%Flux_Zenith_Radian
gidiff%Secant_Flux_Zenith = gidiff%Secant_Flux_Zenith - gi2%Secant_Flux_Zenith
gidiff%AU_ratio2 = gidiff%AU_ratio2 - gi2%AU_ratio2
END FUNCTION CRTM_GeometryInfo_Subtract
!----------------------------------------------------------------------------------
!
! NAME:
! Read_Record
!
! PURPOSE:
! Utility function to read a single GeometryInfo data record
!
! CALLING SEQUENCE:
! Error_Status = Read_Record( FileID, GeometryInfo )
!
! INPUTS:
! FileID: Logical unit number from which to read data.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
! GeometryInfo: CRTM GeometryInfo object containing the data read in.
! UNITS: N/A
! TYPE: CRTM_GeometryInfo_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(OUT)
!
! FUNCTION RESULT:
! Error_Status: The return value is an integer defining the error status.
! The error codes are defined in the Message_Handler module.
! If == SUCCESS, the read was successful
! == FAILURE, an unrecoverable error occurred.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
!
!----------------------------------------------------------------------------------
<A NAME='READ_RECORD'><A href='../../html_code/crtm/CRTM_GeometryInfo_Define.f90.html#READ_RECORD' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
FUNCTION Read_Record( fid, ginfo ) RESULT( err_stat ) 10,64
! Arguments
INTEGER, INTENT(IN) :: fid
TYPE(CRTM_GeometryInfo_type), INTENT(OUT) :: ginfo
! Function result
INTEGER :: err_stat
! Function parameters
CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_GeometryInfo_ReadFile(Record)'
! Function variables
CHARACTER(ML) :: msg
CHARACTER(ML) :: io_msg
INTEGER :: io_stat
! Set up
err_stat = SUCCESS
! Read the embedded Geometry structure
err_stat = CRTM_Geometry_ReadRecord( fid, ginfo%user )
IF ( err_stat /= SUCCESS ) THEN
msg = 'Error reading embedded Geometry data'
CALL Read_Record_Cleanup(); RETURN
END IF
! Read the data record
READ( fid, IOSTAT=io_stat,IOMSG=io_msg ) &
ginfo%Distance_Ratio , &
ginfo%Sensor_Scan_Radian , &
ginfo%Sensor_Zenith_Radian , &
ginfo%Sensor_Azimuth_Radian, &
ginfo%Secant_Sensor_Zenith , &
ginfo%Cosine_Sensor_Zenith , &
ginfo%Trans_Zenith_Radian , &
ginfo%Secant_Trans_Zenith , &
ginfo%Source_Zenith_Radian , &
ginfo%Source_Azimuth_Radian, &
ginfo%Secant_Source_Zenith , &
ginfo%Flux_Zenith_Radian , &
ginfo%Secant_Flux_Zenith , &
ginfo%AU_ratio2
IF ( io_stat /= 0 ) THEN
msg = 'Error reading GeometryInfo data - '//TRIM(io_msg)
CALL Read_Record_Cleanup(); RETURN
END IF
CONTAINS
<A NAME='READ_RECORD_CLEANUP'><A href='../../html_code/crtm/CRTM_GeometryInfo_Define.f90.html#READ_RECORD_CLEANUP' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE Read_Record_Cleanup() 53,18
CALL CRTM_GeometryInfo_Destroy( ginfo )
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 GeometryInfo data record
!
! CALLING SEQUENCE:
! Error_Status = Write_Record( FileID, GeometryInfo )
!
! INPUTS:
! FileID: Logical unit number to which data is written
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! GeometryInfo: CRTM GeometryInfo object containing the data to write.
! UNITS: N/A
! TYPE: CRTM_GeometryInfo_type
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN)
!
! 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 record write was successful
! == FAILURE an unrecoverable error occurred.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
!
!----------------------------------------------------------------------------------
<A NAME='WRITE_RECORD'><A href='../../html_code/crtm/CRTM_GeometryInfo_Define.f90.html#WRITE_RECORD' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
FUNCTION Write_Record( fid, ginfo ) RESULT( err_stat ) 10,52
! Arguments
INTEGER, INTENT(IN) :: fid
TYPE(CRTM_GeometryInfo_type), INTENT(IN) :: ginfo
! Function result
INTEGER :: err_stat
! Function parameters
CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_GeometryInfo_WriteFile(Record)'
! Function variables
CHARACTER(ML) :: msg
CHARACTER(ML) :: io_msg
INTEGER :: io_stat
! Set up
err_stat = SUCCESS
! Write the embedded Geometry structure
err_stat = CRTM_Geometry_WriteRecord( fid, ginfo%user )
IF ( err_stat /= SUCCESS ) THEN
msg = 'Error writing embedded Geometry data'
CALL Write_Record_Cleanup(); RETURN
END IF
! Write the data record
WRITE( fid,IOSTAT=io_stat,IOMSG=io_msg ) &
ginfo%Distance_Ratio , &
ginfo%Sensor_Scan_Radian , &
ginfo%Sensor_Zenith_Radian , &
ginfo%Sensor_Azimuth_Radian, &
ginfo%Secant_Sensor_Zenith , &
ginfo%Cosine_Sensor_Zenith , &
ginfo%Trans_Zenith_Radian , &
ginfo%Secant_Trans_Zenith , &
ginfo%Source_Zenith_Radian , &
ginfo%Source_Azimuth_Radian, &
ginfo%Secant_Source_Zenith , &
ginfo%Flux_Zenith_Radian , &
ginfo%Secant_Flux_Zenith , &
ginfo%AU_ratio2
IF ( io_stat /= 0 ) THEN
msg = 'Error writing GeometryInfo data - '//TRIM(io_msg)
CALL Write_Record_Cleanup(); RETURN
END IF
CONTAINS
<A NAME='WRITE_RECORD_CLEANUP'><A href='../../html_code/crtm/CRTM_GeometryInfo_Define.f90.html#WRITE_RECORD_CLEANUP' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE Write_Record_Cleanup() 48,9
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_GeometryInfo_Define