!
! ODZeeman_TauCoeff
!
! Module containing the shared absorption coefficients (TauCoeff)
! and their load/destruction routines for the Optical Depth Pressure
! Space (ODPS).
!
! PUBLIC DATA:
! TC: Data structure array containing the transmittance model
! coefficient data for the requested sensors.
!
! SIDE EFFECTS:
! Routines in this module modify the contents of the public
! data structure TC.
!
! CREATION HISTORY:
! Written by: Paul van Delst, CIMSS/SSEC 12-Jun-2000
! paul.vandelst@ssec.wisc.edu
!
! Modifed by: Yong Han, NESDIS/STAR 10-July-2008
! yong.han@noaa.gov
!
MODULE ODZeeman_TauCoeff
! -----------------
! Environment setup
! -----------------
! Module use
USE Message_Handler , ONLY: SUCCESS, FAILURE, WARNING, Display_Message
USE ODPS_Define , ONLY: ODPS_TauCoeff_type => ODPS_type, &
ODPS_Destroy_TauCoeff => Destroy_ODPS
USE ODPS_Binary_IO , ONLY: Read_TauCoeff_Binary => Read_ODPS_Binary
! Disable all implicit typing
IMPLICIT NONE
! ------------
! Visibilities
! ------------
! Everything private by default
PRIVATE
! The shared data
PUBLIC :: TC
! Public routines in this module
PUBLIC :: Load_TauCoeff
PUBLIC :: Destroy_TauCoeff
! -----------------
! Module parameters
! -----------------
CHARACTER(*), PARAMETER, PRIVATE :: MODULE_RCS_ID = &
'$Id: ODZeeman_TauCoeff.f90 99117 2017-11-27 18:37:14Z tong.zhu@noaa.gov $'
! --------------------------------------
! The shared data for the gas absorption
! (AtmAbsorption) model
! --------------------------------------
TYPE(ODPS_TauCoeff_type), SAVE, ALLOCATABLE, TARGET :: TC(:)
CONTAINS
!------------------------------------------------------------------------------
!
! NAME:
! Load_TauCoeff
!
! PURPOSE:
! Function to load the TauCoeff transmittance coefficient data into
! the shared data structure.
!
! CALLING SEQUENCE:
! Error_Status = Load_TauCoeff( Filename , &
! File_Path =File_Path , & ! Optional input
! Quiet =Quiet , & ! Optional input
! Process_ID =Process_ID , & ! Optional input
! Output_Process_ID=Output_Process_ID, & ! Optional input
! Message_Log =Message_Log ) ! Error messaging
!
! OPTIONAL INPUT ARGUMENTS:
! Filename: Character string array specifying the name/s of the
! binary format Zeeman file/s
! UNITS: N/A
! TYPE: CHARACTER(*)
! DIMENSION: Rank-1
! ATTRIBUTES: INTENT(IN)
!
! File_Path: Character string specifying a file path for the
! input data files. If not specified, the current
! directory is the default.
! UNITS: N/A
! TYPE: CHARACTER(*)
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
! Quiet: Set this argument to suppress INFORMATION messages
! being printed to standard output (or the message
! log file if the Message_Log optional argument is
! used.) By default, INFORMATION messages are printed.
! If QUIET = 0, INFORMATION messages are OUTPUT.
! QUIET = 1, INFORMATION messages are SUPPRESSED.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
! Process_ID: Set this argument to the MPI process ID that this
! function call is running under. This value is used
! solely for controlling INFORMATIOn message output.
! If MPI is not being used, ignore this argument.
! This argument is ignored if the Quiet argument is set.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
! Output_Process_ID: Set this argument to the MPI process ID in which
! all INFORMATION messages are to be output. If
! the passed Process_ID value agrees with this value
! the INFORMATION messages are output.
! This argument is ignored if the Quiet argument
! is set.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
! Message_Log: Character string specifying a filename in which
! any messages will be logged. If not specified,
! or if an error occurs opening the log file, the
! default action is to output messages to standard
! output.
! 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 TauCoeff data load was successful
! == FAILURE an unrecoverable error occurred.
! == WARNING the number of channels read in differs
! from that stored in the CRTM_Parameters
! module.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
!
! SIDE EFFECTS:
! This function modifies the contents of the public data structures
! in this module.
!
!------------------------------------------------------------------------------
FUNCTION Load_TauCoeff( FileName , & ! Input
File_Path , & ! Optional input
Quiet , & ! Optional input
Process_ID , & ! Optional input
Output_Process_ID, & ! Optional input
Message_Log ) & ! Error messaging
RESULT( Error_Status )
! Arguments
CHARACTER(*), DIMENSION(:), INTENT(IN) :: FileName
CHARACTER(*), OPTIONAL, INTENT(IN) :: File_Path
INTEGER, OPTIONAL, INTENT(IN) :: Quiet
INTEGER, OPTIONAL, INTENT(IN) :: Process_ID
INTEGER, OPTIONAL, INTENT(IN) :: Output_Process_ID
CHARACTER(*), OPTIONAL, INTENT(IN) :: Message_Log
! Function result
INTEGER :: Error_Status
! Local parameters
CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Load_TauCoeff'
! Local variables
CHARACTER(256) :: Message
CHARACTER(256) :: Process_ID_Tag
CHARACTER(256) :: TauCoeff_File
INTEGER :: Allocate_Status
INTEGER :: n, n_Sensors
! Set up
Error_Status = SUCCESS
! Create a process ID message tag for
! WARNING and FAILURE messages
IF ( PRESENT(Process_ID) ) THEN
WRITE( Process_ID_Tag, '("; MPI Process ID: ",i0)' ) Process_ID
ELSE
Process_ID_Tag = ' '
END IF
n_Sensors = SIZE(Filename)
! Allocate the TauCoeff shared data structure array
ALLOCATE(TC(n_Sensors), STAT=Allocate_Status)
IF( Allocate_Status /= 0 )THEN
WRITE(Message,'("TauCoeff structure array allocation failed. STAT=",i0)') Allocate_Status
Error_Status = FAILURE
CALL Display_Message( ROUTINE_NAME, &
TRIM(Message)//TRIM(Process_ID_Tag), &
Error_Status, &
Message_Log = Message_Log )
RETURN
END IF
! Read the TauCoeff data files
DO n = 1, n_Sensors
! Add the file path
IF ( PRESENT(File_Path) ) THEN
TauCoeff_File = TRIM(ADJUSTL(File_Path))//TRIM(FileName(n))
ELSE
TauCoeff_File = TRIM(FileName(n))
END IF
Error_Status = Read_TauCoeff_Binary( TRIM(TauCoeff_File) , & ! Input
TC(n) , & ! Output
Quiet =Quiet , &
Process_ID =Process_ID , &
Output_Process_ID=Output_Process_ID, &
Message_Log =Message_Log )
IF ( Error_Status /= SUCCESS ) THEN
WRITE(Message,'("Error reading TauCoeff file #",i0,", ",a)') &
n, TRIM(TauCoeff_File)
CALL Display_Message( ROUTINE_NAME, &
TRIM(Message)//TRIM(Process_ID_Tag), &
Error_Status, &
Message_Log=Message_Log )
RETURN
END IF
END DO
END FUNCTION Load_TauCoeff
!------------------------------------------------------------------------------
!
! NAME:
! Destroy_TauCoeff
!
! PURPOSE:
! Function to deallocate the public shared data structure containing
! the CRTM TauCoeff transmittance coefficient data.
!
! CALLING SEQUENCE:
! Error_Status = Destroy_TauCoeff( Process_ID = Process_ID, & ! Optional input
! Message_Log = Message_Log ) ! Error messaging
!
! OPTIONAL INPUT ARGUMENTS:
! Process_ID: Set this argument to the MPI process ID that this
! function call is running under. This value is used
! solely for controlling message output. If MPI is not
! being used, ignore this argument.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
! ATTRIBUTES: INTENT(IN), OPTIONAL
!
! Message_Log: Character string specifying a filename in which any
! messages will be logged. If not specified, or if an
! error occurs opening the log file, the default action
! is to output messages to the screen.
! 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 deallocation of the public TC data
! structure was successful
! == FAILURE an unrecoverable error occurred.
! UNITS: N/A
! TYPE: INTEGER
! DIMENSION: Scalar
!
!
! SIDE EFFECTS:
! This function modifies the contents of the public data structures
! in this module.
!
!------------------------------------------------------------------------------
FUNCTION Destroy_TauCoeff( Process_ID, & ! Optional input
Message_Log ) & ! Error messaging
RESULT( Error_Status )
! Arguments
INTEGER, OPTIONAL, INTENT(IN) :: Process_ID
CHARACTER(*), OPTIONAL, INTENT(IN) :: Message_Log
! Function result
INTEGER :: Error_Status
! Local parameters
CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_Destroy_TauCoeff'
! Local variables
CHARACTER(256) :: Message
CHARACTER(256) :: Process_ID_Tag
INTEGER :: n, Destroy_Status, Allocate_Status
! Set up
Error_Status = SUCCESS
! Create a process ID message tag for
! WARNING and FAILURE messages
IF ( PRESENT( Process_ID ) ) THEN
WRITE( Process_ID_Tag, '("; MPI Process ID: ",i0)' ) Process_ID
ELSE
Process_ID_Tag = ' '
END IF
! Destroy the structure array elements
DO n = 1, SIZE(TC)
Destroy_Status = ODPS_Destroy_TauCoeff( TC(n), &
Message_Log=Message_Log )
IF ( Destroy_Status /= SUCCESS ) THEN
Error_Status = FAILURE
WRITE(Message,'("Error destroying TauCoeff structure array element #",i0)') n
CALL Display_Message( ROUTINE_NAME, &
TRIM(Message)//TRIM(Process_ID_Tag), &
Error_Status, &
Message_Log=Message_Log )
! No return here. Continue deallocating
END IF
END DO
! Deallocate the structure array
DEALLOCATE(TC, STAT=Allocate_Status)
IF( Allocate_Status /= 0 )THEN
WRITE(Message,'("RTTOV TC structure deallocation failed. STAT=",i0)') Allocate_Status
Error_Status = FAILURE
CALL Display_Message( ROUTINE_NAME, &
TRIM(Message)//TRIM(Process_ID_Tag), &
Error_Status, &
Message_Log=Message_Log)
! Again, no return.
END IF
END FUNCTION Destroy_TauCoeff
END MODULE ODZeeman_TauCoeff