diff --git a/libsrc/ACCoeff_netCDF_IO.f90 b/libsrc/ACCoeff_netCDF_IO.f90 new file mode 100755 index 000000000..af1b63f0f --- /dev/null +++ b/libsrc/ACCoeff_netCDF_IO.f90 @@ -0,0 +1,1360 @@ +! +! ACCoeff_netCDF_IO +! +! Module containing routines to read and write ACCoeff netCDF +! format files. +! +! +! CREATION HISTORY: +! Written by: Paul van Delst, 10-Apr-2007 +! paul.vandelst@noaa.gov +! + +MODULE ACCoeff_netCDF_IO + + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module use + USE Type_Kinds , ONLY: Long, Double + USE Message_Handler, ONLY: SUCCESS, FAILURE, INFORMATION, Display_Message + USE File_Utility , ONLY: File_Exists + USE String_Utility , ONLY: StrClean + USE ACCoeff_Define , ONLY: ACCoeff_type , & + ACCoeff_Associated , & + ACCoeff_Destroy , & + ACCoeff_Create , & + ACCoeff_Inspect , & + ACCoeff_ValidRelease , & + ACCoeff_Info + USE netcdf + ! Disable implicit typing + IMPLICIT NONE + + + ! ------------ + ! Visibilities + ! ------------ + ! Everything private by default + PRIVATE + ! Procedures + PUBLIC :: ACCoeff_netCDF_InquireFile + PUBLIC :: ACCoeff_netCDF_ReadFile + PUBLIC :: ACCoeff_netCDF_WriteFile + PUBLIC :: ACCoeff_netCDF_IOVersion + + + ! ----------------- + ! Module parameters + ! ----------------- + CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = & + '$Id: ACCoeff_netCDF_IO.f90 13518 2011-04-22 17:25:42Z paul.vandelst@noaa.gov $' + ! Default message string length + INTEGER, PARAMETER :: ML = 1024 + ! Literal constants + REAL(Double), PARAMETER :: ZERO = 0.0_Double + REAL(Double), PARAMETER :: ONE = 1.0_Double + + ! Global attribute names. Case sensitive + CHARACTER(*), PARAMETER :: RELEASE_GATTNAME = 'Release' + CHARACTER(*), PARAMETER :: VERSION_GATTNAME = 'Version' + CHARACTER(*), PARAMETER :: TITLE_GATTNAME = 'Title' + CHARACTER(*), PARAMETER :: HISTORY_GATTNAME = 'History' + CHARACTER(*), PARAMETER :: COMMENT_GATTNAME = 'Comment' + CHARACTER(*), PARAMETER :: SENSOR_ID_GATTNAME = 'Sensor_Id' + CHARACTER(*), PARAMETER :: WMO_SATELLITE_ID_GATTNAME = 'WMO_Satellite_Id' + CHARACTER(*), PARAMETER :: WMO_SENSOR_ID_GATTNAME = 'WMO_Sensor_Id' + + ! Dimension names + CHARACTER(*), PARAMETER :: FOV_DIMNAME = 'n_FOVs' + CHARACTER(*), PARAMETER :: CHANNEL_DIMNAME = 'n_Channels' + + ! Variable names + CHARACTER(*), PARAMETER :: SENSOR_CHANNEL_VARNAME = 'Sensor_Channel' + CHARACTER(*), PARAMETER :: A_EARTH_VARNAME = 'A_earth' + CHARACTER(*), PARAMETER :: A_SPACE_VARNAME = 'A_space' + CHARACTER(*), PARAMETER :: A_PLATFORM_VARNAME = 'A_platform' + + ! Variable long name attribute. + CHARACTER(*), PARAMETER :: LONGNAME_ATTNAME = 'long_name' + + CHARACTER(*), PARAMETER :: SENSOR_CHANNEL_LONGNAME = 'Sensor Channel' + CHARACTER(*), PARAMETER :: A_EARTH_LONGNAME = 'A(earth)' + CHARACTER(*), PARAMETER :: A_SPACE_LONGNAME = 'A(space)' + CHARACTER(*), PARAMETER :: A_PLATFORM_LONGNAME = 'A(platform)' + + + ! Variable description attribute. + CHARACTER(*), PARAMETER :: DESCRIPTION_ATTNAME = 'description' + + CHARACTER(*), PARAMETER :: SENSOR_CHANNEL_DESCRIPTION = 'List of sensor channel numbers' + CHARACTER(*), PARAMETER :: A_EARTH_DESCRIPTION = 'Antenna efficiency for earth view' + CHARACTER(*), PARAMETER :: A_SPACE_DESCRIPTION = 'Antenna efficiency for cold space view' + CHARACTER(*), PARAMETER :: A_PLATFORM_DESCRIPTION = 'Antenna efficiency for satellite platform view' + + ! Variable units attribute. + CHARACTER(*), PARAMETER :: UNITS_ATTNAME = 'units' + + CHARACTER(*), PARAMETER :: SENSOR_CHANNEL_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: A_EARTH_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: A_SPACE_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: A_PLATFORM_UNITS = 'N/A' + + + ! Variable _FillValue attribute. + CHARACTER(*), PARAMETER :: FILLVALUE_ATTNAME = '_FillValue' + + INTEGER(Long), PARAMETER :: SENSOR_CHANNEL_FILLVALUE = 0_Long + REAL(Double) , PARAMETER :: A_EARTH_FILLVALUE = 1.0_Double + REAL(Double) , PARAMETER :: A_SPACE_FILLVALUE = 0.0_Double + REAL(Double) , PARAMETER :: A_PLATFORM_FILLVALUE = 0.0_Double + + + ! Variable types + INTEGER, PARAMETER :: SENSOR_CHANNEL_TYPE = NF90_INT + INTEGER, PARAMETER :: A_EARTH_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: A_SPACE_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: A_PLATFORM_TYPE = NF90_DOUBLE + + +CONTAINS + + +!################################################################################ +!################################################################################ +!## ## +!## ## PUBLIC MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! ACCoeff_netCDF_InquireFile +! +! PURPOSE: +! Function to inquire ACCoeff object netCDF format files. +! +! CALLING SEQUENCE: +! Error_Status = ACCoeff_netCDF_InquireFile( & +! Filename , & +! n_FOVs = n_FOVs , & +! n_Channels = n_Channels , & +! Release = Release , & +! Version = Version , & +! Sensor_Id = Sensor_Id , & +! WMO_Satellite_Id = WMO_Satellite_Id, & +! WMO_Sensor_Id = WMO_Sensor_Id ) +! Title = Title , & +! History = History , & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of the +! ACCoeff data file to inquire. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL OUTPUTS: +! n_FOVs: Number of sensor fields-of-view (FOVs). +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! n_Channels: Number of sensor channels. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Release: The release number of the ACCoeff file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Version: The version number of the ACCoeff file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Sensor_Id: Character string sensor/platform identifier. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! WMO_Satellite_Id: The WMO code used to identify satellite platforms. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! WMO_Sensor_Id: The WMO code used to identify sensors. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Title: Character string written into the TITLE global +! attribute field of the ACCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the ACCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the ACCoeff file. +! 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 inquiry was successful +! == FAILURE an error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION ACCoeff_netCDF_InquireFile( & + Filename , & ! Input + n_FOVs , & ! Optional output + n_Channels , & ! Optional output + Release , & ! Optional Output + Version , & ! Optional Output + Sensor_Id , & ! Optional Output + WMO_Satellite_Id, & ! Optional Output + WMO_Sensor_Id , & ! Optional Output + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , OPTIONAL, INTENT(OUT) :: n_FOVs + INTEGER , OPTIONAL, INTENT(OUT) :: n_Channels + INTEGER , OPTIONAL, INTENT(OUT) :: Release + INTEGER , OPTIONAL, INTENT(OUT) :: Version + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Sensor_Id + INTEGER , OPTIONAL, INTENT(OUT) :: WMO_Satellite_Id + INTEGER , OPTIONAL, INTENT(OUT) :: WMO_Sensor_Id + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'ACCoeff_InquireFile(netCDF)' + ! Function variables + CHARACTER(ML) :: msg + LOGICAL :: close_file + INTEGER :: nf90_status + INTEGER :: fileid + INTEGER :: dimid + TYPE(ACCoeff_type) :: ACCoeff + + ! Set up + err_stat = SUCCESS + close_file = .FALSE. + + + ! Open the file + nf90_status = NF90_OPEN( Filename,NF90_NOWRITE,fileid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error opening '//TRIM(Filename)//' for read access - '// & + TRIM(NF90_STRERROR( nf90_status )) + CALL Inquire_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + close_file = .TRUE. + + + ! Get the dimensions + ! ...n_FOVs dimension + NF90_Status = NF90_INQ_DIMID( FileId,FOV_DIMNAME,DimId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//FOV_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + NF90_Status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=accoeff%n_FOVs ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//FOV_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + ! ...n_Channels dimension + NF90_Status = NF90_INQ_DIMID( FileId,CHANNEL_DIMNAME,DimId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//CHANNEL_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + NF90_Status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=accoeff%n_Channels ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//CHANNEL_DIMNAME//' - '// & + TRIM(NF90_STRERROR( NF90_Status )) + CALL Inquire_Cleanup(); RETURN + END IF + + + ! Get the global attributes + err_stat = ReadGAtts( Filename, & + fileid , & + Release = Release , & + Version = Version , & + Sensor_Id = Sensor_Id , & + WMO_Satellite_Id = WMO_Satellite_Id, & + WMO_Sensor_Id = WMO_Sensor_Id , & + Title = Title , & + History = History , & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading global attributes from '//TRIM(Filename) + CALL Inquire_Cleanup(); RETURN + END IF + + + ! Close the file + nf90_status = NF90_CLOSE( fileid ) + close_file = .FALSE. + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error closing input file - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Inquire_Cleanup(); RETURN + END IF + + + ! Set the return values + IF ( PRESENT(n_FOVs ) ) n_FOVs = ACCoeff%n_FOVs + IF ( PRESENT(n_Channels) ) n_Channels = ACCoeff%n_Channels + + CONTAINS + + SUBROUTINE Inquire_CleanUp() + IF ( close_file ) THEN + nf90_status = NF90_CLOSE( fileid ) + IF ( nf90_status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup.' + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Inquire_CleanUp + + END FUNCTION ACCoeff_netCDF_InquireFile + + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! ACCoeff_netCDF_WriteFile +! +! PURPOSE: +! Function to write ACCoeff object files in netCDF format. +! +! CALLING SEQUENCE: +! Error_Status = ACCoeff_netCDF_WriteFile( & +! Filename , & +! ACCoeff , & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of the +! ACCoeff data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! ACCoeff: ACCoeff object containing the antenna correction +! coefficient data. +! UNITS: N/A +! TYPE: ACCoeff_type +! DIMENSION: Scalar +! 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 +! +! Title: Character string written into the TITLE global +! attribute field of the ACCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the ACCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the ACCoeff file. +! 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 data write was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION ACCoeff_netCDF_WriteFile( & + Filename, & ! Input + ACCoeff , & ! Input + Quiet , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + TYPE(ACCoeff_type), INTENT(IN) :: ACCoeff + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'ACCoeff_WriteFile(netCDF)' + ! Local variables + CHARACTER(ML) :: msg + LOGICAL :: close_file + LOGICAL :: noisy + INTEGER :: nf90_status + INTEGER :: fileid + INTEGER :: varid + + ! Set up + err_stat = SUCCESS + close_file = .FALSE. + ! ...Check structure pointer association status + IF ( .NOT. ACCoeff_Associated( ACCoeff ) ) THEN + msg = 'ACCoeff structure is empty. Nothing to do!' + CALL Write_CleanUp(); RETURN + END IF + ! ...Check if release is valid + IF ( .NOT. ACCoeff_ValidRelease( ACCoeff ) ) THEN + msg = 'ACCoeff Release check failed.' + CALL Write_Cleanup(); RETURN + END IF + ! ...Check Quiet argument + noisy = .TRUE. + IF ( PRESENT(Quiet) ) noisy = .NOT. Quiet + + + ! Create the output file + err_stat = CreateFile( & + Filename , & ! Input + ACCoeff%n_FOVs , & ! Input + ACCoeff%n_Channels , & ! Input + fileid , & ! Output + Version = ACCoeff%Version , & ! Optional input + Sensor_Id = ACCoeff%Sensor_Id , & ! Optional input + WMO_Satellite_Id = ACCoeff%WMO_Satellite_Id, & ! Optional input + WMO_Sensor_Id = ACCoeff%WMO_Sensor_Id , & ! Optional input + Title = Title , & ! Optional input + History = History , & ! Optional input + Comment = Comment ) ! Optional input + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error creating output file '//TRIM(Filename) + CALL Write_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + close_file = .TRUE. + + + ! Write the data items + ! ...Sensor_Channel variable + NF90_Status = NF90_INQ_VARID( FileId,SENSOR_CHANNEL_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//SENSOR_CHANNEL_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,ACcoeff%Sensor_Channel ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//SENSOR_CHANNEL_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...A_earth variable + NF90_Status = NF90_INQ_VARID( FileId,A_EARTH_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//A_EARTH_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,ACcoeff%A_earth ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//A_EARTH_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...A_space variable + NF90_Status = NF90_INQ_VARID( FileId,A_SPACE_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//A_SPACE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,ACcoeff%A_space ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//A_SPACE_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...A_platform variable + NF90_Status = NF90_INQ_VARID( FileId,A_PLATFORM_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//A_PLATFORM_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,ACcoeff%A_platform ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//A_PLATFORM_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + + + ! Close the file + nf90_status = NF90_CLOSE( fileid ) + close_file = .FALSE. + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error closing output file - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + + + ! Output an info message + IF ( noisy ) THEN + CALL ACCoeff_Info( ACCoeff, msg ) + CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION ) + END IF + + CONTAINS + + SUBROUTINE Write_CleanUp() + IF ( close_file ) THEN + nf90_status = NF90_CLOSE( fileid ) + IF ( nf90_status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing output file during error cleanup - '//& + TRIM(NF90_STRERROR( nf90_status )) + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Write_CleanUp + + END FUNCTION ACCoeff_netCDF_WriteFile + + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! ACCoeff_netCDF_ReadFile +! +! PURPOSE: +! Function to read ACCoeff object files in netCDF format. +! +! CALLING SEQUENCE: +! Error_Status = ACCoeff_netCDF_ReadFile( & +! Filename , & +! ACCoeff , & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of the +! ACCoeff data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUTS: +! ACCoeff: ACCoeff object containing the antenna correction +! coefficient data. +! UNITS: N/A +! TYPE: ACCoeff_type +! DIMENSION: Scalar +! 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: +! Title: Character string written into the TITLE global +! attribute field of the ACCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the ACCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the ACCoeff file. +! 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 data write was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION ACCoeff_netCDF_ReadFile( & + Filename, & ! Input + ACCoeff , & ! Output + Quiet , & ! Optional input + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + TYPE(ACCoeff_type), INTENT(OUT) :: ACCoeff + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'ACCoeff_ReadFile(netCDF)' + ! Function variables + CHARACTER(ML) :: msg + LOGICAL :: close_file + LOGICAL :: noisy + INTEGER :: nf90_status + INTEGER :: fileid + INTEGER :: n_fovs + INTEGER :: n_channels + INTEGER :: varid + + + ! Set up + err_stat = SUCCESS + close_file = .FALSE. + ! ...Check that the file exists + IF ( .NOT. File_Exists(Filename) ) THEN + msg = 'File '//TRIM(Filename)//' not found.' + CALL Read_Cleanup(); RETURN + END IF + ! ...Check Quiet argument + noisy = .TRUE. + IF ( PRESENT(Quiet) ) noisy = .NOT. Quiet + + + ! Inquire the file to get the dimensions + err_stat = ACCoeff_netCDF_InquireFile( & + Filename, & + n_FOVs = n_fovs , & + n_Channels = n_channels ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error obtaining ACCoeff dimensions from '//TRIM(Filename) + CALL Read_Cleanup(); RETURN + END IF + + + ! Allocate the output structure + CALL ACCoeff_Create( & + ACCoeff, & + n_fovs , & + n_channels ) + IF ( .NOT. ACCoeff_Associated(ACCoeff) ) THEN + msg = 'Error allocating output ACCoeff' + CALL Read_Cleanup(); RETURN + END IF + + + ! Open the file for reading + nf90_status = NF90_OPEN( Filename,NF90_NOWRITE,fileid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error opening '//TRIM(Filename)//' for read access - '//& + TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + close_file = .TRUE. + + + ! Read the global attributes + err_stat = ReadGAtts( & + Filename, & + fileid , & + Release = ACCoeff%Release , & + Version = ACCoeff%Version , & + Sensor_Id = ACCoeff%Sensor_Id , & + WMO_Satellite_Id = ACCoeff%WMO_Satellite_Id, & + WMO_Sensor_Id = ACCoeff%WMO_Sensor_Id , & + Title = Title , & + History = History , & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading global attribute from '//TRIM(Filename) + CALL Read_Cleanup(); RETURN + END IF + ! ...Check if release is valid + IF ( .NOT. ACCoeff_ValidRelease( ACCoeff ) ) THEN + msg = 'ACCoeff Release check failed.' + CALL Read_Cleanup(); RETURN + END IF + + + ! Read the ACCoeff data + ! ...Sensor_Channel variable + nf90_status = NF90_INQ_VARID( fileid,SENSOR_CHANNEL_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//SENSOR_CHANNEL_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,ACcoeff%Sensor_Channel ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//SENSOR_CHANNEL_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...A_earth variable + nf90_status = NF90_INQ_VARID( fileid,A_EARTH_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//A_EARTH_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,ACcoeff%A_earth ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//A_EARTH_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...A_space variable + nf90_status = NF90_INQ_VARID( fileid,A_SPACE_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//A_SPACE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,ACcoeff%A_space ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//A_SPACE_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...A_platform variable + nf90_status = NF90_INQ_VARID( fileid,A_PLATFORM_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//A_PLATFORM_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,ACcoeff%A_platform ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//A_PLATFORM_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + + + ! Close the file + nf90_status = NF90_CLOSE( fileid ); CLOSE_FILE = .FALSE. + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error closing output file - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + + + ! Output an info message + IF ( noisy ) THEN + CALL ACCoeff_Info( ACCoeff, msg ) + CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION ) + END IF + + CONTAINS + + SUBROUTINE Read_CleanUp() + IF ( close_file ) THEN + nf90_status = NF90_CLOSE( fileid ) + IF ( nf90_status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup- '//& + TRIM(NF90_STRERROR( nf90_status )) + END IF + CALL ACCoeff_Destroy( ACCoeff ) + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Read_CleanUp + + END FUNCTION ACCoeff_netCDF_ReadFile + + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! ACCoeff_netCDF_IOVersion +! +! PURPOSE: +! Subroutine to return the module version information. +! +! CALLING SEQUENCE: +! CALL ACCoeff_netCDF_IOVersion( Id ) +! +! OUTPUT ARGUMENTS: +! Id: Character string containing the version Id information +! for the module. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT) +! +!:sdoc-: +!-------------------------------------------------------------------------------- + + SUBROUTINE ACCoeff_netCDF_IOVersion( Id ) + CHARACTER(*), INTENT(OUT) :: Id + Id = MODULE_VERSION_ID + END SUBROUTINE ACCoeff_netCDF_IOVersion + + + +!################################################################################## +!################################################################################## +!## ## +!## ## PRIVATE MODULE ROUTINES ## ## +!## ## +!################################################################################## +!################################################################################## + + ! Function to write the global attributes to a ACCoeff data file. + + FUNCTION WriteGAtts( & + Filename , & ! Input + FileId , & ! Input + Version , & ! Optional input + Sensor_Id , & ! Optional input + WMO_Satellite_Id, & ! Optional input + WMO_Sensor_Id , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: FileId + INTEGER , OPTIONAL, INTENT(IN) :: Version + CHARACTER(*), OPTIONAL, INTENT(IN) :: Sensor_Id + INTEGER , OPTIONAL, INTENT(IN) :: WMO_Satellite_Id + INTEGER , OPTIONAL, INTENT(IN) :: WMO_Sensor_Id + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'ACCoeff_WriteGAtts(netCDF)' + CHARACTER(*), PARAMETER :: WRITE_MODULE_HISTORY_GATTNAME = 'write_module_history' + CHARACTER(*), PARAMETER :: CREATION_DATE_AND_TIME_GATTNAME = 'creation_date_and_time' + ! Local variables + CHARACTER(ML) :: msg + CHARACTER(ML) :: gattname + CHARACTER(8) :: cdate + CHARACTER(10) :: ctime + CHARACTER(5) :: czone + INTEGER :: ver + INTEGER :: nf90_status + TYPE(ACCoeff_type) :: ACCoeff + + ! Set up + err_stat = SUCCESS + msg = ' ' + + ! Mandatory global attributes + ! ...Software ID + gattname = WRITE_MODULE_HISTORY_GATTNAME + nf90_status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(gattname),MODULE_VERSION_ID ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + ! ...Creation date + CALL DATE_AND_TIME( cdate, ctime, czone ) + gattname = CREATION_DATE_AND_TIME_GATTNAME + nf90_status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(gattname), & + cdate(1:4)//'/'//cdate(5:6)//'/'//cdate(7:8)//', '// & + ctime(1:2)//':'//ctime(3:4)//':'//ctime(5:6)//' '// & + czone//'UTC' ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + ! ...The Release + gattname = RELEASE_GATTNAME + nf90_status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(gattname),ACCoeff%Release ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + + + ! Optional global attributes + ! ...The Version + IF ( PRESENT(Version) ) THEN + ver = Version + ELSE + ver = ACCoeff%Version + END IF + gattname = VERSION_GATTNAME + nf90_status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(gattname),Ver ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + ! ...The Sensor_Id + IF ( PRESENT(Sensor_Id) ) THEN + gattname = SENSOR_ID_GATTNAME + nf90_status = NF90_PUT_ATT( FileID,NF90_GLOBAL,TRIM(gattname),Sensor_Id ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The WMO_Satellite_Id + IF ( PRESENT(WMO_Satellite_Id) ) THEN + gattname = WMO_SATELLITE_ID_GATTNAME + nf90_status = NF90_PUT_ATT( FileID,NF90_GLOBAL,TRIM(gattname),WMO_Satellite_Id ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The WMO_Sensor_Id + IF ( PRESENT(WMO_Sensor_Id) ) THEN + gattname = WMO_SENSOR_ID_GATTNAME + nf90_status = NF90_PUT_ATT( FileID,NF90_GLOBAL,TRIM(gattname),WMO_Sensor_Id ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The title + IF ( PRESENT(title) ) THEN + gattname = TITLE_GATTNAME + nf90_status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(gattname),title ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The history + IF ( PRESENT(history) ) THEN + gattname = HISTORY_GATTNAME + nf90_status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(gattname),history ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The comment + IF ( PRESENT(comment) ) THEN + gattname = COMMENT_GATTNAME + nf90_status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(gattname),comment ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + + CONTAINS + + SUBROUTINE WriteGAtts_CleanUp() + nf90_status = NF90_CLOSE( FileId ) + IF ( nf90_status /= NF90_NOERR ) & + msg = '; Error closing input file during error cleanup - '//& + TRIM(NF90_STRERROR( nf90_status ) ) + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//TRIM(gattname)//' attribute to '//& + TRIM(Filename)//' - '// & + TRIM(NF90_STRERROR( nf90_status ) )//TRIM(msg), & + err_stat ) + END SUBROUTINE WriteGAtts_CleanUp + + END FUNCTION WriteGAtts + + + ! Function to read the global attributes from a ACCoeff data file. + + FUNCTION ReadGAtts( & + Filename , & ! Input + FileId , & ! Input + Release , & ! Optional output + Version , & ! Optional output + Sensor_Id , & ! Optional output + WMO_Satellite_Id, & ! Optional output + WMO_Sensor_Id , & ! Optional output + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: FileId + INTEGER , OPTIONAL, INTENT(OUT) :: Release + INTEGER , OPTIONAL, INTENT(OUT) :: Version + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Sensor_Id + INTEGER , OPTIONAL, INTENT(OUT) :: WMO_Satellite_Id + INTEGER , OPTIONAL, INTENT(OUT) :: WMO_Sensor_Id + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'ACCoeff_ReadGAtts(netCDF)' + ! Local variables + CHARACTER(ML) :: msg + CHARACTER(256) :: gattname + CHARACTER(5000) :: gattstring + INTEGER :: nf90_status + + ! Set up + err_stat = SUCCESS + + ! The global attributes + ! ...The Release + IF ( PRESENT(Release) ) THEN + gattname = RELEASE_GATTNAME + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),Release ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The Version + IF ( PRESENT(Version) ) THEN + gattname = VERSION_GATTNAME + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),Version ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The Sensor_Id + IF ( PRESENT(Sensor_Id) ) THEN + gattname = SENSOR_ID_GATTNAME; gattstring = '' + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),gattstring ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( gattstring ) + Sensor_Id = gattstring(1:MIN(LEN(Sensor_Id), LEN_TRIM(gattstring))) + END IF + ! The WMO_Satellite_Id + IF ( PRESENT(WMO_Satellite_Id) ) THEN + gattname = WMO_SATELLITE_ID_GATTNAME + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),WMO_Satellite_Id ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The WMO_Sensor_Id + IF ( PRESENT(WMO_Sensor_Id) ) THEN + gattname = WMO_SENSOR_ID_GATTNAME + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),WMO_Sensor_Id ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The title + IF ( PRESENT(title) ) THEN + gattname = TITLE_GATTNAME; gattstring = '' + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),gattstring ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( gattstring ) + title = gattstring(1:MIN(LEN(title), LEN_TRIM(gattstring))) + END IF + ! ...The history + IF ( PRESENT(history) ) THEN + gattname = HISTORY_GATTNAME; gattstring = '' + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),gattstring ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( gattstring ) + history = gattstring(1:MIN(LEN(history), LEN_TRIM(gattstring))) + END IF + ! ...The comment + IF ( PRESENT(comment) ) THEN + gattname = COMMENT_GATTNAME; gattstring = '' + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),gattstring ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( gattstring ) + comment = gattstring(1:MIN(LEN(comment), LEN_TRIM(gattstring))) + END IF + + CONTAINS + + SUBROUTINE ReadGAtts_CleanUp() + err_stat = FAILURE + msg = 'Error reading '//TRIM(gattname)//' attribute from '//TRIM(Filename)//' - '// & + TRIM(NF90_STRERROR( nf90_status ) ) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + END SUBROUTINE ReadGAtts_CleanUp + + END FUNCTION ReadGAtts + + + ! Function to create a ACCoeff file for writing + + FUNCTION CreateFile( & + Filename , & ! Input + n_FOVs , & ! Input + n_Channels , & ! Input + FileId , & ! Output + Version , & ! Optional input + Sensor_Id , & ! Optional input + WMO_Satellite_Id, & ! Optional input + WMO_Sensor_Id , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: n_FOVs + INTEGER , INTENT(IN) :: n_Channels + INTEGER , INTENT(OUT) :: FileId + INTEGER , OPTIONAL, INTENT(IN) :: Version + CHARACTER(*), OPTIONAL, INTENT(IN) :: Sensor_Id + INTEGER , OPTIONAL, INTENT(IN) :: WMO_Satellite_Id + INTEGER , OPTIONAL, INTENT(IN) :: WMO_Sensor_Id + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'ACCoeff_CreateFile(netCDF)' + ! Local variables + CHARACTER(ML) :: msg + LOGICAL :: close_file + INTEGER :: nf90_status + INTEGER :: n_fovs_dimid + INTEGER :: n_channels_dimid + INTEGER :: varid + INTEGER :: put_status(4) + + ! Setup + err_stat = SUCCESS + close_file = .FALSE. + + + ! Create the data file + nf90_status = NF90_CREATE( Filename,NF90_CLOBBER,FileId ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error creating '//TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + close_file = .TRUE. + + + ! Define the dimensions + ! ...Number of fields of view for the sensor + nf90_status = NF90_DEF_DIM( FileID,FOV_DIMNAME,n_FOVs,n_fovs_dimid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//FOV_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Total number of channels for the sensor + nf90_status = NF90_DEF_DIM( FileID,CHANNEL_DIMNAME,n_Channels,n_channels_dimid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//CHANNEL_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + + + ! Write the global attributes + err_stat = WriteGAtts( & + Filename, & + FileId , & + Version = Version , & + Sensor_Id = Sensor_Id , & + WMO_Satellite_Id = WMO_Satellite_Id, & + WMO_Sensor_Id = WMO_Sensor_Id , & + Title = Title , & + History = History , & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error writing global attribute to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + + + ! Define the variables + ! ...Sensor_Channel variable + nf90_status = NF90_DEF_VAR( FileID, & + SENSOR_CHANNEL_VARNAME, & + SENSOR_CHANNEL_TYPE, & + dimIDs=(/n_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//SENSOR_CHANNEL_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,SENSOR_CHANNEL_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,SENSOR_CHANNEL_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,SENSOR_CHANNEL_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,SENSOR_CHANNEL_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//SENSOR_CHANNEL_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...A_earth variable + nf90_status = NF90_DEF_VAR( FileID, & + A_EARTH_VARNAME, & + A_EARTH_TYPE, & + dimIDs=(/n_fovs_dimid,n_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//A_EARTH_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,A_EARTH_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,A_EARTH_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,A_EARTH_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,A_EARTH_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//A_EARTH_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...A_space variable + nf90_status = NF90_DEF_VAR( FileID, & + A_SPACE_VARNAME, & + A_SPACE_TYPE, & + dimIDs=(/n_fovs_dimid,n_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//A_SPACE_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,A_SPACE_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,A_SPACE_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,A_SPACE_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,A_SPACE_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//A_SPACE_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...A_platform variable + nf90_status = NF90_DEF_VAR( FileID, & + A_PLATFORM_VARNAME, & + A_PLATFORM_TYPE, & + dimIDs=(/n_fovs_dimid,n_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//A_PLATFORM_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,A_PLATFORM_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,A_PLATFORM_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,A_PLATFORM_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,A_PLATFORM_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//A_PLATFORM_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + + + ! Take netCDF file out of define mode + nf90_status = NF90_ENDDEF( FileId ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error taking file '//TRIM(Filename)// & + ' out of define mode - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + + CONTAINS + + SUBROUTINE Create_CleanUp() + IF ( close_file ) THEN + nf90_status = NF90_CLOSE( FileID ) + IF ( nf90_status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup - '//& + TRIM(NF90_STRERROR( nf90_status )) + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Create_CleanUp + + END FUNCTION CreateFile + +END MODULE ACCoeff_netCDF_IO diff --git a/libsrc/CMakeLists.txt b/libsrc/CMakeLists.txt index 85a7f21ff..e0b7c2441 100644 --- a/libsrc/CMakeLists.txt +++ b/libsrc/CMakeLists.txt @@ -1,4 +1,5 @@ list( APPEND crtm_src_files + ACCoeff_netCDF_IO.f90 ACCoeff_Binary_IO.f90 ACCoeff_Define.f90 ADA_Module.f90 @@ -122,6 +123,7 @@ list( APPEND crtm_src_files NESDIS_SSMI_SnowEM_Module.f90 NESDIS_SnowEM_ATMS_Parameters.f90 NESDIS_SnowEM_Parameters.f90 + NLTECoeff_netCDF_IO.f90 NLTECoeff_Binary_IO.f90 NLTECoeff_Define.f90 NLTE_Parameters.f90 @@ -149,6 +151,7 @@ list( APPEND crtm_src_files ODZeeman_TauCoeff.f90 PAFV_Define.f90 Profile_Utility_Parameters.f90 + RSS_Emissivity_Model.f90 RTV_Define.f90 Reflection_Correction_Module.f90 SEcategory_Define.f90 @@ -159,6 +162,8 @@ list( APPEND crtm_src_files Slope_Variance.f90 Small_Scale_Correction_Module.f90 Sort_Utility.f90 + SpcCoeff_IO.f90 + SpcCoeff_netCDF_IO.f90 SpcCoeff_Binary_IO.f90 SpcCoeff_Define.f90 Spectral_Units_Conversion.f90 diff --git a/libsrc/CRTM_MW_Water_SfcOptics.f90 b/libsrc/CRTM_MW_Water_SfcOptics.f90 index b56dab53a..b12022890 100644 --- a/libsrc/CRTM_MW_Water_SfcOptics.f90 +++ b/libsrc/CRTM_MW_Water_SfcOptics.f90 @@ -42,6 +42,7 @@ MODULE CRTM_MW_Water_SfcOptics Compute_FastemX_TL,& Compute_FastemX_AD USE CRTM_MWwaterCoeff , ONLY: MWwaterC + USE RSS_Emissivity_Model ! Disable implicit typing IMPLICIT NONE @@ -64,7 +65,9 @@ MODULE CRTM_MW_Water_SfcOptics ! ----------------- ! Low frequency model threshold REAL(fp), PARAMETER :: LOW_F_THRESHOLD = 20.0_fp ! GHz - + ! L BAND frequency model threshold + REAL(fp), PARAMETER :: L_BAND_FRQ = 2.0_fp ! GHz + REAL(fp), PARAMETER :: K2C = -273.13_fp ! -------------------------------------- ! Structure definition to hold forward @@ -200,7 +203,7 @@ FUNCTION Compute_MW_Water_SfcOptics( & REAL(fp) :: Frequency REAL(fp) :: Source_Azimuth_Angle, Sensor_Azimuth_Angle REAL(fp) :: Reflectivity(N_STOKES) - + COMPLEX(fp) , DIMENSION(2) :: Specular_Emissivity ! Set up err_stat = SUCCESS @@ -215,33 +218,53 @@ FUNCTION Compute_MW_Water_SfcOptics( & ! Compute the surface optical parameters IF( SfcOptics%Use_New_MWSSEM ) THEN - - ! FastemX model - SfcOptics%Azimuth_Angle = Surface%Wind_Direction - Sensor_Azimuth_Angle - DO i = 1, SfcOptics%n_Angles - CALL Compute_FastemX( & - MWwaterC , & ! Input model coefficients - Frequency , & ! Input - SfcOptics%n_Angles , & ! Input - SfcOptics%Angle(i) , & ! Input - Surface%Water_Temperature , & ! Input - Surface%Salinity , & ! Input - Surface%Wind_Speed , & ! Input - iVar%FastemX_Var(i) , & ! Internal variable output - SfcOptics%Emissivity(i,:) , & ! Output - Reflectivity , & ! Output - Azimuth_Angle = SfcOptics%Azimuth_Angle, & ! Optional input - Transmittance = SfcOptics%Transmittance ) ! Optional input - DO j = 1, N_STOKES - SfcOptics%Reflectivity(i,j,i,j) = Reflectivity(j) - END DO - END DO + + ! Low frequency model coupled with Fastem1 + IF( Frequency < L_BAND_FRQ ) THEN + ! Call the RSS model + DO i = 1, SfcOptics%n_Angles + CALL fdem0_meissner_wentz( & + Frequency , & ! Input + SfcOptics%Angle(i) , & ! Input + Surface%Water_Temperature + K2C , & ! Input + Surface%Salinity , & ! Input + Specular_Emissivity ) ! Output + + SfcOptics%Emissivity(i,1)= Specular_Emissivity(1) + SfcOptics%Emissivity(i,2)= Specular_Emissivity(2) + SfcOptics%Reflectivity(i,1,i,1) = ONE-SfcOptics%Emissivity(i,1) + SfcOptics%Reflectivity(i,2,i,2) = ONE-SfcOptics%Emissivity(i,2) + END DO + + ELSE + ! FastemX model + SfcOptics%Azimuth_Angle = Surface%Wind_Direction - Sensor_Azimuth_Angle + DO i = 1, SfcOptics%n_Angles + CALL Compute_FastemX( & + MWwaterC , & ! Input model coefficients + Frequency , & ! Input + SfcOptics%n_Angles , & ! Input + SfcOptics%Angle(i) , & ! Input + Surface%Water_Temperature , & ! Input + Surface%Salinity , & ! Input + Surface%Wind_Speed , & ! Input + iVar%FastemX_Var(i) , & ! Internal variable output + SfcOptics%Emissivity(i,:) , & ! Output + Reflectivity , & ! Output + Azimuth_Angle = SfcOptics%Azimuth_Angle, & ! Optional input + Transmittance = SfcOptics%Transmittance ) ! Optional input + DO j = 1, N_STOKES + SfcOptics%Reflectivity(i,j,i,j) = Reflectivity(j) + END DO + END DO + + END IF ELSE - ! Low frequency model coupled with Fastem1 + ! Low frequency model coupled with Fastem1 IF( Frequency < LOW_F_THRESHOLD ) THEN - ! Call the low frequency model + ! Call the low frequency model DO i = 1, SfcOptics%n_Angles CALL LowFrequency_MWSSEM( & Frequency , & ! Input @@ -250,12 +273,12 @@ FUNCTION Compute_MW_Water_SfcOptics( & Surface%Salinity , & ! Input Surface%Wind_Speed , & ! Input SfcOptics%Emissivity(i,:), & ! Output - iVar%LF_MWSSEM_Var(i) ) ! Internal variable output + iVar%LF_MWSSEM_Var(i) ) ! Internal variable output SfcOptics%Reflectivity(i,1,i,1) = ONE-SfcOptics%Emissivity(i,1) SfcOptics%Reflectivity(i,2,i,2) = ONE-SfcOptics%Emissivity(i,2) END DO ELSE - ! Call Fastem1 + ! Call Fastem1 DO i = 1, SfcOptics%n_Angles CALL Fastem1( Frequency , & ! Input SfcOptics%Angle(i) , & ! Input @@ -263,7 +286,7 @@ FUNCTION Compute_MW_Water_SfcOptics( & Surface%Wind_Speed , & ! Input SfcOptics%Emissivity(i,:), & ! Output iVar%dEH_dWindSpeed(i) , & ! Output - iVar%dEV_dWindSpeed(i) ) ! Output + iVar%dEV_dWindSpeed(i) ) ! Output SfcOptics%Reflectivity(i,1,i,1) = ONE-SfcOptics%Emissivity(i,1) SfcOptics%Reflectivity(i,2,i,2) = ONE-SfcOptics%Emissivity(i,2) END DO @@ -382,6 +405,7 @@ END FUNCTION Compute_MW_Water_SfcOptics FUNCTION Compute_MW_Water_SfcOptics_TL( & SfcOptics , & ! Input + Surface , & ! Input Surface_TL , & ! Input GeometryInfo, & ! Input SensorIndex , & ! Input @@ -390,6 +414,7 @@ FUNCTION Compute_MW_Water_SfcOptics_TL( & iVar ) & ! Internal variable input RESULT( err_stat ) ! Arguments + TYPE(CRTM_Surface_type), INTENT(IN) :: Surface TYPE(CRTM_Surface_type), INTENT(IN) :: Surface_TL TYPE(CRTM_SfcOptics_type), INTENT(IN) :: SfcOptics TYPE(CRTM_GeometryInfo_type), INTENT(IN) :: GeometryInfo @@ -406,7 +431,7 @@ FUNCTION Compute_MW_Water_SfcOptics_TL( & REAL(fp) :: Frequency REAL(fp) :: Source_Azimuth_Angle, Sensor_Azimuth_Angle REAL(fp) :: Reflectivity_TL(N_STOKES) - + COMPLEX(fp) , DIMENSION(2) :: Specular_Emissivity, Specular_Emissivity_TL ! Set up err_stat = SUCCESS @@ -421,9 +446,28 @@ FUNCTION Compute_MW_Water_SfcOptics_TL( & ! Compute the tangent-linear surface optical parameters IF( SfcOptics%Use_New_MWSSEM ) THEN + IF( Frequency < L_BAND_FRQ ) THEN + + ! Call the RSS model for L-band + DO i = 1, SfcOptics%n_Angles + CALL fdem0_meissner_wentz_TL( & + Frequency , & ! Input + SfcOptics%Angle(i) , & ! Input + Surface%Water_Temperature + K2C , & ! Input + Surface_TL%Water_Temperature , & ! Input + Surface%Salinity , & ! Input + Surface_TL%Salinity , & ! Input + Specular_Emissivity , & ! Input + Specular_Emissivity_TL ) ! Output + + SfcOptics_TL%Emissivity(i,:)= Specular_Emissivity_TL(:) + SfcOptics_TL%Reflectivity(i,1,i,1) = ONE-SfcOptics_TL%Emissivity(i,1) + SfcOptics_TL%Reflectivity(i,2,i,2) = ONE-SfcOptics_TL%Emissivity(i,2) + END DO + ELSE ! FastemX model - DO i = 1, SfcOptics%n_Angles + DO i = 1, SfcOptics%n_Angles CALL Compute_FastemX_TL( & MWwaterC , & ! Input model coefficients Surface_TL%Water_Temperature , & ! TL Input @@ -439,7 +483,8 @@ FUNCTION Compute_MW_Water_SfcOptics_TL( & !SfcOptics_TL%Reflectivity(i,j,i,j) = -Reflectivity_TL(j) SfcOptics_TL%Reflectivity(i,j,i,j) = Reflectivity_TL(j) END DO - END DO + END DO + END IF ELSE @@ -586,6 +631,7 @@ FUNCTION Compute_MW_Water_SfcOptics_AD( & GeometryInfo, & ! Input SensorIndex , & ! Input ChannelIndex, & ! Input + Surface , & ! Input Surface_AD , & ! Output iVar ) & ! Internal variable input RESULT( err_stat ) @@ -595,6 +641,7 @@ FUNCTION Compute_MW_Water_SfcOptics_AD( & TYPE(CRTM_GeometryInfo_type), INTENT(IN) :: GeometryInfo INTEGER, INTENT(IN) :: SensorIndex INTEGER, INTENT(IN) :: ChannelIndex + TYPE(CRTM_Surface_type), INTENT(IN) :: Surface TYPE(CRTM_Surface_type), INTENT(IN OUT) :: Surface_AD TYPE(iVar_type), INTENT(IN) :: iVar ! Function result @@ -607,7 +654,7 @@ FUNCTION Compute_MW_Water_SfcOptics_AD( & REAL(fp) :: Source_Azimuth_Angle, Sensor_Azimuth_Angle REAL(fp) :: Reflectivity_AD(N_STOKES) REAL(fp) :: Azimuth_Angle_AD - + REAL(fp) , DIMENSION(2) :: Specular_Emissivity ! Set up err_stat = SUCCESS @@ -621,7 +668,24 @@ FUNCTION Compute_MW_Water_SfcOptics_AD( & ! Compute the adjoint surface optical parameters IF( SfcOptics%Use_New_MWSSEM ) THEN - + ! Low frequency model coupled with Fastem1 + IF( Frequency < L_BAND_FRQ ) THEN + ! Call the RSS model for L-band + DO i = 1, SfcOptics%n_Angles + CALL fdem0_meissner_wentz_AD( & + Frequency , & ! Input + SfcOptics%Angle(i) , & ! Input + Surface%Water_Temperature + K2C , & ! Input + Surface_AD%Water_Temperature , & ! AD Output + Surface%Salinity ,& ! Input + Surface_AD%Salinity ,& ! AD Output + Specular_Emissivity , & ! Input + SfcOptics_AD%Emissivity(i,:) ) ! Input + + SfcOptics_AD%Reflectivity(i,1,i,1) = ONE-SfcOptics_AD%Emissivity(i,1) + SfcOptics_AD%Reflectivity(i,2,i,2) = ONE-SfcOptics_AD%Emissivity(i,2) + END DO + ELSE ! FastemX model Azimuth_Angle_AD = ZERO DO i = 1, SfcOptics%n_Angles @@ -640,6 +704,7 @@ FUNCTION Compute_MW_Water_SfcOptics_AD( & Transmittance_AD = SfcOptics_AD%Transmittance ) ! Optional AD Output END DO Surface_AD%Wind_Direction = Surface_AD%Wind_Direction + Azimuth_Angle_AD + END IF ELSE diff --git a/libsrc/CRTM_SfcOptics.f90 b/libsrc/CRTM_SfcOptics.f90 index 7452874f5..d74a867b9 100644 --- a/libsrc/CRTM_SfcOptics.f90 +++ b/libsrc/CRTM_SfcOptics.f90 @@ -1,4 +1,4 @@ -! + ! CRTM_SfcOptics ! ! Module to compute the surface optical properties required for @@ -11,6 +11,16 @@ ! Paul van Delst, CIMSS/SSEC; paul.vandelst@ssec.wisc.edu ! 02-Apr-2004 ! +! MODIFICATION HISTORY: +! ===================== +! +! Author: Date: Description: +! ======= ===== ============ +! Patrick Stegmann 2021-01-22 Added CONST_MIXED_POLARIZATION scheme. +! +! Patrick Stegmann 2021-08-31 Added PRA_POLARIZATION scheme for GEMS-1. +! +! Cheng Dang 2022-05-31 Added IRsnowCoeff TL and AD modules MODULE CRTM_SfcOptics @@ -39,7 +49,9 @@ MODULE CRTM_SfcOptics VL_MIXED_POLARIZATION, & HL_MIXED_POLARIZATION, & RC_POLARIZATION, & - LC_POLARIZATION + LC_POLARIZATION, & + CONST_MIXED_POLARIZATION, & + PRA_POLARIZATION USE CRTM_Surface_Define, ONLY: CRTM_Surface_type USE CRTM_GeometryInfo_Define, ONLY: CRTM_GeometryInfo_type USE CRTM_SfcOptics_Define, ONLY: CRTM_SfcOptics_type , & @@ -134,10 +146,10 @@ MODULE CRTM_SfcOptics TYPE(MWSSOVar_type) :: MWSSOV ! Snow TYPE(MWISOVar_type) :: MWISOV ! Ice ! Infrared - TYPE(IRLSOVar_type) :: IRLSOV ! Land - TYPE(IRWSOVar_type) :: IRWSOV ! Water - TYPE(IRSSOVar_type) :: IRSSOV ! Snow - TYPE(IRISOVar_type) :: IRISOV ! Ice + TYPE(IRLSOVar_type) :: IRLSOV ! Land + TYPE(IRWSOVar_type) :: IRWSOV ! Water + TYPE(IRSSOVar_type) :: IRSSOV ! Snow + TYPE(IRISOVar_type) :: IRISOV ! Ice ! Visible TYPE(VISLSOVar_type) :: VISLSOV ! Land TYPE(VISWSOVar_type) :: VISWSOV ! Water @@ -461,6 +473,10 @@ FUNCTION CRTM_Compute_SfcOptics( & INTEGER :: i INTEGER :: nL, nZ REAL(fp) :: SIN2_Angle + REAL(fp) :: pv + REAL(fp) :: ph + REAL(fp) :: phi + REAL(fp) :: theta_f REAL(fp), DIMENSION(SfcOptics%n_Angles,MAX_N_STOKES) :: Emissivity REAL(fp), DIMENSION(SfcOptics%n_Angles,MAX_N_STOKES, & SfcOptics%n_Angles,MAX_N_STOKES) :: Reflectivity @@ -715,6 +731,51 @@ FUNCTION CRTM_Compute_SfcOptics( & CASE ( LC_POLARIZATION ) SfcOptics%Emissivity(1:nZ,1) = Emissivity(1:nZ,1) SfcOptics%Reflectivity(1:nZ,1,1:nZ,1) = Reflectivity(1:nZ,1,1:nZ,1) + ! + ! Description: + ! ============ + ! Polarization mixing with constant offset angle for TROPICS + ! + ! Reference: + ! ========== + ! Leslie, V. (2020): TROPICS Polarization Description, 20 November 2020. + ! (Personal Communication) + ! + CASE ( CONST_MIXED_POLARIZATION ) + SIN2_Angle = (GeometryInfo%Distance_Ratio * & + SIN(DEGREES_TO_RADIANS*SC(SensorIndex)%PolAngle(ChannelIndex)))**2 + DO i = 1, nZ + SfcOptics%Emissivity(i,1) = (Emissivity(i,1)*(SIN2_Angle)) + & + (Emissivity(i,2)*(ONE-SIN2_Angle)) + SfcOptics%Reflectivity(i,1,i,1) = (Reflectivity(i,1,i,1)*SIN2_Angle) + & + (Reflectivity(i,2,i,2)*(ONE-SIN2_Angle)) + END DO + + ! + ! Description: + ! ============ + ! Polarization changing with a defined polarization rotation angle + ! as instrument zenith angle changes. Implemented for GEMS-1 SmallSat. + ! + CASE ( PRA_POLARIZATION ) + DO i = 1, nZ + ! Alias for the sensor scan angle: + phi = GeometryInfo%Sensor_Scan_Radian + ! Instrument offset angle: + theta_f = DEGREES_TO_RADIANS*SC(SensorIndex)%PolAngle(ChannelIndex) + ph = SIN(phi) * ( COS(phi) + SIN(theta_f)*(1.0_fp - COS(phi)) ) & + ! -------------------------------------------------------------- + / SQRT( SIN(phi)**2 + SIN(theta_f)**2*(1.0_fp - COS(phi)**2) ) + pv = - ( SIN(phi)**2 - SIN(theta_f)*(1.0_fp - COS(phi))*COS(phi) ) & + ! --------------------------------------------------------------- + / SQRT( SIN(phi)**2 + SIN(theta_f)**2*(1.0_fp - COS(phi)**2) ) + ! Sine square of Polarization Rotation Angle (PRA) + SIN2_Angle = SIN(ATAN( -pv/ph ))**2 + SfcOptics%Emissivity(i,1) = (Emissivity(i,1)*(SIN2_Angle)) + & + (Emissivity(i,2)*(ONE-SIN2_Angle)) + SfcOptics%Reflectivity(i,1,i,1) = (Reflectivity(i,1,i,1)*SIN2_Angle) + & + (Reflectivity(i,2,i,2)*(ONE-SIN2_Angle)) + END DO ! Serious problem if we got to this points CASE DEFAULT @@ -816,11 +877,11 @@ FUNCTION CRTM_Compute_SfcOptics( & ! Compute the surface optics Error_Status = Compute_IR_Snow_SfcOptics( & - Surface , & ! Input - SensorIndex , & ! Input - ChannelIndex, & ! Input - SfcOptics , & ! In/Output - iVar%IRSSOV ) ! Internal variable output + Surface , & ! Input + SensorIndex , & ! Input + ChannelIndex , & ! Input + SfcOptics , & ! In/Output + iVar%IRSSOV ) ! Internal variable output IF ( Error_Status /= SUCCESS ) THEN WRITE( Message,'("Error computing IR snow SfcOptics at ",& &"channel index ",i0)' ) ChannelIndex @@ -1193,6 +1254,10 @@ FUNCTION CRTM_Compute_SfcOptics_TL( & INTEGER :: nL, nZ INTEGER :: Polarization REAL(fp) :: SIN2_Angle + REAL(fp) :: pv + REAL(fp) :: ph + REAL(fp) :: phi + REAL(fp) :: theta_f REAL(fp), DIMENSION(SfcOptics%n_Angles,MAX_N_STOKES) :: Emissivity_TL REAL(fp), DIMENSION(SfcOptics%n_Angles,MAX_N_STOKES, & SfcOptics%n_Angles,MAX_N_STOKES) :: Reflectivity_TL @@ -1253,6 +1318,7 @@ FUNCTION CRTM_Compute_SfcOptics_TL( & ! Compute the surface optics Error_Status = Compute_MW_Water_SfcOptics_TL( & SfcOptics , & ! Input + Surface , & ! Input Surface_TL , & ! Input GeometryInfo, & ! Input SensorIndex , & ! Input @@ -1424,6 +1490,17 @@ FUNCTION CRTM_Compute_SfcOptics_TL( & (Reflectivity_TL(i,2,i,2)*(ONE-SIN2_Angle)) END DO + ! Polarization mixing with constant offset angle for TROPICS + CASE ( CONST_MIXED_POLARIZATION ) + SIN2_Angle = (GeometryInfo%Distance_Ratio * & + SIN(DEGREES_TO_RADIANS*SC(SensorIndex)%PolAngle(ChannelIndex)))**2 + DO i = 1, nZ + SfcOptics_TL%Emissivity(i,1) = (Emissivity_TL(i,1)*(SIN2_Angle)) + & + (Emissivity_TL(i,2)*(ONE-SIN2_Angle)) + SfcOptics_TL%Reflectivity(i,1,i,1) = (Reflectivity_TL(i,1,i,1)*SIN2_Angle) + & + (Reflectivity_TL(i,2,i,2)*(ONE-SIN2_Angle)) + END DO + ! Right circular polarisation CASE ( RC_POLARIZATION ) SfcOptics_TL%Emissivity(1:nZ,1) = Emissivity_TL(1:nZ,1) @@ -1434,6 +1511,32 @@ FUNCTION CRTM_Compute_SfcOptics_TL( & SfcOptics_TL%Emissivity(1:nZ,1) = Emissivity_TL(1:nZ,1) SfcOptics_TL%Reflectivity(1:nZ,1,1:nZ,1) = Reflectivity_TL(1:nZ,1,1:nZ,1) + ! + ! Description: + ! ============ + ! Polarization changing with a defined polarization rotation angle + ! as instrument zenith angle changes. Implemented for GEMS-1 SmallSat. + ! + CASE ( PRA_POLARIZATION ) + DO i = 1, nZ + ! Alias for the sensor scan angle: + phi = GeometryInfo%Sensor_Scan_Radian + ! Instrument offset angle: + theta_f = DEGREES_TO_RADIANS*SC(SensorIndex)%PolAngle(ChannelIndex) + ph = SIN(phi) * ( COS(phi) + SIN(theta_f)*(1.0_fp - COS(phi)) ) & + ! -------------------------------------------------------------- + / SQRT( SIN(phi)**2 + SIN(theta_f)**2*(1.0_fp - COS(phi)**2) ) + pv = - ( SIN(phi)**2 - SIN(theta_f)*(1.0_fp - COS(phi))*COS(phi) ) & + ! --------------------------------------------------------------- + / SQRT( SIN(phi)**2 + SIN(theta_f)**2*(1.0_fp - COS(phi)**2) ) + ! Sine square of Polarization Rotation Angle (PRA) + SIN2_Angle = SIN(ATAN( -pv/ph ))**2 + SfcOptics_TL%Emissivity(i,1) = (Emissivity_TL(i,1)*(SIN2_Angle)) + & + (Emissivity_TL(i,2)*(ONE-SIN2_Angle)) + SfcOptics_TL%Reflectivity(i,1,i,1) = (Reflectivity_TL(i,1,i,1)*SIN2_Angle) + & + (Reflectivity_TL(i,2,i,2)*(ONE-SIN2_Angle)) + END DO + ! Serious problem if we got to this point CASE DEFAULT Error_Status = FAILURE @@ -1770,6 +1873,8 @@ FUNCTION CRTM_Compute_SfcOptics_AD( & INTEGER :: nL, nZ INTEGER :: Polarization REAL(fp) :: SIN2_Angle + REAL(fp) :: theta_f + REAL(fp) :: phi, ph, pv REAL(fp), DIMENSION(SfcOptics%n_Angles,MAX_N_STOKES) :: Emissivity_AD REAL(fp), DIMENSION(SfcOptics%n_Angles,MAX_N_STOKES, & SfcOptics%n_Angles,MAX_N_STOKES) :: Reflectivity_AD @@ -1916,6 +2021,22 @@ FUNCTION CRTM_Compute_SfcOptics_AD( & SfcOptics_AD%Emissivity = ZERO SfcOptics_AD%Reflectivity = ZERO + ! Polarization mixing with constant offset angle for TROPICS + CASE ( CONST_MIXED_POLARIZATION ) + SIN2_Angle = (GeometryInfo%Distance_Ratio * & + SIN(DEGREES_TO_RADIANS*SC(SensorIndex)%PolAngle(ChannelIndex)))**2 + DO i = 1, nZ + ! PS: The adjoint is the transpose of the TL relationship: + ! eV_AD = e_AD * SIN^2(theta) + ! eH_AD = e_AD * COS^2(theta) + Emissivity_AD(i,1) = SfcOptics_AD%Emissivity(i,1)*SIN2_Angle + Emissivity_AD(i,2) = SfcOptics_AD%Emissivity(i,1)*(ONE-SIN2_Angle) + Reflectivity_AD(i,1,i,1) = SfcOptics_AD%Reflectivity(i,1,i,1)*SIN2_Angle + Reflectivity_AD(i,2,i,2) = SfcOptics_AD%Reflectivity(i,1,i,1)*(ONE-SIN2_Angle) + END DO + SfcOptics_AD%Emissivity = ZERO + SfcOptics_AD%Reflectivity = ZERO + ! Right circular polarisation CASE ( RC_POLARIZATION ) Emissivity_AD(1:nZ,1) = SfcOptics_AD%Emissivity(1:nZ,1) @@ -1930,6 +2051,37 @@ FUNCTION CRTM_Compute_SfcOptics_AD( & Reflectivity_AD(1:nZ,1,1:nZ,1) = SfcOptics_AD%Reflectivity(1:nZ,1,1:nZ,1) SfcOptics_AD%Reflectivity = ZERO + ! + ! Description: + ! ============ + ! Polarization changing with a defined polarization rotation angle + ! as instrument zenith angle changes. Implemented for GEMS-1 SmallSat. + ! + CASE ( PRA_POLARIZATION ) + DO i = 1, nZ + ! Alias for the sensor scan angle: + phi = GeometryInfo%Sensor_Scan_Radian + ! Instrument offset angle: + theta_f = DEGREES_TO_RADIANS*SC(SensorIndex)%PolAngle(ChannelIndex) + ph = SIN(phi) * ( COS(phi) + SIN(theta_f)*(1.0_fp - COS(phi)) ) & + ! -------------------------------------------------------------- + / SQRT( SIN(phi)**2 + SIN(theta_f)**2*(1.0_fp - COS(phi)**2) ) + pv = - ( SIN(phi)**2 - SIN(theta_f)*(1.0_fp - COS(phi))*COS(phi) ) & + ! --------------------------------------------------------------- + / SQRT( SIN(phi)**2 + SIN(theta_f)**2*(1.0_fp - COS(phi)**2) ) + ! Sine square of Polarization Rotation Angle (PRA) + SIN2_Angle = SIN(ATAN( -pv/ph ))**2 + ! PS: The adjoint is the transpose of the TL relationship: + ! eV_AD = e_AD * SIN^2(theta) + ! eH_AD = e_AD * COS^2(theta) + Emissivity_AD(i,1) = SfcOptics_AD%Emissivity(i,1)*SIN2_Angle + Emissivity_AD(i,2) = SfcOptics_AD%Emissivity(i,1)*(ONE-SIN2_Angle) + Reflectivity_AD(i,1,i,1) = SfcOptics_AD%Reflectivity(i,1,i,1)*SIN2_Angle + Reflectivity_AD(i,2,i,2) = SfcOptics_AD%Reflectivity(i,1,i,1)*(ONE-SIN2_Angle) + END DO + SfcOptics_AD%Emissivity = ZERO + SfcOptics_AD%Reflectivity = ZERO + ! Serious problem if we got to this point CASE DEFAULT Error_Status = FAILURE @@ -2032,6 +2184,7 @@ FUNCTION CRTM_Compute_SfcOptics_AD( & GeometryInfo, & ! Input SensorIndex , & ! Input ChannelIndex, & ! Input + Surface , & ! Input Surface_AD , & ! Output iVar%MWWSOV ) ! Internal variable input IF ( Error_Status /= SUCCESS ) THEN @@ -2083,12 +2236,12 @@ FUNCTION CRTM_Compute_SfcOptics_AD( & ELSE IF ( SpcCoeff_IsInfraredSensor( SC(SensorIndex) ) ) THEN Reflectivity_AD(1:nZ,1,1:nZ,1:nL) = SfcOptics_AD%Reflectivity(1:nZ,1,1:nZ,1:nL) - SfcOptics_AD%Reflectivity = ZERO + SfcOptics_AD%Reflectivity = ZERO Emissivity_AD(1:nZ,1:nL) = SfcOptics_AD%Emissivity(1:nZ,1:nL) SfcOptics_AD%Emissivity = ZERO Direct_Reflectivity_AD(1:nZ,1) = SfcOptics_AD%Direct_Reflectivity(1:nZ,1) SfcOptics_AD%Direct_Reflectivity(1:nZ,1) = ZERO - + ! ------------------------------------ ! Infrared ICE emissivity/reflectivity ! ------------------------------------ @@ -2105,7 +2258,7 @@ FUNCTION CRTM_Compute_SfcOptics_AD( & (Reflectivity_AD(1:nZ,1:nL,1:nZ,1:nL)*Surface%Ice_Coverage) SfcOptics_AD%Direct_Reflectivity(1:nZ,1:nL) = & SfcOptics_AD%Direct_Reflectivity(1:nZ,1:nL) + & - (Direct_Reflectivity_AD(1:nZ,1:nL)*Surface%Ice_Coverage) + (Direct_Reflectivity_AD(1:nZ,1:nL)*Surface%Ice_Coverage) ! Compute the surface optics adjoints Error_Status = Compute_IR_Ice_SfcOptics_AD( SfcOptics_AD ) IF ( Error_Status /= SUCCESS ) THEN @@ -2134,7 +2287,7 @@ FUNCTION CRTM_Compute_SfcOptics_AD( & (Reflectivity_AD(1:nZ,1:nL,1:nZ,1:nL)*Surface%Snow_Coverage) SfcOptics_AD%Direct_Reflectivity(1:nZ,1:nL) = & SfcOptics_AD%Direct_Reflectivity(1:nZ,1:nL) + & - (Direct_Reflectivity_AD(1:nZ,1:nL)*Surface%Snow_Coverage) + (Direct_Reflectivity_AD(1:nZ,1:nL)*Surface%Snow_Coverage) ! Compute the surface optics adjoints Error_Status = Compute_IR_Snow_SfcOptics_AD( SfcOptics_AD ) IF ( Error_Status /= SUCCESS ) THEN @@ -2163,7 +2316,7 @@ FUNCTION CRTM_Compute_SfcOptics_AD( & (Reflectivity_AD(1:nZ,1:nL,1:nZ,1:nL)*Surface%Water_Coverage) SfcOptics_AD%Direct_Reflectivity(1:nZ,1:nL) = & SfcOptics_AD%Direct_Reflectivity(1:nZ,1:nL) + & - (Direct_Reflectivity_AD(1:nZ,1:nL)*Surface%Water_Coverage) + (Direct_Reflectivity_AD(1:nZ,1:nL)*Surface%Water_Coverage) ! Compute the surface optics adjoints Error_Status = Compute_IR_Water_SfcOptics_AD( & Surface , & ! Input @@ -2200,7 +2353,7 @@ FUNCTION CRTM_Compute_SfcOptics_AD( & (Reflectivity_AD(1:nZ,1:nL,1:nZ,1:nL)*Surface%Land_Coverage) SfcOptics_AD%Direct_Reflectivity(1:nZ,1:nL) = & SfcOptics_AD%Direct_Reflectivity(1:nZ,1:nL) + & - (Direct_Reflectivity_AD(1:nZ,1:nL)*Surface%Land_Coverage) + (Direct_Reflectivity_AD(1:nZ,1:nL)*Surface%Land_Coverage) ! Compute the surface optics adjoints ! **STUB PROCEDURE** Error_Status = Compute_IR_Land_SfcOptics_AD( SfcOptics_AD ) diff --git a/libsrc/CRTM_SpcCoeff.f90 b/libsrc/CRTM_SpcCoeff.f90 index db21ee789..8d6dd5458 100644 --- a/libsrc/CRTM_SpcCoeff.f90 +++ b/libsrc/CRTM_SpcCoeff.f90 @@ -28,22 +28,24 @@ MODULE CRTM_SpcCoeff ! ---------------- ! Module use USE Message_Handler , ONLY: SUCCESS, FAILURE, WARNING, Display_Message - USE SensorInfo_Parameters, ONLY: N_POLARIZATION_TYPES , & - INVALID_POLARIZATION , & - UNPOLARIZED , & - INTENSITY , & - FIRST_STOKES_COMPONENT , & - SECOND_STOKES_COMPONENT, & - THIRD_STOKES_COMPONENT , & - FOURTH_STOKES_COMPONENT, & - VL_POLARIZATION , & - HL_POLARIZATION , & - plus45L_POLARIZATION , & - minus45L_POLARIZATION , & - VL_MIXED_POLARIZATION , & - HL_MIXED_POLARIZATION , & - RC_POLARIZATION , & - LC_POLARIZATION , & + USE SensorInfo_Parameters, ONLY: N_POLARIZATION_TYPES , & + INVALID_POLARIZATION , & + UNPOLARIZED , & + INTENSITY , & + FIRST_STOKES_COMPONENT , & + SECOND_STOKES_COMPONENT , & + THIRD_STOKES_COMPONENT , & + FOURTH_STOKES_COMPONENT , & + VL_POLARIZATION , & + HL_POLARIZATION , & + plus45L_POLARIZATION , & + minus45L_POLARIZATION , & + VL_MIXED_POLARIZATION , & + HL_MIXED_POLARIZATION , & + RC_POLARIZATION , & + LC_POLARIZATION , & + CONST_MIXED_POLARIZATION, & + PRA_POLARIZATION , & POLARIZATION_TYPE_NAME USE SpcCoeff_Define , ONLY: SpcCoeff_type , & SpcCoeff_Associated , & @@ -54,7 +56,7 @@ MODULE CRTM_SpcCoeff SpcCoeff_IsInfraredSensor , & SpcCoeff_IsVisibleSensor , & SpcCoeff_IsUltravioletSensor - USE SpcCoeff_Binary_IO , ONLY: SpcCoeff_Binary_ReadFile + USE SpcCoeff_IO , ONLY: SpcCoeff_ReadFile USE CRTM_Parameters , ONLY: CRTM_Set_Max_nChannels , & CRTM_Reset_Max_nChannels ! Disable all implicit typing @@ -95,7 +97,9 @@ MODULE CRTM_SpcCoeff PUBLIC :: VL_MIXED_POLARIZATION PUBLIC :: HL_MIXED_POLARIZATION PUBLIC :: RC_POLARIZATION - PUBLIC :: LC_POLARIZATION + PUBLIC :: LC_POLARIZATION + PUBLIC :: CONST_MIXED_POLARIZATION + PUBLIC :: PRA_POLARIZATION PUBLIC :: POLARIZATION_TYPE_NAME @@ -129,6 +133,7 @@ MODULE CRTM_SpcCoeff ! Error_Status = CRTM_Load_SpcCoeff( & ! Sensor_ID , & ! File_Path = File_Path , & +! netCDF = netCDF , & ! Quiet = Quiet , & ! Process_ID = Process_ID , & ! Output_Process_ID = Output_Process_ID ) @@ -154,6 +159,13 @@ MODULE CRTM_SpcCoeff ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! +! netCDF: Set this logical argument to read in the SpcCoeff +! coefficients from a netCDF format file. +! 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]. @@ -204,6 +216,7 @@ MODULE CRTM_SpcCoeff FUNCTION CRTM_SpcCoeff_Load( & Sensor_ID , & ! Input File_Path , & ! Optional input + netCDF , & ! Optional input Quiet , & ! Optional input Process_ID , & ! Optional input Output_Process_ID) & ! Optional input @@ -211,6 +224,7 @@ FUNCTION CRTM_SpcCoeff_Load( & ! Arguments CHARACTER(*), INTENT(IN) :: Sensor_ID(:) CHARACTER(*), OPTIONAL, INTENT(IN) :: File_Path + LOGICAL , OPTIONAL, INTENT(IN) :: netCDF LOGICAL , OPTIONAL, INTENT(IN) :: Quiet INTEGER , OPTIONAL, INTENT(IN) :: Process_ID INTEGER , OPTIONAL, INTENT(IN) :: Output_Process_ID @@ -261,11 +275,17 @@ FUNCTION CRTM_SpcCoeff_Load( & ! Read the SpcCoeff data files DO n = 1, n_Sensors - spccoeff_file = TRIM(path)//TRIM(ADJUSTL(Sensor_ID(n)))//'.SpcCoeff.bin' - err_stat = SpcCoeff_Binary_ReadFile( & + spccoeff_file = TRIM(ADJUSTL(path))//TRIM(ADJUSTL(Sensor_ID(n)))//'.SpcCoeff.bin' + IF( PRESENT(netCDF) ) THEN + IF( netCDF ) THEN + spccoeff_file = TRIM(ADJUSTL(path))//TRIM(ADJUSTL(Sensor_ID(n)))//'.SpcCoeff.nc' + END IF + END IF + err_stat = SpcCoeff_ReadFile( & spccoeff_file , & SC(n) , & - Quiet = .NOT. noisy ) + netCDF = netCDF , & + Quiet = .NOT. noisy ) IF ( err_stat /= SUCCESS ) THEN WRITE( msg,'("Error reading SpcCoeff file #",i0,", ",a)') n, TRIM(spccoeff_file) CALL Display_Message( ROUTINE_NAME, TRIM(msg)//TRIM(pid_msg), err_stat ); RETURN diff --git a/libsrc/CRTM_Version.inc b/libsrc/CRTM_Version.inc index 84b8ecdb8..3dc1d5526 100644 --- a/libsrc/CRTM_Version.inc +++ b/libsrc/CRTM_Version.inc @@ -1 +1 @@ -#define CRTM_VERSION 'v2.4.0-alpha' +#define CRTM_VERSION 'v2.4.0' diff --git a/libsrc/NLTECoeff_netCDF_IO.f90 b/libsrc/NLTECoeff_netCDF_IO.f90 new file mode 100644 index 000000000..86b755c65 --- /dev/null +++ b/libsrc/NLTECoeff_netCDF_IO.f90 @@ -0,0 +1,1850 @@ +! +! NLTECoeff_netCDF_IO +! +! Module containing routines to read and write NLTECoeff netCDF +! format files. +! +! +! CREATION HISTORY: +! Written by: Paul van Delst, 20-Jan-2011 +! paul.vandelst@noaa.gov +! + +MODULE NLTECoeff_netCDF_IO + + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module use + USE Type_Kinds , ONLY: Long, Double + USE Message_Handler , ONLY: SUCCESS, FAILURE, INFORMATION, Display_Message + USE File_Utility , ONLY: File_Exists + USE String_Utility , ONLY: StrClean + USE NLTECoeff_Define, ONLY: NLTECoeff_type , & + NLTECoeff_Associated , & + NLTECoeff_Destroy , & + NLTECoeff_Create , & + NLTECoeff_Inspect , & + NLTECoeff_ValidRelease, & + NLTECoeff_Info + USE netcdf + ! Disable implicit typing + IMPLICIT NONE + + + ! ------------ + ! Visibilities + ! ------------ + ! Everything private by default + PRIVATE + ! Procedures + PUBLIC :: NLTECoeff_netCDF_InquireFile + PUBLIC :: NLTECoeff_netCDF_ReadFile + PUBLIC :: NLTECoeff_netCDF_WriteFile + PUBLIC :: NLTECoeff_netCDF_IOVersion + + + ! ----------------- + ! Module parameters + ! ----------------- + ! Module version + CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = & + '$Id: NLTECoeff_netCDF_IO.f90 13518 2011-04-22 17:25:42Z paul.vandelst@noaa.gov $' + ! Default msg string length + INTEGER, PARAMETER :: ML = 1024 + ! Literal constants + REAL(Double), PARAMETER :: ZERO = 0.0_Double + + ! Global attribute names. + CHARACTER(*), PARAMETER :: RELEASE_GATTNAME = 'Release' + CHARACTER(*), PARAMETER :: VERSION_GATTNAME = 'Version' + CHARACTER(*), PARAMETER :: TITLE_GATTNAME = 'Title' + CHARACTER(*), PARAMETER :: HISTORY_GATTNAME = 'History' + CHARACTER(*), PARAMETER :: COMMENT_GATTNAME = 'Comment' + CHARACTER(*), PARAMETER :: SENSOR_ID_GATTNAME = 'Sensor_Id' + CHARACTER(*), PARAMETER :: WMO_SATELLITE_ID_GATTNAME = 'WMO_Satellite_Id' + CHARACTER(*), PARAMETER :: WMO_SENSOR_ID_GATTNAME = 'WMO_Sensor_Id' + + ! Dimension names + CHARACTER(*), PARAMETER :: PREDICTOR_DIMNAME = 'n_Predictors' + CHARACTER(*), PARAMETER :: SENSOR_ANGLE_DIMNAME = 'n_Sensor_Angles' + CHARACTER(*), PARAMETER :: SOLAR_ANGLE_DIMNAME = 'n_Solar_Angles' + CHARACTER(*), PARAMETER :: NLTE_CHANNEL_DIMNAME = 'n_NLTE_Channels' + CHARACTER(*), PARAMETER :: CHANNEL_DIMNAME = 'n_Channels' + CHARACTER(*), PARAMETER :: LAYER_DIMNAME = 'n_Layers' + + ! Variable names + CHARACTER(*), PARAMETER :: SENSOR_CHANNEL_VARNAME = 'Sensor_Channel' + CHARACTER(*), PARAMETER :: UPPER_PLEVEL_VARNAME = 'Upper_Plevel' + CHARACTER(*), PARAMETER :: LOWER_PLEVEL_VARNAME = 'Lower_Plevel' + CHARACTER(*), PARAMETER :: MIN_TM_VARNAME = 'Min_Tm' + CHARACTER(*), PARAMETER :: MAX_TM_VARNAME = 'Max_Tm' + CHARACTER(*), PARAMETER :: MEAN_TM_VARNAME = 'Mean_Tm' + CHARACTER(*), PARAMETER :: SENSOR_ANGLE_VARNAME = 'Secant_Sensor_Zenith' + CHARACTER(*), PARAMETER :: SOLAR_ANGLE_VARNAME = 'Secant_Solar_Zenith' + CHARACTER(*), PARAMETER :: NLTE_CHANNEL_VARNAME = 'NLTE_Channel' + CHARACTER(*), PARAMETER :: C_INDEX_VARNAME = 'C_Index' + CHARACTER(*), PARAMETER :: C_VARNAME = 'C' + + ! Variable long name attribute. + CHARACTER(*), PARAMETER :: LONGNAME_ATTNAME = 'long_name' + + CHARACTER(*), PARAMETER :: SENSOR_CHANNEL_LONGNAME = 'Sensor Channel' + CHARACTER(*), PARAMETER :: UPPER_PLEVEL_LONGNAME = 'Upper Pressure Levels' + CHARACTER(*), PARAMETER :: LOWER_PLEVEL_LONGNAME = 'Lower Pressure Levels' + CHARACTER(*), PARAMETER :: MIN_TM_LONGNAME = 'Minimum Layer Temperature' + CHARACTER(*), PARAMETER :: MAX_TM_LONGNAME = 'Maximum Layer Temperature' + CHARACTER(*), PARAMETER :: MEAN_TM_LONGNAME = 'Mean Layer Temperature' + CHARACTER(*), PARAMETER :: SENSOR_ANGLE_LONGNAME = 'Secant Sensor Zenith Angle' + CHARACTER(*), PARAMETER :: SOLAR_ANGLE_LONGNAME = 'Secant Solar Zenith Angle' + CHARACTER(*), PARAMETER :: NLTE_CHANNEL_LONGNAME = 'NLTE Channel' + CHARACTER(*), PARAMETER :: C_INDEX_LONGNAME = 'NLTE Channel Index' + CHARACTER(*), PARAMETER :: C_LONGNAME = 'NLTE Correction Coefficients' + + ! Variable description attribute. + CHARACTER(*), PARAMETER :: DESCRIPTION_ATTNAME = 'description' + + CHARACTER(*), PARAMETER :: SENSOR_CHANNEL_DESCRIPTION = 'List of sensor channel numbers' + CHARACTER(*), PARAMETER :: UPPER_PLEVEL_DESCRIPTION = 'Upper pressure levels used for computing mean layer temperatures' + CHARACTER(*), PARAMETER :: LOWER_PLEVEL_DESCRIPTION = 'Lower pressure levels used for computing mean layer temperatures' + CHARACTER(*), PARAMETER :: MIN_TM_DESCRIPTION = 'Minimum layer temperatures used as the temperature predictor limits' + CHARACTER(*), PARAMETER :: MAX_TM_DESCRIPTION = 'Maximum layer temperatures used as the temperature predictor limits' + CHARACTER(*), PARAMETER :: MEAN_TM_DESCRIPTION = 'Mean layer temperatures used as the temperature predictor limits' + CHARACTER(*), PARAMETER :: SENSOR_ANGLE_DESCRIPTION = 'Secant of the Sensor Zenith Angle' + CHARACTER(*), PARAMETER :: SOLAR_ANGLE_DESCRIPTION = 'Secant of the Solar Zenith Angle' + CHARACTER(*), PARAMETER :: NLTE_CHANNEL_DESCRIPTION = 'List of NLTE-affected channel numbers' + CHARACTER(*), PARAMETER :: C_INDEX_DESCRIPTION = 'Coefficient array index of NLTE-affected channel' + CHARACTER(*), PARAMETER :: C_DESCRIPTION = 'Coefficients used in the NLTE radianec correction algorithm' + + + ! Variable units attribute. + CHARACTER(*), PARAMETER :: UNITS_ATTNAME = 'units' + + CHARACTER(*), PARAMETER :: SENSOR_CHANNEL_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: UPPER_PLEVEL_UNITS = 'hectoPascals (hPa)' + CHARACTER(*), PARAMETER :: LOWER_PLEVEL_UNITS = 'hectoPascals (hPa)' + CHARACTER(*), PARAMETER :: MIN_TM_UNITS = 'Kelvin (K)' + CHARACTER(*), PARAMETER :: MAX_TM_UNITS = 'Kelvin (K)' + CHARACTER(*), PARAMETER :: MEAN_TM_UNITS = 'Kelvin (K)' + CHARACTER(*), PARAMETER :: SENSOR_ANGLE_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: SOLAR_ANGLE_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: NLTE_CHANNEL_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: C_INDEX_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: C_UNITS = 'N/A' + + + ! Variable _FillValue attribute. + CHARACTER(*), PARAMETER :: FILLVALUE_ATTNAME = '_FillValue' + + INTEGER(Long), PARAMETER :: SENSOR_CHANNEL_FILLVALUE = 0_Long + REAL(Double) , PARAMETER :: UPPER_PLEVEL_FILLVALUE = 0.0_Double + REAL(Double) , PARAMETER :: LOWER_PLEVEL_FILLVALUE = 0.0_Double + REAL(Double) , PARAMETER :: MIN_TM_FILLVALUE = 0.0_Double + REAL(Double) , PARAMETER :: MAX_TM_FILLVALUE = 0.0_Double + REAL(Double) , PARAMETER :: MEAN_TM_FILLVALUE = 0.0_Double + REAL(Double) , PARAMETER :: SENSOR_ANGLE_FILLVALUE = 0.0_Double + REAL(Double) , PARAMETER :: SOLAR_ANGLE_FILLVALUE = 0.0_Double + INTEGER(Long), PARAMETER :: NLTE_CHANNEL_FILLVALUE = 0_Long + INTEGER(Long), PARAMETER :: C_INDEX_FILLVALUE = 0_Long + REAL(Double) , PARAMETER :: C_FILLVALUE = 0.0_Double + + + ! Variable types + INTEGER, PARAMETER :: SENSOR_CHANNEL_TYPE = NF90_INT + INTEGER, PARAMETER :: UPPER_PLEVEL_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: LOWER_PLEVEL_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: MIN_TM_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: MAX_TM_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: MEAN_TM_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: SENSOR_ANGLE_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: SOLAR_ANGLE_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: NLTE_CHANNEL_TYPE = NF90_INT + INTEGER, PARAMETER :: C_INDEX_TYPE = NF90_INT + INTEGER, PARAMETER :: C_TYPE = NF90_DOUBLE + + +CONTAINS + + +!################################################################################ +!################################################################################ +!## ## +!## ## PUBLIC MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! NLTECoeff_netCDF_InquireFile +! +! PURPOSE: +! Function to inquire NLTECoeff object netCDF format files. +! +! CALLING SEQUENCE: +! Error_Status = NLTECoeff_netCDF_InquireFile( & +! Filename, & +! n_Predictors = n_Predictors , & +! n_Sensor_Angles = n_Sensor_Angles , & +! n_Solar_Angles = n_Solar_Angles , & +! n_NLTE_Channels = n_NLTE_Channels , & +! n_Channels = n_Channels , & +! Release = Release , & +! Version = Version , & +! Sensor_Id = Sensor_Id , & +! WMO_Satellite_Id = WMO_Satellite_Id, & +! WMO_Sensor_Id = WMO_Sensor_Id , & +! Title = Title , & +! History = History , & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of the +! NLTECoeff data file to inquire. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL OUTPUTS: +! n_Predictors: The number of predictor functions used in generating +! the NLTE correction coefficients. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! n_Sensor_Angles: Number of sensor zenith angles. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! n_Solar_Angles: Number of solar zenith angles. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! n_NLTE_Channels: Number of NLTE channels for the sensor. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! n_Channels: Total number of sensor channels. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Release: The release number of the NLTECoeff file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Version: The version number of the NLTECoeff file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Sensor_Id: Character string sensor/platform identifier. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! WMO_Satellite_Id: The WMO code used to identify satellite platforms. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! WMO_Sensor_Id: The WMO code used to identify sensors. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Title: Character string written into the TITLE global +! attribute field of the NLTECoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the NLTECoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the NLTECoeff file. +! 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 inquiry was successful +! == FAILURE an error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION NLTECoeff_netCDF_InquireFile( & + Filename , & ! Input + n_Predictors , & ! Optional output + n_Sensor_Angles , & ! Optional output + n_Solar_Angles , & ! Optional output + n_NLTE_Channels , & ! Optional output + n_Channels , & ! Optional output + Release , & ! Optional Output + Version , & ! Optional Output + Sensor_Id , & ! Optional Output + WMO_Satellite_Id, & ! Optional Output + WMO_Sensor_Id , & ! Optional Output + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , OPTIONAL, INTENT(OUT) :: n_Predictors + INTEGER , OPTIONAL, INTENT(OUT) :: n_Sensor_Angles + INTEGER , OPTIONAL, INTENT(OUT) :: n_Solar_Angles + INTEGER , OPTIONAL, INTENT(OUT) :: n_NLTE_Channels + INTEGER , OPTIONAL, INTENT(OUT) :: n_Channels + INTEGER , OPTIONAL, INTENT(OUT) :: Release + INTEGER , OPTIONAL, INTENT(OUT) :: Version + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Sensor_Id + INTEGER , OPTIONAL, INTENT(OUT) :: WMO_Satellite_Id + INTEGER , OPTIONAL, INTENT(OUT) :: WMO_Sensor_Id + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'NLTECoeff_InquireFile(netCDF)' + ! Function variables + CHARACTER(ML) :: msg + LOGICAL :: close_file + INTEGER :: nf90_status + INTEGER :: fileid + INTEGER :: dimid + TYPE(NLTECoeff_type) :: nltecoeff + + ! Set up + err_stat = SUCCESS + close_file = .FALSE. + + + ! Open the file + nf90_status = NF90_OPEN( Filename,NF90_NOWRITE,fileid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error opening '//TRIM(Filename)//' for read access - '// & + TRIM(NF90_STRERROR( nf90_status )) + CALL Inquire_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + close_file = .TRUE. + + + ! Get the dimensions + ! ...n_Predictors dimension + nf90_status = NF90_INQ_DIMID( FileId,PREDICTOR_DIMNAME,DimId ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//PREDICTOR_DIMNAME//' - '// & + TRIM(NF90_STRERROR( nf90_status )) + CALL Inquire_Cleanup(); RETURN + END IF + nf90_status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=nltecoeff%n_Predictors ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//PREDICTOR_DIMNAME//' - '// & + TRIM(NF90_STRERROR( nf90_status )) + CALL Inquire_Cleanup(); RETURN + END IF + ! ...n_Sensor_Angles dimension + nf90_status = NF90_INQ_DIMID( FileId,SENSOR_ANGLE_DIMNAME,DimId ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//SENSOR_ANGLE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( nf90_status )) + CALL Inquire_Cleanup(); RETURN + END IF + nf90_status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=nltecoeff%n_Sensor_Angles ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//SENSOR_ANGLE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( nf90_status )) + CALL Inquire_Cleanup(); RETURN + END IF + ! ...n_Solar_Angles dimension + nf90_status = NF90_INQ_DIMID( FileId,SOLAR_ANGLE_DIMNAME,DimId ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//SOLAR_ANGLE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( nf90_status )) + CALL Inquire_Cleanup(); RETURN + END IF + nf90_status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=nltecoeff%n_Solar_Angles ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//SOLAR_ANGLE_DIMNAME//' - '// & + TRIM(NF90_STRERROR( nf90_status )) + CALL Inquire_Cleanup(); RETURN + END IF + ! ...n_NLTE_Channels dimension + nf90_status = NF90_INQ_DIMID( FileId,NLTE_CHANNEL_DIMNAME,DimId ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//NLTE_CHANNEL_DIMNAME//' - '// & + TRIM(NF90_STRERROR( nf90_status )) + CALL Inquire_Cleanup(); RETURN + END IF + nf90_status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=nltecoeff%n_NLTE_Channels ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//NLTE_CHANNEL_DIMNAME//' - '// & + TRIM(NF90_STRERROR( nf90_status )) + CALL Inquire_Cleanup(); RETURN + END IF + ! ...n_Channels dimension + nf90_status = NF90_INQ_DIMID( FileId,CHANNEL_DIMNAME,DimId ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//CHANNEL_DIMNAME//' - '// & + TRIM(NF90_STRERROR( nf90_status )) + CALL Inquire_Cleanup(); RETURN + END IF + nf90_status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=nltecoeff%n_Channels ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//CHANNEL_DIMNAME//' - '// & + TRIM(NF90_STRERROR( nf90_status )) + CALL Inquire_Cleanup(); RETURN + END IF + + + ! Get the global attributes + err_stat = ReadGAtts( Filename, & + fileid , & + Release = Release , & + Version = Version , & + Sensor_Id = Sensor_Id , & + WMO_Satellite_Id = WMO_Satellite_Id, & + WMO_Sensor_Id = WMO_Sensor_Id , & + Title = Title , & + History = History , & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading global attributes from '//TRIM(Filename) + CALL Inquire_Cleanup(); RETURN + END IF + + + ! Close the file + nf90_status = NF90_CLOSE( fileid ) + close_file = .FALSE. + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error closing input file - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Inquire_Cleanup(); RETURN + END IF + + + ! Set the return values + IF ( PRESENT(n_Predictors ) ) n_Predictors = nltecoeff%n_Predictors + IF ( PRESENT(n_Sensor_Angles ) ) n_Sensor_Angles = nltecoeff%n_Sensor_Angles + IF ( PRESENT(n_Solar_Angles ) ) n_Solar_Angles = nltecoeff%n_Solar_Angles + IF ( PRESENT(n_NLTE_Channels ) ) n_NLTE_Channels = nltecoeff%n_NLTE_Channels + IF ( PRESENT(n_Channels ) ) n_Channels = nltecoeff%n_Channels + + CONTAINS + + SUBROUTINE Inquire_CleanUp() + IF ( close_file ) THEN + nf90_status = NF90_CLOSE( fileid ) + IF ( nf90_status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup.' + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Inquire_CleanUp + + END FUNCTION NLTECoeff_netCDF_InquireFile + + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! NLTECoeff_netCDF_WriteFile +! +! PURPOSE: +! Function to write NLTECoeff object files in netCDF format. +! +! CALLING SEQUENCE: +! Error_Status = NLTECoeff_netCDF_WriteFile( & +! Filename , & +! NLTECoeff , & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of the +! NLTECoeff data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! NLTECoeff: NLTECoeff object containing the NLTE correction +! coefficient data. +! UNITS: N/A +! TYPE: NLTECoeff_type +! DIMENSION: Scalar +! 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 +! +! Title: Character string written into the TITLE global +! attribute field of the NLTECoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the NLTECoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the NLTECoeff file. +! 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 data write was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION NLTECoeff_netCDF_WriteFile( & + Filename , & ! Input + NLTECoeff, & ! Input + Quiet , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + TYPE(NLTECoeff_type), INTENT(IN) :: NLTECoeff + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'NLTECoeff_WriteFile(netCDF)' + ! Local variables + CHARACTER(ML) :: msg + LOGICAL :: close_file + LOGICAL :: noisy + INTEGER :: nf90_status + INTEGER :: fileid + INTEGER :: varid + + ! Set up + err_stat = SUCCESS + close_file = .FALSE. + ! ...Check structure pointer association status + IF ( .NOT. NLTECoeff_Associated( NLTECoeff ) ) THEN + msg = 'NLTECoeff structure is empty. Nothing to do!' + CALL Write_CleanUp(); RETURN + END IF + ! ...Check if release is valid + IF ( .NOT. NLTECoeff_ValidRelease( NLTECoeff ) ) THEN + msg = 'NLTECoeff Release check failed.' + CALL Write_Cleanup(); RETURN + END IF + ! ...Check Quiet argument + noisy = .TRUE. + IF ( PRESENT(Quiet) ) noisy = .NOT. Quiet + + + ! Create the output file + err_stat = CreateFile( & + Filename , & ! Input + NLTECoeff%n_Predictors , & ! Input + NLTECoeff%n_Sensor_Angles , & ! Input + NLTECoeff%n_Solar_Angles , & ! Input + NLTECoeff%n_NLTE_Channels , & ! Input + NLTECoeff%n_Channels , & ! Input + NLTECoeff%n_Layers , & ! Input + fileid , & ! Output + Version = NLTECoeff%Version , & ! Optional input + Sensor_Id = NLTECoeff%Sensor_Id , & ! Optional input + WMO_Satellite_Id = NLTECoeff%WMO_Satellite_Id, & ! Optional input + WMO_Sensor_Id = NLTECoeff%WMO_Sensor_Id , & ! Optional input + Title = Title , & ! Optional input + History = History , & ! Optional input + Comment = Comment ) ! Optional input + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error creating output file '//TRIM(Filename) + CALL Write_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + close_file = .TRUE. + + + ! Write the data items + ! ...Sensor_Channel variable + nf90_status = NF90_INQ_varid( fileid,SENSOR_CHANNEL_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//SENSOR_CHANNEL_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + nf90_status = NF90_PUT_VAR( fileid,varid,NLTECoeff%Sensor_Channel ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error writing '//SENSOR_CHANNEL_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Upper_Plevel variable + nf90_status = NF90_INQ_varid( fileid,UPPER_PLEVEL_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//UPPER_PLEVEL_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + nf90_status = NF90_PUT_VAR( fileid,varid,NLTECoeff%Upper_Plevel ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error writing '//UPPER_PLEVEL_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Lower_Plevel variable + nf90_status = NF90_INQ_varid( fileid,LOWER_PLEVEL_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//LOWER_PLEVEL_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + nf90_status = NF90_PUT_VAR( fileid,varid,NLTECoeff%Lower_Plevel ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error writing '//LOWER_PLEVEL_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Min_Tm variable + nf90_status = NF90_INQ_varid( fileid,MIN_TM_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//MIN_TM_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + nf90_status = NF90_PUT_VAR( fileid,varid,NLTECoeff%Min_Tm ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error writing '//MIN_TM_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Max_Tm variable + nf90_status = NF90_INQ_varid( fileid,MAX_TM_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//MAX_TM_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + nf90_status = NF90_PUT_VAR( fileid,varid,NLTECoeff%Max_Tm ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error writing '//MAX_TM_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Mean_Tm variable + nf90_status = NF90_INQ_varid( fileid,MEAN_TM_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//MEAN_TM_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + nf90_status = NF90_PUT_VAR( fileid,varid,NLTECoeff%Mean_Tm ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error writing '//MEAN_TM_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Secant_Sensor_Zenith variable + nf90_status = NF90_INQ_varid( fileid,SENSOR_ANGLE_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//SENSOR_ANGLE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + nf90_status = NF90_PUT_VAR( fileid,varid,NLTECoeff%Secant_Sensor_Zenith ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error writing '//SENSOR_ANGLE_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Secant_Solar_Zenith variable + nf90_status = NF90_INQ_varid( fileid,SOLAR_ANGLE_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//SOLAR_ANGLE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + nf90_status = NF90_PUT_VAR( fileid,varid,NLTECoeff%Secant_Solar_Zenith ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error writing '//SOLAR_ANGLE_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...NLTE_Channel variable + nf90_status = NF90_INQ_varid( fileid,NLTE_CHANNEL_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//NLTE_CHANNEL_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + nf90_status = NF90_PUT_VAR( fileid,varid,NLTECoeff%NLTE_Channel ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error writing '//NLTE_CHANNEL_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...C_Index variable + nf90_status = NF90_INQ_varid( fileid,C_INDEX_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//C_INDEX_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + nf90_status = NF90_PUT_VAR( fileid,varid,NLTECoeff%C_Index ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error writing '//C_INDEX_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...C variable + nf90_status = NF90_INQ_varid( fileid,C_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//C_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + nf90_status = NF90_PUT_VAR( fileid,varid,NLTECoeff%C ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error writing '//C_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + + + ! Close the file + nf90_status = NF90_CLOSE( fileid ) + close_file = .FALSE. + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error closing output file - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + + + ! Output an info message + IF ( noisy ) THEN + CALL NLTECoeff_Info( NLTECoeff, msg ) + CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION ) + END IF + + CONTAINS + + SUBROUTINE Write_CleanUp() + IF ( close_file ) THEN + nf90_status = NF90_CLOSE( fileid ) + IF ( nf90_status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing output file during error cleanup - '//& + TRIM(NF90_STRERROR( nf90_status )) + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Write_CleanUp + + END FUNCTION NLTECoeff_netCDF_WriteFile + + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! NLTECoeff_netCDF_ReadFile +! +! PURPOSE: +! Function to read NLTECoeff object files in netCDF format. +! +! CALLING SEQUENCE: +! Error_Status = NLTECoeff_netCDF_ReadFile( & +! Filename , & +! NLTECoeff , & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of the +! NLTECoeff data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUTS: +! NLTECoeff: NLTECoeff object containing the NLTE correction +! coefficient data. +! UNITS: N/A +! TYPE: NLTECoeff_type +! DIMENSION: Scalar +! 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: +! Title: Character string written into the TITLE global +! attribute field of the NLTECoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the NLTECoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the NLTECoeff file. +! 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 data write was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION NLTECoeff_netCDF_ReadFile( & + Filename , & ! Input + NLTECoeff, & ! Output + Quiet , & ! Optional input + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + TYPE(NLTECoeff_type), INTENT(OUT) :: NLTECoeff + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'NLTECoeff_ReadFile(netCDF)' + ! Function variables + CHARACTER(ML) :: msg + LOGICAL :: close_file + LOGICAL :: noisy + INTEGER :: nf90_status + INTEGER :: fileid + INTEGER :: n_predictors + INTEGER :: n_sensor_angles + INTEGER :: n_solar_angles + INTEGER :: n_nlte_channels + INTEGER :: n_channels + INTEGER :: varid + + + ! Set up + err_stat = SUCCESS + close_file = .FALSE. + ! ...Check that the file exists + IF ( .NOT. File_Exists(Filename) ) THEN + msg = 'File '//TRIM(Filename)//' not found.' + CALL Read_Cleanup(); RETURN + END IF + ! ...Check Quiet argument + noisy = .TRUE. + IF ( PRESENT(Quiet) ) noisy = .NOT. Quiet + + + ! Inquire the file to get the dimensions + err_stat = NLTECoeff_netCDF_InquireFile( & + Filename, & + n_Predictors = n_predictors , & + n_Sensor_Angles = n_sensor_angles, & + n_Solar_Angles = n_solar_angles , & + n_NLTE_Channels = n_nlte_channels, & + n_Channels = n_channels ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error obtaining NLTECoeff dimensions from '//TRIM(Filename) + CALL Read_Cleanup(); RETURN + END IF + + + ! Allocate the output structure + CALL NLTECoeff_Create( & + NLTECoeff, & + n_predictors , & + n_sensor_angles, & + n_solar_angles , & + n_nlte_channels, & + n_channels ) + IF ( .NOT. NLTECoeff_Associated(NLTECoeff) ) THEN + msg = 'Error allocating output NLTECoeff' + CALL Read_Cleanup(); RETURN + END IF + + + ! Open the file for reading + nf90_status = NF90_OPEN( Filename,NF90_NOWRITE,fileid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error opening '//TRIM(Filename)//' for read access - '//& + TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + close_file = .TRUE. + + + ! Read the global attributes + err_stat = ReadGAtts( & + Filename, & + fileid , & + Release = NLTECoeff%Release , & + Version = NLTECoeff%Version , & + Sensor_Id = NLTECoeff%Sensor_Id , & + WMO_Satellite_Id = NLTECoeff%WMO_Satellite_Id, & + WMO_Sensor_Id = NLTECoeff%WMO_Sensor_Id , & + Title = Title , & + History = History , & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading global attribute from '//TRIM(Filename) + CALL Read_Cleanup(); RETURN + END IF + ! ...Check if release is valid + IF ( .NOT. NLTECoeff_ValidRelease( NLTECoeff ) ) THEN + msg = 'NLTECoeff Release check failed.' + CALL Read_Cleanup(); RETURN + END IF + + + ! Read the NLTECoeff data + ! ...Sensor_Channel variable + nf90_status = NF90_INQ_varid( fileid,SENSOR_CHANNEL_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//SENSOR_CHANNEL_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,NLTECoeff%Sensor_Channel ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//SENSOR_CHANNEL_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Upper_Plevel variable + nf90_status = NF90_INQ_varid( fileid,UPPER_PLEVEL_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//UPPER_PLEVEL_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,NLTECoeff%Upper_Plevel ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//UPPER_PLEVEL_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Lower_Plevel variable + nf90_status = NF90_INQ_varid( fileid,LOWER_PLEVEL_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//LOWER_PLEVEL_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,NLTECoeff%Lower_Plevel ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//LOWER_PLEVEL_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Min_Tm variable + nf90_status = NF90_INQ_varid( fileid,MIN_TM_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//MIN_TM_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,NLTECoeff%Min_Tm ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//MIN_TM_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Max_Tm variable + nf90_status = NF90_INQ_varid( fileid,MAX_TM_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//MAX_TM_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,NLTECoeff%Max_Tm ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//MAX_TM_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Mean_Tm variable + nf90_status = NF90_INQ_varid( fileid,MEAN_TM_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//MEAN_TM_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,NLTECoeff%Mean_Tm ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//MEAN_TM_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Secant_Sensor_Zenith variable + nf90_status = NF90_INQ_varid( fileid,SENSOR_ANGLE_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//SENSOR_ANGLE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,NLTECoeff%Secant_Sensor_Zenith ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//SENSOR_ANGLE_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Secant_Solar_Zenith variable + nf90_status = NF90_INQ_varid( fileid,SOLAR_ANGLE_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//SOLAR_ANGLE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,NLTECoeff%Secant_Solar_Zenith ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//SOLAR_ANGLE_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...NLTE_Channel variable + nf90_status = NF90_INQ_varid( fileid,NLTE_CHANNEL_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//NLTE_CHANNEL_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,NLTECoeff%NLTE_Channel ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//NLTE_CHANNEL_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...C_Index variable + nf90_status = NF90_INQ_varid( fileid,C_INDEX_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//C_INDEX_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,NLTECoeff%C_Index ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//C_INDEX_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...C variable + nf90_status = NF90_INQ_varid( fileid,C_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//C_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,NLTECoeff%C ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//C_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + + + ! Set the logical flag based on the C_Index values + WHERE( NLTECoeff%C_Index > 0 ) NLTECoeff%Is_NLTE_Channel = .TRUE. + + + ! Close the file + nf90_status = NF90_CLOSE( fileid ); CLOSE_FILE = .FALSE. + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error closing output file - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + + + ! Output an info message + IF ( noisy ) THEN + CALL NLTECoeff_Info( NLTECoeff, msg ) + CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION ) + END IF + + CONTAINS + + SUBROUTINE Read_CleanUp() + IF ( close_file ) THEN + nf90_status = NF90_CLOSE( fileid ) + IF ( nf90_status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup- '//& + TRIM(NF90_STRERROR( nf90_status )) + END IF + CALL NLTECoeff_Destroy( NLTECoeff ) + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Read_CleanUp + + END FUNCTION NLTECoeff_netCDF_ReadFile + + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! NLTECoeff_netCDF_IOVersion +! +! PURPOSE: +! Subroutine to return the module version information. +! +! CALLING SEQUENCE: +! CALL NLTECoeff_netCDF_IOVersion( Id ) +! +! OUTPUT ARGUMENTS: +! Id: Character string containing the version Id information +! for the module. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT) +! +!:sdoc-: +!-------------------------------------------------------------------------------- + + SUBROUTINE NLTECoeff_netCDF_IOVersion( Id ) + CHARACTER(*), INTENT(OUT) :: Id + Id = MODULE_VERSION_ID + END SUBROUTINE NLTECoeff_netCDF_IOVersion + + +!################################################################################## +!################################################################################## +!## ## +!## ## PRIVATE MODULE ROUTINES ## ## +!## ## +!################################################################################## +!################################################################################## + + ! Function to write the global attributes to a NLTECoeff data file. + + FUNCTION WriteGAtts( & + Filename , & ! Input + FileId , & ! Input + Version , & ! Optional input + Sensor_Id , & ! Optional input + WMO_Satellite_Id, & ! Optional input + WMO_Sensor_Id , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: FileId + INTEGER , OPTIONAL, INTENT(IN) :: Version + CHARACTER(*), OPTIONAL, INTENT(IN) :: Sensor_Id + INTEGER , OPTIONAL, INTENT(IN) :: WMO_Satellite_Id + INTEGER , OPTIONAL, INTENT(IN) :: WMO_Sensor_Id + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'NLTECoeff_WriteGAtts(netCDF)' + CHARACTER(*), PARAMETER :: WRITE_MODULE_HISTORY_GATTNAME = 'write_module_history' + CHARACTER(*), PARAMETER :: CREATION_DATE_AND_TIME_GATTNAME = 'creation_date_and_time' + ! Local variables + CHARACTER(ML) :: msg + CHARACTER(ML) :: gattname + CHARACTER(8) :: cdate + CHARACTER(10) :: ctime + CHARACTER(5) :: czone + INTEGER :: ver + INTEGER :: nf90_status + TYPE(NLTECoeff_type) :: nltecoeff + + ! Set up + err_stat = SUCCESS + msg = ' ' + + ! Mandatory global attributes + ! ...Software ID + gattname = WRITE_MODULE_HISTORY_GATTNAME + nf90_status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(gattname),MODULE_VERSION_ID ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + ! ...Creation date + CALL DATE_AND_TIME( cdate, ctime, czone ) + gattname = CREATION_DATE_AND_TIME_GATTNAME + nf90_status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(gattname), & + cdate(1:4)//'/'//cdate(5:6)//'/'//cdate(7:8)//', '// & + ctime(1:2)//':'//ctime(3:4)//':'//ctime(5:6)//' '// & + czone//'UTC' ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + ! ...The Release + gattname = RELEASE_GATTNAME + nf90_status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(gattname),NLTECoeff%Release ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + + + ! Optional global attributes + ! ...The Version + IF ( PRESENT(Version) ) THEN + ver = Version + ELSE + ver = nltecoeff%Version + END IF + gattname = VERSION_GATTNAME + nf90_status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(gattname),Ver ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + ! ...The Sensor_Id + IF ( PRESENT(Sensor_Id) ) THEN + gattname = SENSOR_ID_GATTNAME + nf90_status = NF90_PUT_ATT( FileID,NF90_GLOBAL,TRIM(gattname),Sensor_Id ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The WMO_Satellite_Id + IF ( PRESENT(WMO_Satellite_Id) ) THEN + gattname = WMO_SATELLITE_ID_GATTNAME + nf90_status = NF90_PUT_ATT( FileID,NF90_GLOBAL,TRIM(gattname),WMO_Satellite_Id ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The WMO_Sensor_Id + IF ( PRESENT(WMO_Sensor_Id) ) THEN + gattname = WMO_SENSOR_ID_GATTNAME + nf90_status = NF90_PUT_ATT( FileID,NF90_GLOBAL,TRIM(gattname),WMO_Sensor_Id ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The title + IF ( PRESENT(title) ) THEN + gattname = TITLE_GATTNAME + nf90_status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(gattname),title ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The history + IF ( PRESENT(history) ) THEN + gattname = HISTORY_GATTNAME + nf90_status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(gattname),history ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The comment + IF ( PRESENT(comment) ) THEN + gattname = COMMENT_GATTNAME + nf90_status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(gattname),comment ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + + CONTAINS + + SUBROUTINE WriteGAtts_CleanUp() + nf90_status = NF90_CLOSE( FileId ) + IF ( nf90_status /= NF90_NOERR ) & + msg = '; Error closing input file during error cleanup - '//& + TRIM(NF90_STRERROR( nf90_status ) ) + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//TRIM(gattname)//' attribute to '//& + TRIM(Filename)//' - '// & + TRIM(NF90_STRERROR( nf90_status ) )//TRIM(msg), & + err_stat ) + END SUBROUTINE WriteGAtts_CleanUp + + END FUNCTION WriteGAtts + + + ! Function to read the global attributes from a NLTECoeff data file. + + FUNCTION ReadGAtts( & + Filename , & ! Input + FileId , & ! Input + Release , & ! Optional output + Version , & ! Optional output + Sensor_Id , & ! Optional output + WMO_Satellite_Id, & ! Optional output + WMO_Sensor_Id , & ! Optional output + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: FileId + INTEGER , OPTIONAL, INTENT(OUT) :: Release + INTEGER , OPTIONAL, INTENT(OUT) :: Version + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Sensor_Id + INTEGER , OPTIONAL, INTENT(OUT) :: WMO_Satellite_Id + INTEGER , OPTIONAL, INTENT(OUT) :: WMO_Sensor_Id + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'NLTECoeff_ReadGAtts(netCDF)' + ! Local variables + CHARACTER(ML) :: msg + CHARACTER(256) :: gattname + CHARACTER(5000) :: gattstring + INTEGER :: nf90_status + + ! Set up + err_stat = SUCCESS + + ! The global attributes + ! ...The Release + IF ( PRESENT(Release) ) THEN + gattname = RELEASE_GATTNAME + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),Release ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The Version + IF ( PRESENT(Version) ) THEN + gattname = VERSION_GATTNAME + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),Version ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The Sensor_Id + IF ( PRESENT(Sensor_Id) ) THEN + gattname = SENSOR_ID_GATTNAME; gattstring = '' + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),gattstring ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( gattstring ) + Sensor_Id = gattstring(1:MIN(LEN(Sensor_Id), LEN_TRIM(gattstring))) + END IF + ! The WMO_Satellite_Id + IF ( PRESENT(WMO_Satellite_Id) ) THEN + gattname = WMO_SATELLITE_ID_GATTNAME + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),WMO_Satellite_Id ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The WMO_Sensor_Id + IF ( PRESENT(WMO_Sensor_Id) ) THEN + gattname = WMO_SENSOR_ID_GATTNAME + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),WMO_Sensor_Id ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The title + IF ( PRESENT(title) ) THEN + gattname = TITLE_GATTNAME; gattstring = '' + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),gattstring ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( gattstring ) + title = gattstring(1:MIN(LEN(title), LEN_TRIM(gattstring))) + END IF + ! ...The history + IF ( PRESENT(history) ) THEN + gattname = HISTORY_GATTNAME; gattstring = '' + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),gattstring ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( gattstring ) + history = gattstring(1:MIN(LEN(history), LEN_TRIM(gattstring))) + END IF + ! ...The comment + IF ( PRESENT(comment) ) THEN + gattname = COMMENT_GATTNAME; gattstring = '' + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),gattstring ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( gattstring ) + comment = gattstring(1:MIN(LEN(comment), LEN_TRIM(gattstring))) + END IF + + CONTAINS + + SUBROUTINE ReadGAtts_CleanUp() + err_stat = FAILURE + msg = 'Error reading '//TRIM(gattname)//' attribute from '//TRIM(Filename)//' - '// & + TRIM(NF90_STRERROR( nf90_status ) ) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + END SUBROUTINE ReadGAtts_CleanUp + + END FUNCTION ReadGAtts + + + ! Function to create a NLTECoeff file for writing + + FUNCTION CreateFile( & + Filename , & ! Input + n_Predictors , & ! Input + n_Sensor_Angles , & ! Input + n_Solar_Angles , & ! Input + n_NLTE_Channels , & ! Input + n_Channels , & ! Input + n_Layers , & ! Input + FileId , & ! Output + Version , & ! Optional input + Sensor_Id , & ! Optional input + WMO_Satellite_Id, & ! Optional input + WMO_Sensor_Id , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: n_Predictors + INTEGER , INTENT(IN) :: n_Sensor_Angles + INTEGER , INTENT(IN) :: n_Solar_Angles + INTEGER , INTENT(IN) :: n_NLTE_Channels + INTEGER , INTENT(IN) :: n_Channels + INTEGER , INTENT(IN) :: n_Layers + INTEGER , INTENT(OUT) :: FileId + INTEGER , OPTIONAL, INTENT(IN) :: Version + CHARACTER(*), OPTIONAL, INTENT(IN) :: Sensor_Id + INTEGER , OPTIONAL, INTENT(IN) :: WMO_Satellite_Id + INTEGER , OPTIONAL, INTENT(IN) :: WMO_Sensor_Id + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'NLTECoeff_CreateFile(netCDF)' + ! Local variables + CHARACTER(ML) :: msg + LOGICAL :: close_file + INTEGER :: nf90_status + INTEGER :: n_predictors_dimid + INTEGER :: n_sensor_angles_dimid + INTEGER :: n_solar_angles_dimid + INTEGER :: n_nlte_channels_dimid + INTEGER :: n_channels_dimid + INTEGER :: n_layers_dimid + INTEGER :: varid + INTEGER :: put_status(4) + + ! Setup + err_stat = SUCCESS + close_file = .FALSE. + + + ! Create the data file + nf90_status = NF90_CREATE( Filename,NF90_CLOBBER,FileId ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error creating '//TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + close_file = .TRUE. + + + ! Define the dimensions + ! ...Number of predictors used in NLTE correction algorithm + nf90_status = NF90_DEF_DIM( FileID,PREDICTOR_DIMNAME,n_predictors,n_predictors_dimid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//PREDICTOR_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Number of sensor zenith angles + nf90_status = NF90_DEF_DIM( FileID,SENSOR_ANGLE_DIMNAME,n_sensor_angles,n_sensor_angles_dimid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//SENSOR_ANGLE_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Number of solar zenith angles + nf90_status = NF90_DEF_DIM( FileID,SOLAR_ANGLE_DIMNAME,n_solar_angles,n_solar_angles_dimid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//SOLAR_ANGLE_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Number of NLTE channels for a sensor + nf90_status = NF90_DEF_DIM( FileID,NLTE_CHANNEL_DIMNAME,n_nlte_channels,n_nlte_channels_dimid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//NLTE_CHANNEL_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Total number of channels for the sensor + nf90_status = NF90_DEF_DIM( FileID,CHANNEL_DIMNAME,n_channels,n_channels_dimid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//CHANNEL_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Number of layers for which mean temperatures are computed + nf90_status = NF90_DEF_DIM( FileID,LAYER_DIMNAME,n_layers,n_layers_dimid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//LAYER_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + + + ! Write the global attributes + err_stat = WriteGAtts( & + Filename, & + FileId , & + Version = Version , & + Sensor_Id = Sensor_Id , & + WMO_Satellite_Id = WMO_Satellite_Id, & + WMO_Sensor_Id = WMO_Sensor_Id , & + Title = Title , & + History = History , & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error writing global attribute to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + + + ! Define the variables + ! ...Sensor_Channel variable + nf90_status = NF90_DEF_VAR( FileID, & + SENSOR_CHANNEL_VARNAME, & + SENSOR_CHANNEL_TYPE, & + dimIDs=(/n_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//SENSOR_CHANNEL_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,SENSOR_CHANNEL_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,SENSOR_CHANNEL_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,SENSOR_CHANNEL_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,SENSOR_CHANNEL_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//SENSOR_CHANNEL_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Upper_Plevel variable + nf90_status = NF90_DEF_VAR( FileID, & + UPPER_PLEVEL_VARNAME, & + UPPER_PLEVEL_TYPE, & + dimIDs=(/n_layers_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//UPPER_PLEVEL_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,UPPER_PLEVEL_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,UPPER_PLEVEL_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,UPPER_PLEVEL_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,UPPER_PLEVEL_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//UPPER_PLEVEL_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Lower_Plevel variable + nf90_status = NF90_DEF_VAR( FileID, & + LOWER_PLEVEL_VARNAME, & + LOWER_PLEVEL_TYPE, & + dimIDs=(/n_layers_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//LOWER_PLEVEL_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,LOWER_PLEVEL_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,LOWER_PLEVEL_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,LOWER_PLEVEL_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,LOWER_PLEVEL_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//LOWER_PLEVEL_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Min_Tm variable + nf90_status = NF90_DEF_VAR( FileID, & + MIN_TM_VARNAME, & + MIN_TM_TYPE, & + dimIDs=(/n_layers_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//MIN_TM_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,MIN_TM_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,MIN_TM_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,MIN_TM_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,MIN_TM_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//MIN_TM_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Max_Tm variable + nf90_status = NF90_DEF_VAR( FileID, & + MAX_TM_VARNAME, & + MAX_TM_TYPE, & + dimIDs=(/n_layers_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//MAX_TM_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,MAX_TM_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,MAX_TM_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,MAX_TM_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,MAX_TM_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//MAX_TM_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Mean_Tm variable + nf90_status = NF90_DEF_VAR( FileID, & + MEAN_TM_VARNAME, & + MEAN_TM_TYPE, & + dimIDs=(/n_layers_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//MEAN_TM_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,MEAN_TM_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,MEAN_TM_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,MEAN_TM_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,MEAN_TM_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//MEAN_TM_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Secant_Sensor_Zenith variable + nf90_status = NF90_DEF_VAR( FileID, & + SENSOR_ANGLE_VARNAME, & + SENSOR_ANGLE_TYPE, & + dimIDs=(/n_sensor_angles_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//SENSOR_ANGLE_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,SENSOR_ANGLE_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,SENSOR_ANGLE_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,SENSOR_ANGLE_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,SENSOR_ANGLE_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//SENSOR_ANGLE_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Secant_Solar_Zenith variable + nf90_status = NF90_DEF_VAR( FileID, & + SOLAR_ANGLE_VARNAME, & + SOLAR_ANGLE_TYPE, & + dimIDs=(/n_solar_angles_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//SOLAR_ANGLE_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,SOLAR_ANGLE_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,SOLAR_ANGLE_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,SOLAR_ANGLE_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,SOLAR_ANGLE_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//SOLAR_ANGLE_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...NLTE_Channel variable + nf90_status = NF90_DEF_VAR( FileID, & + NLTE_CHANNEL_VARNAME, & + NLTE_CHANNEL_TYPE, & + dimIDs=(/n_nlte_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//NLTE_CHANNEL_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,NLTE_CHANNEL_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,NLTE_CHANNEL_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,NLTE_CHANNEL_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,NLTE_CHANNEL_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//NLTE_CHANNEL_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...C_Index variable + nf90_status = NF90_DEF_VAR( FileID, & + C_INDEX_VARNAME, & + C_INDEX_TYPE, & + dimIDs=(/n_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//C_INDEX_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,C_INDEX_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,C_INDEX_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,C_INDEX_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,C_INDEX_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//C_INDEX_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...C variable + nf90_status = NF90_DEF_VAR( FileID, & + C_VARNAME, & + C_TYPE, & + dimIDs=(/n_predictors_dimid ,& + n_sensor_angles_dimid,& + n_solar_angles_dimid ,& + n_nlte_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//C_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,C_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,C_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,C_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,C_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//C_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + + + ! Take netCDF file out of define mode + nf90_status = NF90_ENDDEF( FileId ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error taking file '//TRIM(Filename)// & + ' out of define mode - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + + CONTAINS + + SUBROUTINE Create_CleanUp() + IF ( close_file ) THEN + nf90_status = NF90_CLOSE( FileID ) + IF ( nf90_status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup - '//& + TRIM(NF90_STRERROR( nf90_status )) + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Create_CleanUp + + END FUNCTION CreateFile + +END MODULE NLTECoeff_netCDF_IO diff --git a/libsrc/RSS_Emissivity_Model.f90 b/libsrc/RSS_Emissivity_Model.f90 new file mode 100644 index 000000000..99f3aef13 --- /dev/null +++ b/libsrc/RSS_Emissivity_Model.f90 @@ -0,0 +1,600 @@ +! this is just Specular emissivity part of FORTRAN code for wind emissivity model in RSS SMAP V3.0 salinity release +! Thomas Meissner +! RSS +! October 15, 2018 + +! References: +! 1. Meissner, T.; F. Wentz and D. Le Vine, Aquarius Salinity Retrieval Algorithm Theoretical Basis Document (ATBD), +! End of Mission Version; RSS Technical Report 120117; December 1, 2017; +! Available online at ftp://podaac-ftp.jpl.nasa.gov/allData/aquarius/docs/v5/AQ-014-PS-0017_Aquarius_ATBD-EndOfMission.pdf. +! +! 2. Meissner, T, F. Wentz, and D, Le Vine, 2018, +! The Salinity Retrieval Algorithms for the NASA Aquarius Version 5 and SMAP Version 3 Releases, +! Remote Sensing 10, 1121, doi:10.3390/rs10071121. +! +! 3. Meissner, T. and F. Wentz, The complex dielectric constant of pure and sea water from microwave satellite observations, +! IEEE TGRS, 2004, 42(9), 1836 – 1849, doi:10.1109/TGRS.2004.831888. +! +! 4. Meissner, T. and F. Wentz, The emissivity of the ocean surface between 6 and 90 GHz +! over a large range of wind speeds and Earth incidence angles, +! IEEE TGRS, 2012, 50(8), 3004 – 3026, doi: 10.1109/TGRS.2011.2179662. +! +! 5. Meissner, T., F. Wentz, F. and L. Ricciardulli, The emission and scattering of L-band microwave radiation +! from rough ocean surfaces and wind speed measurements from Aquarius, +! J. Geophys. Res. Oceans, 2014, 119, doi:10.1002/2014JC009837. +! + + + +module RSS_Emissivity_Model + +USE Type_Kinds , ONLY: fp +implicit none +private +save + +! Declare local constant Pi +REAL, PARAMETER :: Pi = 3.14159265358979323846 +REAL(fp), parameter :: f0=17.97510 + +public :: fdem0_meissner_wentz, & + FDEM0_MEISSNER_WENTZ_TL, & + FDEM0_MEISSNER_WENTZ_AD + +contains + + +subroutine fdem0_meissner_wentz(freq,tht,sst,salinity, em0) +! input: +! name parameter unit range +! +! freq frequency [GHz] >0 +! tht EIA [deg] [0, 90[ +! sst SST [C] -25 c to 40 c for pure water +! -2 c to 34 c for saline water +! salinity salinity [ppt] 0 to 40 +! +! output: +! EM0 specular emissivity [0,1] +! 2-dimesnional vector, 1=v-pol, 2=h-pol + +implicit none + +real(fp), intent(in) :: freq +real(fp), intent(in) :: tht,sst,salinity +complex(fp), dimension(2), intent(out) :: em0 +real(fp), parameter :: f0=17.97510 +real(fp) :: costht,sinsqtht,tht_r +real(fp) :: e0s,e1s,e2s,n1s,n2s,sig +complex(fp) :: permit,esqrt,rh,rv +complex(fp), parameter :: j=(0.,1.) + +!convert phir to radian +tht_r =tht *pi/180.0_fp +call dielectric_meissner_wentz(sst,salinity, e0s,e1s,e2s,n1s,n2s,sig) + +costht=cos(tht_r) +sinsqtht=1.-costht*costht + +! debye law (2 relaxation wavelengths) +permit = (e0s - e1s)/(1.0 - j*(freq/n1s)) + (e1s - e2s)/(1.0 - j*(freq/n2s)) + e2s + j*sig*f0/freq +permit = conjg(permit) + +esqrt = sqrt(permit-sinsqtht) +rh = (costht-esqrt)/(costht+esqrt) +rv = (permit*costht-esqrt)/(permit*costht+esqrt) +em0(1) = 1.-rv*conjg(rv) +em0(2) = 1.-rh*conjg(rh) + +return +end subroutine fdem0_meissner_wentz + + +subroutine dielectric_meissner_wentz(sst_in,s, e0s,e1s,e2s,n1s,n2s,sig) +! +! complex dielectric constant: eps +! [MW 2004, MW 2012]. +! References: +! [MW 2004]: T. Meissner and F. J. Wentz, +! "The complex dielectric constant of pure and sea water from microwave satellite observations," +! IEEE Trans. Geosci. Remote Sens., vol. 42, no.9, pp 1836 – 1849, 2004. +! +! [MW 2012]: T. Meissner and F. J. Wentz, +! "The Emissivity of the Ocean Surface between 6 – 90 GHz over a Large Range of Wind Speeds and Earth Incidence Angles," +! IEEE Trans. Geosci. Remote Sens., vol. 50, no.8, pp 3004 - 3026, 2012. +! +! Changes from [MW 2012]: +! 1. Typo (sign) in the printed version of coefficient d3 in Table 7. Its value should be -0.35594E-06. +! 2. Changed SST behavior of coefficient b2 from: +! b2 = 1.0 + s*(z(10) + z(11)*sst) to +! b2 = 1.0 + s*(z(10) + 0.5*z(11)*(sst + 30)) +! +! input: +! name parameter unit range +! sst sst [c] -25 c to 40 c for pure water +! -2 c to 34 c for saline water +! s salinity [ppt] 0 to 40 +! +! output: +! Debye pparameters: e0s,e1s,e2s,n1s,n2s,sig +! The permittivity can be calculated in the subroutine: fdpermit_meissner_wentz + +implicit none + +real(fp), intent(in) :: sst_in,s +real(fp), intent(out) :: e0s,e1s,e2s,n1s,n2s,sig +real(fp), dimension(11), parameter :: & + x=(/ 5.7230e+00, 2.2379e-02, -7.1237e-04, 5.0478e+00, -7.0315e-02, 6.0059e-04, 3.6143e+00, & + 2.8841e-02, 1.3652e-01, 1.4825e-03, 2.4166e-04 /) +real(fp), dimension(13), parameter :: & + z=(/ -3.56417e-03, 4.74868e-06, 1.15574e-05, 2.39357e-03, -3.13530e-05, & + 2.52477e-07, -6.28908e-03, 1.76032e-04, -9.22144e-05, -1.99723e-02, & + 1.81176e-04, -2.04265e-03, 1.57883e-04 /) ! 2004 +real(fp), dimension(3), parameter :: a0coef=(/ -0.33330E-02, 4.74868e-06, 0.0e+00/) +real(fp), dimension(5), parameter :: b1coef=(/0.23232E-02, -0.79208E-04, 0.36764E-05, -0.35594E-06, 0.89795E-08/) +real(fp) :: e0,e1,e2,n1,n2 +real(fp) :: a0,a1,a2,b1,b2 +real(fp) :: sig35,r15,rtr15,alpha0,alpha1 +real(fp) :: sst,sst2,sst3,sst4,s2 + +sst=sst_in +if(sst.lt.-30.16) sst=-30.16 !protects against n1 and n2 going zero for very cold water + +sst2=sst*sst +sst3=sst2*sst +sst4=sst3*sst +s2=s*s + +! pure water + e0 = (3.70886e4 - 8.2168e1*sst)/(4.21854e2 + sst) ! stogryn et al. + e1 = x(1) + x(2)*sst + x(3)*sst2 + n1 = (45.00 + sst)/(x(4) + x(5)*sst + x(6)*sst2) + e2 = x(7) + x(8)*sst + n2 = (45.00 + sst)/(x(9) + x(10)*sst + x(11)*sst2) + +! saline water +! conductivity [s/m] taken from stogryn et al. + sig35 = 2.903602 + 8.60700e-2*sst + 4.738817e-4*sst2 - 2.9910e-6*sst3 + 4.3047e-9*sst4 + r15 = s*(37.5109+5.45216*s+1.4409e-2*s2)/(1004.75+182.283*s+s2) + + alpha0 = (6.9431+3.2841*s-9.9486e-2*s2)/(84.850+69.024*s+s2) + alpha1 = 49.843 - 0.2276*s + 0.198e-2*s2 + rtr15 = 1.0 + (sst-15.0)*alpha0/(alpha1+sst) + + sig = sig35*r15*rtr15 + +! permittivity + a0 = exp(a0coef(1)*s + a0coef(2)*s2 + a0coef(3)*s*sst) + e0s = a0*e0 + + if(sst.le.30) then + b1 = 1.0 + s*(b1coef(1) + b1coef(2)*sst + b1coef(3)*sst2 + b1coef(4)*sst3 + b1coef(5)*sst4) + else + b1 = 1.0 + s*(9.1873715e-04 + 1.5012396e-04*(sst-30)) + endif + n1s = n1*b1 + + a1 = exp(z(7)*s + z(8)*s2 + z(9)*s*sst) + e1s = e1*a1 + +! b2 = 1.0 + s*(z(10) + z(11)*sst) + b2 = 1.0 + s*(z(10) + 0.5*z(11)*(sst + 30)) + n2s = n2*b2 + + + a2 = 1.0 + s*(z(12) + z(13)*sst) + e2s = e2*a2 + +return +end subroutine dielectric_meissner_wentz + +!!!Tangent part +! Generated by TAPENADE (INRIA, Ecuador team) +! Tapenade 3.15 (master) - 15 Apr 2020 11:54 +! +! Generated by TAPENADE (INRIA, Ecuador team) +! Tapenade 3.15 (master) - 15 Apr 2020 11:54 +! +! Differentiation of fdem0_meissner_wentz in forward (tangent) mode: +! variations of useful results: em0 +! with respect to varying inputs: sst +SUBROUTINE FDEM0_MEISSNER_WENTZ_TL(freq, tht, sst, sst_TL, salinity,salinity_TL, em0, & +& em0_TL) + IMPLICIT NONE + REAL(FP), INTENT(IN) :: freq + REAL(FP), INTENT(IN) :: tht, sst, salinity + REAL(FP), INTENT(IN) :: sst_TL,salinity_TL + COMPLEX(FP), DIMENSION(2), INTENT(OUT) :: em0 + COMPLEX(FP), DIMENSION(2), INTENT(OUT) :: em0_TL + REAL(FP) :: costht, sinsqtht, costht_TL, sinsqtht_TL, freq_TL,tht_TL + REAL(FP) :: e0s, e1s, e2s, n1s, n2s, sig + REAL(FP) :: e0s_TL, e1s_TL, e2s_TL, n1s_TL, n2s_TL, sig_TL + COMPLEX(FP) :: permit, esqrt, rh, rv + COMPLEX(FP) :: permit_TL, esqrt_TL, rh_TL, rv_TL + COMPLEX, PARAMETER :: j=(0.,1.) + REAL(FP) :: tht_r, tht_r_TL + INTRINSIC COS + INTRINSIC CONJG + COMPLEX(FP) :: temp + COMPLEX(FP) :: temp0 + COMPLEX(FP) :: temp1 + COMPLEX(FP) :: temp2 + COMPLEX(FP) :: temp3 + + freq_TL = 0.0_fp + tht_TL = 0.0_fp + tht_r_TL = pi*tht_TL/180.0_fp + tht_r = tht*pi/180.0_fp + CALL DIELECTRIC_MEISSNER_WENTZ_TL(sst, sst_TL, salinity, salinity_TL, e0s, e0s_TL, e1s, & +& e1s_TL, e2s, e2s_TL, n1s, n1s_TL, n2s, n2s_TL, sig& +& , sig_TL) + costht_TL = -(SIN(tht_r)*tht_r_TL) + costht = COS(tht_r) + sinsqtht_TL = -(2*costht*costht_TL) + sinsqtht = 1. - costht*costht +! debye law (2 relaxation wavelengths) + temp = -(j*freq/n1s) + 1.0 + temp0 = (e0s-e1s)/temp + temp1 = -(j*freq/n2s) + 1.0 + temp2 = (e1s-e2s)/temp1 + permit_TL = (e0s_TL-e1s_TL+temp0*j*(freq_TL-freq*n1s_TL/n1s)/n1s)/temp + (e1s_TL-& +& e2s_TL+temp2*j*(freq_TL-freq*n2s_TL/n2s)/n2s)/temp1 + e2s_TL + j*f0*(sig_TL-& +& sig*freq_TL/freq)/freq + permit = temp0 + temp2 + e2s + j*f0*(sig/freq) + permit_TL = CONJG(permit_TL) + permit = CONJG(permit) + temp3 = SQRT(permit - sinsqtht) + IF (permit - sinsqtht .EQ. 0.0) THEN + esqrt_TL = 0.0 + ELSE + esqrt_TL = (permit_TL-sinsqtht_TL)/(2.0*temp2) + END IF + esqrt = temp3 + temp2 = (costht-esqrt)/(costht+esqrt) + rh_TL = (costht_TL-esqrt_TL-temp2*(costht_TL+esqrt_TL))/(costht+esqrt) + rh = temp2 + temp2 = (permit*costht-esqrt)/(permit*costht+esqrt) + rv_TL = (costht*permit_TL+permit*costht_TL-esqrt_TL-temp2*(costht*permit_TL+& +& permit*costht_TL+esqrt_TL))/(permit*costht+esqrt) + rv = temp2 + temp3 = CONJG(rv) + em0_TL(1) = -(temp3*rv_TL+rv*CONJG(rv_TL)) + em0(1) = 1. - rv*temp3 + temp3 = CONJG(rh) + em0_TL(2) = -(temp3*rh_TL+rh*CONJG(rh_TL)) + em0(2) = 1. - rh*temp3 + + RETURN + +END SUBROUTINE FDEM0_MEISSNER_WENTZ_TL + +! Differentiation of dielectric_meissner_wentz in forward (tangent) mode: +! variations of useful results: e2s n1s e0s sig n2s e1s +! with respect to varying inputs: sst_in +SUBROUTINE DIELECTRIC_MEISSNER_WENTZ_TL(sst_in, sst_in_TL, salinity, salinity_TL, e0s, e0s_TL& +& , e1s, e1s_TL, e2s, e2s_TL, n1s, n1s_TL, n2s, n2s_TL, sig, sig_TL) + IMPLICIT NONE + REAL(FP), INTENT(IN) :: sst_in, salinity + REAL(FP), INTENT(IN) :: sst_in_TL, salinity_TL + REAL(FP), INTENT(OUT) :: e0s, e1s, e2s, n1s, n2s, sig + REAL(FP), INTENT(OUT) :: e0s_TL, e1s_TL, e2s_TL, n1s_TL, n2s_TL, sig_TL + REAL(FP), DIMENSION(11), PARAMETER :: x=(/5.7230e+00, 2.2379e-02, -& +& 7.1237e-04, 5.0478e+00, -7.0315e-02, 6.0059e-04, 3.6143e+00, & +& 2.8841e-02, 1.3652e-01, 1.4825e-03, 2.4166e-04/) + REAL(FP), DIMENSION(13), PARAMETER :: z=(/-3.56417e-03, 4.74868e-06, & +& 1.15574e-05, 2.39357e-03, -3.13530e-05, 2.52477e-07, -6.28908e-03, & +& 1.76032e-04, -9.22144e-05, -1.99723e-02, 1.81176e-04, -2.04265e-03, & +& 1.57883e-04/) + REAL(FP), DIMENSION(3), PARAMETER :: a0coef=(/-0.33330e-02, 4.74868e-06& +& , 0.0e+00/) + REAL(FP), DIMENSION(5), PARAMETER :: b1coef=(/0.23232e-02, -0.79208e-04& +& , 0.36764e-05, -0.35594e-06, 0.89795e-08/) + REAL(FP) :: e0, e1, e2, n1, n2 + REAL(FP) :: e0_TL, e1_TL, e2_TL, n1_TL, n2_TL + REAL(FP) :: a0, a1, a2, b1, b2 + REAL(FP) :: a0_TL, a1_TL, a2_TL, b1_TL, b2_TL + REAL(FP) :: sig35, r15, rtr15, alpha0, alpha1 + REAL(FP) :: sig35_TL, r15_TL, rtr15_TL, alpha0_TL, alpha1_TL + REAL(FP) :: s,sst, sst2, sst3, sst4, s2 + REAL(FP) :: sst_TL, s_TL,sst2_TL, sst3_TL, sst4_TL, s2_TL + INTRINSIC EXP + REAL(FP) :: temp + REAL(FP) :: temp0 + sst = sst_in + sst_TL = sst_in_TL + s = salinity + s_TL= salinity_TL +!protects against n1 and n2 going zero for very cold water + IF (sst .LT. -30.16) THEN + sst = -30.16 + sst_TL = 0.0_4 + END IF + sst2_TL = 2*sst*sst_TL + sst2 = sst*sst + sst3_TL = sst*sst2_TL + sst2*sst_TL + sst3 = sst2*sst + sst4_TL = sst*sst3_TL + sst3*sst_TL + sst4 = sst3*sst + s2_TL = 2 * s * s_TL + s2 = s * s +! pure water +! stogryn et al. + temp = (-(8.2168e1*sst)+3.70886e4)/(sst+4.21854e2) + e0_TL = -((temp+8.2168e1)*sst_TL/(sst+4.21854e2)) + e0 = temp + e1_TL = x(2)*sst_TL + x(3)*sst2_TL + e1 = x(1) + x(2)*sst + x(3)*sst2 + temp = x(4) + x(5)*sst + x(6)*sst2 + temp0 = (sst+45.00)/temp + n1_TL = (sst_TL-temp0*(x(5)*sst_TL+x(6)*sst2_TL))/temp + n1 = temp0 + e2_TL = x(8)*sst_TL + e2 = x(7) + x(8)*sst + temp0 = x(9) + x(10)*sst + x(11)*sst2 + temp = (sst+45.00)/temp0 + n2_TL = (sst_TL-temp*(x(10)*sst_TL+x(11)*sst2_TL))/temp0 + n2 = temp +! saline water +! conductivity [s/m] taken from stogryn et al. + sig35_TL = 8.60700e-2*sst_TL + 4.738817e-4*sst2_TL + 4.3047e-9*sst4_TL - & +& 2.9910e-6*sst3_TL + sig35 = 2.903602 + 8.60700e-2*sst + 4.738817e-4*sst2 - 2.9910e-6*sst3 & +& + 4.3047e-9*sst4 + temp0 = s/(182.283*s+s2+1004.75) + temp = 5.45216*s + 1.4409e-2*s2 + 37.5109 + r15_TL = temp0*(5.45216*s_TL+1.4409e-2*s2_TL) + temp*(s_TL-temp0*(182.283*s_TL+& +& s2_TL))/(182.283*s+s2+1004.75) + r15 = temp*temp0 + temp0 = (3.2841*s-9.9486e-2*s2+6.9431)/(69.024*s+s2+84.850) + alpha0_TL = (3.2841*s_TL-9.9486e-2*s2_TL-temp0*(69.024*s_TL+s2_TL))/(69.024*s+s2& +& +84.850) + alpha0 = temp0 + alpha1_TL = 0.198e-2*s2_TL - 0.2276*s_TL + alpha1 = 49.843 - 0.2276*s + 0.198e-2*s2 + temp0 = (sst-15.0)*alpha0/(alpha1+sst) + rtr15_TL = (alpha0*sst_TL+(sst-15.0)*alpha0_TL-temp0*(alpha1_TL+sst_TL))/(alpha1& +& +sst) + rtr15 = temp0 + 1.0 + sig_TL = rtr15*(r15*sig35_TL+sig35*r15_TL) + sig35*r15*rtr15_TL + sig = sig35*r15*rtr15 +! permittivity + temp0 = a0coef(1)*s + a0coef(2)*s2 + a0coef(3)*s*sst + a0_TL = EXP(temp0)*(a0coef(1)*s_TL+a0coef(2)*s2_TL+a0coef(3)*(sst*s_TL+s*sst_TL)& +& ) + a0 = EXP(temp0) + e0s_TL = e0*a0_TL + a0*e0_TL + e0s = a0*e0 + IF (sst .LE. 30) THEN + temp0 = b1coef(1) + b1coef(2)*sst + b1coef(3)*sst2 + b1coef(4)*sst3 & +& + b1coef(5)*sst4 + b1_TL = temp0*s_TL + s*(b1coef(2)*sst_TL+b1coef(3)*sst2_TL+b1coef(4)*sst3_TL+& +& b1coef(5)*sst4_TL) + b1 = s*temp0 + 1.0 + ELSE + b1_TL = (1.5012396e-04*(sst-30)+9.1873715e-04)*s_TL + s*1.5012396e-04*& +& sst_TL + b1 = 1.0 + s*(9.1873715e-04+1.5012396e-04*(sst-30)) + END IF + n1s_TL = b1*n1_TL + n1*b1_TL + n1s = n1*b1 + temp0 = z(7)*s + z(8)*s2 + z(9)*s*sst + a1_TL = EXP(temp0)*(z(7)*s_TL+z(8)*s2_TL+z(9)*(sst*s_TL+s*sst_TL)) + a1 = EXP(temp0) + e1s_TL = a1*e1_TL + e1*a1_TL + e1s = e1*a1 +! b2 = 1.0 + s*(z(10) + z(11)*sst) + temp0 = z(10) + 0.5*z(11)*(sst+30) + b2_TL = temp0*s_TL + s*z(11)*0.5*sst_TL + b2 = s*temp0 + 1.0 + n2s_TL = b2*n2_TL + n2*b2_TL + n2s = n2*b2 + temp0 = z(12) + z(13)*sst + a2_TL = temp0*s_TL + s*z(13)*sst_TL + a2 = s*temp0 + 1.0 + e2s_TL = a2*e2_TL + e2*a2_TL + e2s = e2*a2 + RETURN +END SUBROUTINE DIELECTRIC_MEISSNER_WENTZ_TL + + +! Adjoint part +! derived analytically +!"x.adjoint = x.adjoint +f(x) * J " + +SUBROUTINE FDEM0_MEISSNER_WENTZ_AD(freq, tht, sst, sst_AD, & +& salinity,salinity_AD, em0, em0_AD) + IMPLICIT NONE + REAL(FP), INTENT(IN) :: freq, tht + REAL(FP), INTENT(IN) :: sst, salinity + REAL(FP), INTENT(INOUT) :: salinity_AD, sst_AD + REAL(FP), DIMENSION(2), INTENT(INOUT) :: em0, em0_AD + COMPLEX(FP), DIMENSION(2) :: d_em0_dsst, d_em0_ds + + REAL(FP) :: costht, sinsqtht + REAL(FP) :: e0s, e1s, e2s, n1s, n2s, sig + REAL(FP) :: d_e0s_dsst,d_e0s_ds,d_e1s_dsst,d_e1s_ds,d_e2s_dsst,d_e2s_ds + REAL(FP) :: d_n1s_dsst,d_n1s_ds, d_n2s_dsst,d_n2s_ds, d_sig_dsst,d_sig_ds + + COMPLEX(FP):: permit, esqrt, rh, rv + COMPLEX(FP):: d_permit_dsst, d_permit_ds, d_esqrt_dsst + COMPLEX(FP):: d_esqrt_ds,d_rh_dsst ,d_rh_ds ,d_rv_dsst ,d_rv_ds + COMPLEX(FP), PARAMETER :: j=(0.,1.) + REAL(FP) :: tht_r + + +tht_r =tht *pi/180.0_fp +call dielectric_meissner_wentz(sst,salinity, e0s,e1s,e2s,n1s,n2s,sig) +!call dielectric_meissner_wentz(sst,salinity, e0s,e1s,e2s,n1s,n2s,sig) +call DIELECTRIC_MEISSNER_WENTZ_K(sst, salinity, d_e0s_dsst, d_e0s_ds & +& , d_e1s_dsst, d_e1s_ds, d_e2s_dsst, d_e2s_ds, d_n1s_dsst, & +d_n1s_ds, d_n2s_dsst, d_n2s_ds, d_sig_dsst, d_sig_ds) +!print *, "F1" +costht=cos(tht_r) +sinsqtht=1.-costht*costht + +! debye law (2 relaxation wavelengths) +permit = (e0s - e1s)/(1.0 - j*(freq/n1s)) + (e1s - e2s)/(1.0 - j*(freq/n2s)) + e2s + j*sig*f0/freq +d_permit_dsst = (d_e0s_dsst-d_e1s_dsst) /(1.0 - j*(freq/n1s)) - (e0s - e1s) *(j*freq)/(n1s-j*freq)**2 * d_n1s_dsst & ++ (d_e1s_dsst-d_e2s_dsst) /(1.0 - j*(freq/n2s)) - (e1s - e2s) *(j*freq)/(n2s-j*freq)**2 * d_n2s_dsst & ++ d_e2s_dsst + j* d_sig_dsst *f0/freq + +d_permit_ds = (d_e0s_ds-d_e1s_ds)/(1.0 - j*(freq/n1s)) - (e0s - e1s) *(j*freq)/(n1s-j*freq)**2 * d_n1s_ds & ++ (d_e1s_ds-d_e2s_ds) /(1.0 - j*(freq/n2s)) - (e1s - e2s) *(j*freq)/(n2s-j*freq)**2 * d_n2s_ds & ++ d_e2s_ds + j* d_sig_ds *f0/freq + +permit = CONJG(permit) +d_permit_dsst = CONJG(d_permit_dsst) +d_permit_ds = CONJG(d_permit_ds) +!print *, "permit", permit +esqrt = sqrt(permit-sinsqtht) + +d_esqrt_dsst = d_permit_dsst /(2*sqrt(permit-sinsqtht)) +d_esqrt_ds = d_permit_ds /(2*sqrt(permit-sinsqtht)) + +rh = (costht-esqrt)/(costht+esqrt) + +d_rh_dsst = -d_esqrt_dsst * (2*costht)/(costht+esqrt)**2 +d_rh_ds = -d_esqrt_ds * (2*costht)/(costht+esqrt)**2 + +rv = (permit*costht-esqrt)/(permit*costht+esqrt) +d_rv_dsst = (d_permit_dsst*costht-d_esqrt_dsst)/(permit*costht+esqrt) -(permit*costht-esqrt)/(permit*costht+esqrt)**2 *(d_permit_dsst*costht + d_esqrt_dsst) +d_rv_ds = (d_permit_ds*costht-d_esqrt_ds)/(permit*costht+esqrt) -(permit*costht-esqrt)/(permit*costht+esqrt)**2 *(d_permit_ds*costht + d_esqrt_ds) + +em0(1) = 1.-rv*CONJG(rv) +em0(2) = 1.-rh*CONJG(rh) + +d_em0_dsst(1) = -d_rv_dsst*CONJG(rv) -rv*CONJG(d_rv_dsst) +d_em0_dsst(2) = -d_rh_dsst*CONJG(rh) -rh*CONJG(d_rh_dsst) +d_em0_ds(1) = -d_rv_ds*CONJG(rv) -rv*CONJG(d_rv_ds) +d_em0_ds(2) = -d_rh_ds*CONJG(rh) -rh*CONJG(d_rh_ds) + +sst_AD = sst_AD + d_em0_dsst(1)* em0_AD(1) +sst_AD = sst_AD + d_em0_dsst(2)* em0_AD(2) +salinity_AD = salinity_AD + d_em0_ds(1)* em0_AD(1) +salinity_AD = salinity_AD + d_em0_ds(2)* em0_AD(2) + +END SUBROUTINE FDEM0_MEISSNER_WENTZ_AD + +! jacobians of outputs of DIELECTRIC_MEISSNER_WENTZ for salinity and SST +SUBROUTINE DIELECTRIC_MEISSNER_WENTZ_K(sst_in, salinity, d_e0s_dsst, d_e0s_ds & +& , d_e1s_dsst, d_e1s_ds, d_e2s_dsst, d_e2s_ds, d_n1s_dsst, & +d_n1s_ds, d_n2s_dsst, d_n2s_ds, d_sig_dsst, d_sig_ds) + IMPLICIT NONE + REAL(FP), INTENT(IN) :: sst_in, salinity + REAL(FP) :: d_e0s_dsst,d_e0s_ds,d_e1s_dsst + REAL(FP) :: d_e1s_ds,d_e2s_dsst,d_e2s_ds + REAL(FP) :: d_n1s_dsst,d_n1s_ds, d_n2s_dsst + REAL(FP) :: d_n2s_ds, d_sig_dsst,d_sig_ds + REAL(FP) :: e0s, e1s, e2s, n1s, n2s, sig + REAL(FP), DIMENSION(11), PARAMETER :: x=(/5.7230e+00, 2.2379e-02, -& +& 7.1237e-04, 5.0478e+00, -7.0315e-02, 6.0059e-04, 3.6143e+00, & +& 2.8841e-02, 1.3652e-01, 1.4825e-03, 2.4166e-04/) + REAL(FP), DIMENSION(13), PARAMETER :: z=(/-3.56417e-03, 4.74868e-06, & +& 1.15574e-05, 2.39357e-03, -3.13530e-05, 2.52477e-07, -6.28908e-03, & +& 1.76032e-04, -9.22144e-05, -1.99723e-02, 1.81176e-04, -2.04265e-03, & +& 1.57883e-04/) + REAL(FP), DIMENSION(3), PARAMETER :: a0coef=(/-0.33330e-02, 4.74868e-06& +& , 0.0e+00/) + REAL(FP), DIMENSION(5), PARAMETER :: b1coef=(/0.23232e-02, -0.79208e-04& +& , 0.36764e-05, -0.35594e-06, 0.89795e-08/) + REAL(FP) :: e0, e1, e2, n1, n2 + REAL(FP) :: sst, s,a0, a1, a2, b1, b2 + REAL(FP) :: sig35, r15, rtr15, alpha0, alpha1 + REAL(FP) :: d_e0_dsst,d_e1_dsst,d_n1_dsst,d_e2_dsst + REAL(FP) :: d_n2_dsst, d_sig35_dsst,d_r15_ds, d_alpha0_ds + REAL(FP) :: d_alpha1_ds,d_rtr15_dsst,d_rtr15_ds + REAL(FP) :: d_a0_dsst,d_a0_ds,d_a1_dsst,d_a1_ds,d_a2_dsst + REAL(FP) :: d_a2_ds,d_b1_dsst,d_b1_ds,d_b2_dsst,d_b2_ds + sst = sst_in + s = salinity + if(sst.lt.-30.16) sst=-30.16 !protects against n1 and n2 going zero for very cold water + call dielectric_meissner_wentz(sst,salinity, e0s,e1s,e2s,n1s,n2s,sig) +! pure water + e0 = (3.70886e4 - 8.2168e1*sst)/(4.21854e2 + sst) ! stogryn et al. + d_e0_dsst=(-7.1751499e4)/(4.21854e2 + sst)**2 + + e1 = x(1) + x(2)*sst + x(3)*(sst)**2 + d_e1_dsst = x(2)+2*x(3)*sst + + n1 = (45.00 + sst)/( x(4) + x(5)*sst + x(6)*(sst**2) ) + d_n1_dsst=-(x(6)* sst**2 +90*x(6)*sst+45*x(5)-x(4))/(x(6)*sst**2+x(5)*sst+x(4))**2 + + e2 = x(7) + x(8)*sst + d_e2_dsst= x(8) + + n2 = (45.00 + sst)/(x(9) + x(10)*sst + x(11)*(sst**2)) + d_n2_dsst=-(x(11)* sst**2+90*x(11)*sst+45*x(10)-x(9))/(x(11)* sst**2 +x(10)*sst+x(9))**2 + +! saline water +! conductivity [s/m] taken from stogryn et al. + sig35 = 2.903602 + 8.60700e-2*sst + 4.738817e-4*sst**2 - 2.9910e-6* sst**3 + 4.3047e-9*sst**4 + d_sig35_dsst=8.60700e-2 + 4.738817e-4*2*sst - 2.9910e-6*3*sst**2 + 4.3047e-9*4*sst**3 + + r15 = s*(37.5109+5.45216*s+1.4409e-2*s**2)/(1004.75+182.283*s+s**2) + d_r15_ds =(0.014409*s**4+5.25302*s**3+999.756*s**2+10956.114*s+37689.076)/(s**2+182.283*s+1004.750)**2 + + alpha0 = (6.9431+3.2841*s-9.9486e-2*s**2)/(84.850+69.024*s+s**2) + d_alpha0_ds = -(10.15096*s**2+30.76896*s+200.584)/(s**2+69.024*s+84.85)**2 + + alpha1 = 49.843 - 0.2276*s + 0.198e-2*s**2 + d_alpha1_ds = 0.396e-2*s-0.2276 + + rtr15 = 1.0 + (sst-15.0)*alpha0/(alpha1+sst) + d_rtr15_dsst = (alpha0*(alpha1+15))/(sst+alpha1)**2 + d_rtr15_ds = d_alpha0_ds * (sst-15.0)/(alpha1+sst) - alpha0 *(sst-15.0) * d_alpha1_ds /(sst+alpha1)**2 + + !sig = sig35*r15*rtr15 + d_sig_dsst= r15* (d_sig35_dsst *rtr15 + sig35 * d_rtr15_dsst) + d_sig_ds = sig35 *(d_r15_ds *rtr15 + r15*d_rtr15_ds) + +! permittivity + a0 = exp(a0coef(1)*s + a0coef(2)*s**2 + a0coef(3)*s*sst) + d_a0_dsst =(a0coef(3)*s) * exp(a0coef(1)*s + a0coef(2)*s**2 + a0coef(3)*s*sst) + d_a0_ds =(2*a0coef(2)*s+a0coef(1)+a0coef(3)*sst)* exp(s*(a0coef(2)*s+a0coef(1)+a0coef(3)*sst)) + + !e0s = a0*e0 + d_e0s_dsst= d_a0_dsst * e0 +a0*d_e0_dsst + d_e0s_ds = e0*d_a0_ds + + if(sst.le.30) then + b1 = 1.0 + s*(b1coef(1) + b1coef(2)*sst + b1coef(3)*sst**2 + b1coef(4)*sst**3 + b1coef(5)*sst**4) + d_b1_dsst = s*(b1coef(2)+2*b1coef(3)*sst + 3*b1coef(4)*sst**2 + 4*b1coef(5)*sst**3) + d_b1_ds =b1coef(1) + b1coef(2)*sst + b1coef(3)*sst**2 + b1coef(4)*sst**3 + b1coef(5)*sst**4 + else + b1 = 1.0 + s*(9.1873715e-04 + 1.5012396e-04*(sst-30)) + d_b1_dsst = s*(1.5012396e-04) + d_b1_ds = 9.1873715e-04 + 1.5012396e-04*(sst-30) + endif + !n1s = n1*b1 + d_n1s_dsst= d_n1_dsst *b1 + n1 * d_b1_dsst + d_n1s_ds = n1 * d_b1_ds + + a1 = exp(z(7)*s + z(8)*s**2 + z(9)*s*sst) + d_a1_dsst = exp(z(7)*s + z(8)*s**2) *z(9)*s*exp(z(9)*s*sst) + d_a1_ds = (2*z(8)*s+z(7)+z(9)*sst) * exp(s*(z(8)*s+z(7)+z(9)*sst)) + + !e1s = e1*a1 + d_e1s_dsst = d_e1_dsst*a1 +e1* d_a1_dsst + d_e1s_ds = e1*d_a1_ds + + b2 = 1.0 + s*(z(10) + 0.5*z(11)*(sst + 30)) + d_b2_dsst = s*0.5*z(11) + d_b2_ds = z(10) + 0.5*z(11)*(sst + 30) + + !n2s = n2*b2 + d_n2s_dsst = d_n2_dsst *b2 +n2* d_b2_dsst + d_n2s_ds = n2*d_b2_ds + + a2 = 1.0 + s*(z(12) + z(13)*sst) + d_a2_dsst = s*z(13) + d_a2_ds = z(12) + z(13)*sst + + !e2s = e2*a2 + d_e2s_dsst = d_e2_dsst *a2 +e2*d_a2_dsst + d_e2s_ds = e2*d_a2_ds + +END SUBROUTINE DIELECTRIC_MEISSNER_WENTZ_K + +end module RSS_Emissivity_Model + + diff --git a/libsrc/SensorInfo_Define.f90 b/libsrc/SensorInfo_Define.f90 new file mode 100644 index 000000000..17f0874db --- /dev/null +++ b/libsrc/SensorInfo_Define.f90 @@ -0,0 +1,640 @@ +! +! SensorInfo_Define +! +! Module defining the SensorInfo data structure and containing routines to +! manipulate it. +! +! +! CREATION HISTORY: +! Written by: Paul van Delst, CIMSS/SSEC 09-Aug-2002 +! paul.vandelst@ssec.wisc.edu +! + +MODULE SensorInfo_Define + + ! ------------------ + ! Environment set up + ! ------------------ + ! Module use + USE Type_Kinds , ONLY: fp + USE Message_Handler , ONLY: SUCCESS, FAILURE, Display_Message + USE SensorInfo_Parameters, ONLY: INVALID_WMO_SATELLITE_ID, & + INVALID_WMO_SENSOR_ID , & + N_SENSOR_TYPES , & + INVALID_SENSOR , & + MICROWAVE_SENSOR , & + INFRARED_SENSOR , & + VISIBLE_SENSOR , & + ULTRAVIOLET_SENSOR , & + SENSOR_TYPE_NAME , & + N_POLARIZATION_TYPES , & + UNPOLARIZED + + ! Disable implicit typing + IMPLICIT NONE + + + ! ------------ + ! Visibilities + ! ------------ + ! Everything private by default + PRIVATE + ! Parameters (passed through from SensorInfo_Parameters) + PUBLIC :: UNPOLARIZED + PUBLIC :: N_SENSOR_TYPES + PUBLIC :: INVALID_SENSOR + PUBLIC :: MICROWAVE_SENSOR + PUBLIC :: INFRARED_SENSOR + PUBLIC :: VISIBLE_SENSOR + PUBLIC :: ULTRAVIOLET_SENSOR + PUBLIC :: SENSOR_TYPE_NAME + PUBLIC :: N_POLARIZATION_TYPES + ! The derived type definition + PUBLIC :: SensorInfo_type + ! Procedures + PUBLIC :: Associated_SensorInfo + PUBLIC :: Destroy_SensorInfo + PUBLIC :: Allocate_SensorInfo + PUBLIC :: Assign_SensorInfo + + + ! ------------------- + ! Procedure overloads + ! ------------------- + INTERFACE Destroy_SensorInfo + MODULE PROCEDURE Destroy_Scalar + MODULE PROCEDURE Destroy_Rank1 + END INTERFACE Destroy_SensorInfo + + + ! ----------------- + ! Module parameters + ! ----------------- + CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = & + ! Literal constants + REAL(fp), PARAMETER :: ZERO = 0.0_fp + ! Keyword set value + INTEGER, PARAMETER :: SET = 1 + ! String lengths + INTEGER, PARAMETER :: ML = 256 + INTEGER, PARAMETER :: SL = 20 + INTEGER, PARAMETER :: SL2 = 12 + ! Default values + INTEGER, PARAMETER :: INVALID = -1 + + + ! ------------------------------- + ! SensorInfo data type definition + ! ------------------------------- + TYPE :: SensorInfo_type + INTEGER :: n_Allocates = 0 + ! Dimensions + INTEGER :: n_Channels = 0 ! L + INTEGER :: n_FOVs = 0 ! I + ! Descriptors + CHARACTER(SL2) :: Sensor_Name = ' ' + CHARACTER(SL2) :: Satellite_Name = ' ' + ! Sensor Ids + CHARACTER(SL) :: Sensor_Id = ' ' + INTEGER :: WMO_Satellite_ID = INVALID_WMO_SATELLITE_ID + INTEGER :: WMO_Sensor_ID = INVALID_WMO_SENSOR_ID + ! Sensor type + INTEGER :: Sensor_Type = INVALID_SENSOR + ! The channel data + INTEGER , POINTER :: Sensor_Channel(:) => NULL() ! L + INTEGER , POINTER :: Use_Flag(:) => NULL() ! L + REAL(fp), POINTER :: Noise(:) => NULL() ! L + END TYPE SensorInfo_type + + +CONTAINS + + +!################################################################################ +!################################################################################ +!## ## +!## ## PUBLIC MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ + +!-------------------------------------------------------------------------------- +! +! NAME: +! Associated_SensorInfo +! +! PURPOSE: +! Function to test the association status of the pointer members of a +! SensorInfo structure. +! +! CALLING SEQUENCE: +! Association_Status = Associated_SensorInfo( SensorInfo , & ! Input +! ANY_Test=Any_Test ) ! Optional input +! +! INPUT ARGUMENTS: +! SensorInfo: SensorInfo structure which is to have its pointer +! member's association status tested. +! UNITS: N/A +! TYPE: SensorInfo_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUT ARGUMENTS: +! ANY_Test: Set this argument to test if ANY of the +! SensorInfo structure pointer members are associated. +! The default is to test if ALL the pointer members +! are associated. +! If ANY_Test = 0, test if ALL the pointer members +! are associated. (DEFAULT) +! ANY_Test = 1, test if ANY of the pointer members +! are associated. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! FUNCTION RESULT: +! Association_Status: The return value is a logical value indicating the +! association status of the SensorInfo pointer members. +! .TRUE. - if ALL the SensorInfo pointer members are +! associated, or if the ANY_Test argument +! is set and ANY of the SensorInfo pointer +! members are associated. +! .FALSE. - some or all of the SensorInfo pointer +! members are NOT associated. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! +!-------------------------------------------------------------------------------- + + FUNCTION Associated_SensorInfo( SensorInfo, & ! Input + ANY_Test ) & ! Optional input + RESULT( Association_Status ) + ! Arguments + TYPE(SensorInfo_type), INTENT(IN) :: SensorInfo + INTEGER, OPTIONAL, INTENT(IN) :: ANY_Test + ! Function result + LOGICAL :: Association_Status + ! Local variables + LOGICAL :: ALL_Test + + ! Default is to test ALL the pointer members + ! for a true association status.... + ALL_Test = .TRUE. + ! ...unless the ANY_Test argument is set. + IF ( PRESENT( ANY_Test ) ) THEN + IF ( ANY_Test == SET ) ALL_Test = .FALSE. + END IF + + ! Test the structure associations + Association_Status = .FALSE. + IF ( ALL_Test ) THEN + IF ( ASSOCIATED(SensorInfo%Sensor_Channel) .AND. & + ASSOCIATED(SensorInfo%Use_Flag ) .AND. & + ASSOCIATED(SensorInfo%Noise )) THEN + Association_Status = .TRUE. + END IF + ELSE + IF ( ASSOCIATED(SensorInfo%Sensor_Channel) .OR. & + ASSOCIATED(SensorInfo%Use_Flag ) .OR. & + ASSOCIATED(SensorInfo%Noise )) THEN + Association_Status = .TRUE. + END IF + END IF + + END FUNCTION Associated_SensorInfo + + +!------------------------------------------------------------------------------ +! +! NAME: +! Destroy_SensorInfo +! +! PURPOSE: +! Function to re-initialize the scalar and pointer members of SensorInfo +! data structures. +! +! CALLING SEQUENCE: +! Error_Status = Destroy_SensorInfo( SensorInfo ) +! +! OUTPUT ARGUMENTS: +! SensorInfo: Re-initialized SensorInfo structure. +! UNITS: N/A +! TYPE: SensorInfo_type +! DIMENSION: Scalar or Rank-1 +! ATTRIBUTES: INTENT(IN 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 structure re-initialisation was successful +! == FAILURE - an error occurred, or +! - the structure internal allocation counter +! is not equal to zero (0) upon exiting this +! function. This value is incremented and +! decremented for every structure allocation +! and deallocation respectively. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +! COMMENTS: +! Note the INTENT on the output SensorInfo argument is IN OUT rather than +! just OUT. This is necessary because the argument may be defined upon +! input. To prevent memory leaks, the IN OUT INTENT is a must. +! +!------------------------------------------------------------------------------ + + FUNCTION Destroy_Scalar( SensorInfo , & ! Output + No_Clear ) & ! Optional input + RESULT( Error_Status ) + ! Arguments + TYPE(SensorInfo_type) , INTENT(IN OUT) :: SensorInfo + INTEGER , OPTIONAL, INTENT(IN) :: No_Clear + ! Function result + INTEGER :: Error_Status + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Destroy_SensorInfo' + ! Local variables + CHARACTER(ML) :: Message + LOGICAL :: Clear + INTEGER :: Allocate_Status + + ! Set up + ! ------ + Error_Status = SUCCESS + + ! Reset the dimension indicators + SensorInfo%n_Channels = 0 + SensorInfo%n_FOVs = 0 + + ! Default is to clear scalar members... + Clear = .TRUE. + ! ....unless the No_Clear argument is set + IF ( PRESENT( No_Clear ) ) THEN + IF ( No_Clear == 1 ) Clear = .FALSE. + END IF + IF ( Clear ) CALL Clear_SensorInfo(SensorInfo) + + ! If ALL pointer members are NOT associated, do nothing + IF ( .NOT. Associated_SensorInfo(SensorInfo) ) RETURN + + + ! Deallocate the pointer members + ! ------------------------------ + DEALLOCATE( SensorInfo%Sensor_Channel, & + SensorInfo%Use_Flag , & + SensorInfo%Noise , & + STAT = Allocate_Status ) + IF ( Allocate_Status /= 0 ) THEN + WRITE( Message, '("Error deallocating SensorInfo. STAT = ",i0)') & + Allocate_Status + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + RETURN + END IF + + + ! Decrement and test allocation counter + ! ------------------------------------- + SensorInfo%n_Allocates = SensorInfo%n_Allocates - 1 + IF ( SensorInfo%n_Allocates /= 0 ) THEN + WRITE( Message, '("Allocation counter /= 0, Value = ",i0)') & + SensorInfo%n_Allocates + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + RETURN + END IF + + END FUNCTION Destroy_Scalar + + + FUNCTION Destroy_Rank1( SensorInfo , & ! Output + No_Clear ) & ! Optional input + RESULT( Error_Status ) + ! Arguments + TYPE(SensorInfo_type) , INTENT(IN OUT) :: SensorInfo(:) + INTEGER , OPTIONAL, INTENT(IN) :: No_Clear + ! Function result + INTEGER :: Error_Status + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Destroy_SensorInfo(rank1)' + ! Local variables + CHARACTER(ML) :: Message + INTEGER :: Scalar_Status + INTEGER :: n + + ! Set up + ! ------ + Error_Status = SUCCESS + + + ! Perform the reinitialisation + ! ---------------------------- + DO n = 1, SIZE(SensorInfo) + + ! Call the scalar function + Scalar_Status = Destroy_Scalar( SensorInfo(n), & + No_Clear = No_Clear ) + + ! Check the result, but do not halt so deallocation + ! continues even if an error is encountered. + IF ( Scalar_Status /= SUCCESS ) THEN + Error_Status = Scalar_Status + WRITE( Message,'("Error destroying SensorInfo structure array element ",i0)' ) n + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + END IF + END DO + + END FUNCTION Destroy_Rank1 + + +!------------------------------------------------------------------------------ +! +! NAME: +! Allocate_SensorInfo +! +! PURPOSE: +! Function to allocate the pointer members of the SensorInfo +! data structure. +! +! CALLING SEQUENCE: +! Error_Status = Allocate_SensorInfo( n_Channels, & ! Input +! SensorInfo ) ! Output +! +! +! INPUT ARGUMENTS: +! n_Channels: The number of channels in the SensorInfo structure. +! Must be > 0. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUT ARGUMENTS: +! SensorInfo: SensorInfo structure with allocated pointer members +! UNITS: N/A +! TYPE: SensorInfo_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN 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 structure pointer allocations were +! successful +! == FAILURE - an error occurred, or +! - the structure internal allocation counter +! is not equal to one (1) upon exiting this +! function. This value is incremented and +! decremented for every structure allocation +! and deallocation respectively. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +! COMMENTS: +! Note the INTENT on the output SensorInfo argument is IN OUT rather than +! just OUT. This is necessary because the argument may be defined upon +! input. To prevent memory leaks, the IN OUT INTENT is a must. +! +!------------------------------------------------------------------------------ + + FUNCTION Allocate_SensorInfo( n_Channels , & ! Input + SensorInfo ) & ! Output + RESULT( Error_Status ) + ! Arguments + INTEGER , INTENT(IN) :: n_Channels + TYPE(SensorInfo_type) , INTENT(IN OUT) :: SensorInfo + ! Function result + INTEGER :: Error_Status + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Allocate_SensorInfo' + ! Local variables + CHARACTER(ML) :: Message + INTEGER :: Allocate_Status + + ! Set up + ! ------ + Error_Status = SUCCESS + + ! Check dimensions + IF (n_Channels < 1) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Input SensorInfo dimensions must all be > 0.', & + Error_Status ) + RETURN + END IF + + ! Check if ANY pointers are already associated. + ! If they are, deallocate them but leave scalars. + IF ( Associated_SensorInfo( SensorInfo, ANY_Test=SET ) ) THEN + Error_Status = Destroy_SensorInfo( SensorInfo, & + No_Clear=SET ) + IF ( Error_Status /= SUCCESS ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error deallocating SensorInfo prior to allocation.', & + Error_Status ) + RETURN + END IF + END IF + + + ! Perform the pointer allocation + ! ------------------------------ + ALLOCATE( SensorInfo%Sensor_Channel( n_Channels ), & + SensorInfo%Use_Flag( n_Channels ), & + SensorInfo%Noise( n_Channels ), & + STAT=Allocate_Status ) + IF ( Allocate_Status /= 0 ) THEN + Error_Status = FAILURE + WRITE( Message,'("Error allocating SensorInfo data arrays. STAT = ",i0)' ) & + Allocate_Status + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + RETURN + END IF + + + ! Assign the dimensions + ! --------------------- + SensorInfo%n_Channels = n_Channels + + + ! Initialise the arrays + ! --------------------- + SensorInfo%Sensor_Channel = 0 + SensorInfo%Use_Flag = 0 + SensorInfo%Noise = ZERO + + + ! Increment and test the allocation counter + ! ----------------------------------------- + SensorInfo%n_Allocates = SensorInfo%n_Allocates + 1 + IF ( SensorInfo%n_Allocates /= 1 ) THEN + WRITE( Message, '("Allocation counter /= 1, Value = ",i0)') & + SensorInfo%n_Allocates + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + RETURN + END IF + + END FUNCTION Allocate_SensorInfo + + +!------------------------------------------------------------------------------ +! +! NAME: +! Assign_SensorInfo +! +! PURPOSE: +! Function to copy valid SensorInfo structures. +! +! CALLING SEQUENCE: +! Error_Status = Assign_SensorInfo( SensorInfo_in , & ! Input +! SensorInfo_out ) ! Output +! +! INPUT ARGUMENTS: +! SensorInfo_in: SensorInfo structure which is to be copied. +! UNITS: N/A +! TYPE: SensorInfo_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUT ARGUMENTS: +! SensorInfo_out: Copy of the input structure, SensorInfo_in. +! UNITS: N/A +! TYPE: SensorInfo_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN 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 structure assignment was successful +! == FAILURE an error occurred +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +! COMMENTS: +! Note the INTENT on the output SensorInfo argument is IN OUT rather than +! just OUT. This is necessary because the argument may be defined upon +! input. To prevent memory leaks, the IN OUT INTENT is a must. +! +!------------------------------------------------------------------------------ + + FUNCTION Assign_SensorInfo( SensorInfo_in , & ! Input + SensorInfo_out) & ! Output + RESULT( Error_Status ) + ! Arguments + TYPE(SensorInfo_type) , INTENT(IN) :: SensorInfo_in + TYPE(SensorInfo_type) , INTENT(IN OUT) :: SensorInfo_out + ! Function result + INTEGER :: Error_Status + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Assign_SensorInfo' + + ! Set up + ! ------ + Error_Status = SUCCESS + + ! ALL *input* pointers must be associated + IF ( .NOT. Associated_SensorInfo( SensorInfo_in ) ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Some or all INPUT SensorInfo_in pointer members are NOT associated.', & + Error_Status ) + RETURN + END IF + + + ! Allocate data arrays + ! -------------------- + Error_Status = Allocate_SensorInfo( SensorInfo_in%n_Channels, & + SensorInfo_out ) + IF ( Error_Status /= SUCCESS ) THEN + CALL Display_Message( ROUTINE_NAME, & + 'Error allocating output structure.', & + Error_Status ) + RETURN + END IF + + + ! Assign non-dimension scalar members + ! ----------------------------------- + SensorInfo_out%n_FOVs = SensorInfo_in%n_FOVs + SensorInfo_out%Sensor_Name = SensorInfo_in%Sensor_Name + SensorInfo_out%Satellite_Name = SensorInfo_in%Satellite_Name + SensorInfo_out%Sensor_Id = SensorInfo_in%Sensor_Id + SensorInfo_out%WMO_Satellite_Id = SensorInfo_in%WMO_Satellite_Id + SensorInfo_out%WMO_Sensor_Id = SensorInfo_in%WMO_Sensor_Id + SensorInfo_out%Sensor_Type = SensorInfo_in%Sensor_Type + + ! Copy array data + ! --------------- + SensorInfo_out%Sensor_Channel = SensorInfo_in%Sensor_Channel + SensorInfo_out%Use_Flag = SensorInfo_in%Use_Flag + SensorInfo_out%Noise = SensorInfo_in%Noise + + END FUNCTION Assign_SensorInfo + + +!################################################################################## +!################################################################################## +!## ## +!## ## PRIVATE MODULE ROUTINES ## ## +!## ## +!################################################################################## +!################################################################################## + +!---------------------------------------------------------------------------------- +! +! NAME: +! Clear_SensorInfo +! +! PURPOSE: +! Subroutine to clear the scalar members of a SensorInfo structure. +! +! CALLING SEQUENCE: +! CALL Clear_SensorInfo( SensorInfo) ! Output +! +! OUTPUT ARGUMENTS: +! SensorInfo: SensorInfo structure for which the scalar members have +! been cleared. +! UNITS: N/A +! TYPE: SensorInfo_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN OUT) +! +! COMMENTS: +! Note the INTENT on the output SensorInfo argument is IN OUT rather than +! just OUT. This is necessary because the argument may be defined (at least +! its components may be) upon input. To prevent memory leaks, the IN OUT +! INTENT is a must. +! +!---------------------------------------------------------------------------------- + + SUBROUTINE Clear_SensorInfo( SensorInfo ) + TYPE(SensorInfo_type), INTENT(IN OUT) :: SensorInfo + SensorInfo%Sensor_Name = ' ' + SensorInfo%Satellite_Name = ' ' + SensorInfo%Sensor_Id = ' ' + SensorInfo%WMO_Satellite_ID = INVALID_WMO_SATELLITE_ID + SensorInfo%WMO_Sensor_ID = INVALID_WMO_SENSOR_ID + SensorInfo%Sensor_Type = INVALID_SENSOR + END SUBROUTINE Clear_SensorInfo + +END MODULE SensorInfo_Define diff --git a/libsrc/SensorInfo_IO.f90 b/libsrc/SensorInfo_IO.f90 new file mode 100644 index 000000000..0e25715c6 --- /dev/null +++ b/libsrc/SensorInfo_IO.f90 @@ -0,0 +1,672 @@ +! +! SensorInfo_IO +! +! Module containing routines to read and write ASCII format SensorInfo +! data files. +! +! +! CREATION HISTORY: +! Written by: Paul van Delst, CIMSS/SSEC 09-Aug-2002 +! paul.vandelst@ssec.wisc.edu +! + +MODULE SensorInfo_IO + + ! ------------------ + ! Environment set up + ! ------------------ + ! Module use + USE File_Utility , ONLY: Get_Lun, File_Exists + USE Message_Handler , ONLY: SUCCESS, FAILURE, WARNING, INFORMATION, & + Display_Message + USE SensorInfo_Define , ONLY: SensorInfo_type, & + Allocate_SensorInfo, & + Destroy_SensorInfo + USE SensorInfo_LinkedList, ONLY: SensorInfo_List_type, & + New_SensorInfo_List, & + Destroy_SensorInfo_List, & + AddTo_SensorInfo_List, & + GetFrom_SensorInfo_List, & + Count_SensorInfo_Nodes + ! Disable implicit typing + IMPLICIT NONE + + + ! ------------ + ! Visibilities + ! ------------ + ! Everything private by default + PRIVATE + ! Parameters + PUBLIC :: SENSORINFO_FORMAT + PUBLIC :: CHANNELINFO_FORMAT + ! Module procedures + PUBLIC :: Read_SensorInfo + PUBLIC :: Write_SensorInfo + + + ! ----------------- + ! Module parameters + ! ----------------- + CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = & + ! Keyword set value + INTEGER, PARAMETER :: SET = 1 + ! Input data formats + CHARACTER(*), PARAMETER :: SENSORINFO_FORMAT = '(1x,2(1x,a12),1x,a20,1x,i1,6x,4(1x,i5))' + CHARACTER(*), PARAMETER :: CHANNELINFO_FORMAT = '(i5,3x,i2,5x,es13.6)' + + +CONTAINS + + +!################################################################################ +!################################################################################ +!## ## +!## ## PUBLIC MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ + +!------------------------------------------------------------------------------ +! +! NAME: +! Read_SensorInfo +! +! PURPOSE: +! Function to read ASCII format SensorInfo file data into a +! SensorInfo linked list. +! +! CALLING SEQUENCE: +! Error_Status = Read_SensorInfo( Filename, & ! Input +! SensorInfo_List, & ! Output +! Quiet =Quiet ) ! Optional input +! +! INPUT ARGUMENTS: +! Filename: Character string specifying the name of an ASCII +! format SensorInfo data file. +! UNITS: N/A +! TYPE: CHARACTER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUT ARGUMENTS: +! SensorInfo_List: Linked list containing the SensorInfo data. Each list +! node corresponds to a SensorInfo file entry. +! UNITS: N/A +! TYPE: SensorInfo_List_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN OUT) +! +! OPTIONAL INPUT ARGUMENTS: +! Quiet: Set this keyword 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 +! +! 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 SensorInfo data read was successful +! == FAILURE an unrecoverable error occurred +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +! COMMENTS: +! Note the INTENT on the output SensorInfo_List argument is IN OUT rather +! than just OUT. This is necessary because the argument may be defined on +! input. To prevent memory leaks, the IN OUT INTENT is a must. +! +!------------------------------------------------------------------------------ + + FUNCTION Read_SensorInfo( Filename, & ! Input + SensorInfo_List, & ! Output + Quiet ) & ! Optional input + RESULT( Error_Status ) + ! Arguments + CHARACTER(*) , INTENT(IN) :: Filename + TYPE(SensorInfo_List_type), INTENT(IN OUT) :: SensorInfo_List + INTEGER , OPTIONAL, INTENT(IN) :: Quiet + ! Function result + INTEGER :: Error_Status + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Read_SensorInfo' + ! Function variables + CHARACTER(256) :: Message + CHARACTER(256) :: Line_Buffer + LOGICAL :: Noisy + INTEGER :: IO_Status + INTEGER :: FileID + INTEGER :: l + INTEGER :: n_Sensors + TYPE(SensorInfo_type) :: SensorInfo, dummy + + + ! Set up + ! ------ + Error_Status = SUCCESS + + ! Does the file exist? + IF ( .NOT. File_Exists( TRIM(Filename) ) ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'File '//TRIM(Filename)//' not found.', & + Error_Status ) + RETURN + END IF + + ! Output informational messages.... + Noisy = .TRUE. + ! ....unless the QUIET keyword is set. + IF ( PRESENT(Quiet) ) THEN + IF ( Quiet == SET ) Noisy = .FALSE. + END IF + + + ! Create a new SensorInfo linked list + ! ----------------------------------- + Error_Status = Destroy_SensorInfo_List( SensorInfo_List, & + Quiet =Quiet ) + IF ( Error_Status /= SUCCESS ) THEN + CALL Display_Message( ROUTINE_NAME, & + 'Error destroying SensorInfo_List.', & + Error_Status ) + RETURN + END IF + SensorInfo_List = New_SensorInfo_List() + + + ! Open the SensorInfo file + ! ------------------------ + FileID = Get_Lun() + IF ( FileID < 0 ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error obtaining file unit number.', & + Error_Status ) + RETURN + END IF + OPEN( FileID, FILE = TRIM(ADJUSTL(Filename)), & + STATUS = 'OLD', & + ACCESS = 'SEQUENTIAL', & + FORM = 'FORMATTED', & + ACTION = 'READ', & + IOSTAT = IO_Status ) + IF ( IO_Status /= 0 ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error opening '//TRIM(Filename), & + Error_Status ) + RETURN + END IF + + + ! Loop over comment lines + ! ----------------------- + Comment_Read_loop: DO + + ! Read a line of the file + READ( FileID, FMT ='(a)', & + IOSTAT=IO_Status ) Line_Buffer + IF ( IO_Status /= 0 ) THEN + Error_Status = FAILURE + WRITE( Message,'("Error reading SensorInfo file in comment skip. IOSTAT = ",i5)' ) & + IO_Status + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + CLOSE( FileID ) + RETURN + END IF + + ! Exit loop if this is NOT a comment or blank line + IF ( Line_Buffer(1:1) /= '!' .AND. LEN_TRIM(Line_Buffer) /= 0 ) THEN + BACKSPACE( FileID ) + EXIT Comment_Read_loop + END IF + + END DO Comment_Read_loop + + + ! Initialise sensor counter + ! ------------------------- + n_Sensors = 0 + + + ! Begin open loop over sensors + ! ---------------------------- + SensorInfo_Read_loop: DO + + + ! Read a line of the file into a character buffer + ! ----------------------------------------------- + READ( FileID, FMT ='(a)', & + IOSTAT=IO_Status ) Line_Buffer + + ! End of file? + IF ( IO_Status < 0 ) EXIT SensorInfo_Read_Loop + + ! Read error + IF ( IO_Status > 0 ) THEN + Error_Status = FAILURE + WRITE( Message,'("Error reading SensorInfo file in sensor header read. ",& + &"Sensors already read = ",i0,". IOSTAT = ",i0)' ) & + n_Sensors, IO_Status + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + CLOSE( FileID ) + RETURN + END IF + + ! Cycle loop if this is a blank line + IF ( LEN_TRIM(Line_Buffer) == 0 ) CYCLE SensorInfo_Read_Loop + + + ! Increment sensor counter + ! ------------------------ + n_Sensors = n_Sensors + 1 + + + ! Read the SensorInfo data line into variables + ! -------------------------------------------- + READ( Line_Buffer, FMT =SENSORINFO_FORMAT, & + IOSTAT=IO_Status ) dummy%Sensor_Name, & + dummy%Satellite_Name, & + dummy%Sensor_Id, & + dummy%Sensor_Type, & + dummy%WMO_Sensor_ID, & + dummy%WMO_Satellite_ID, & + dummy%n_Channels, & + dummy%n_FOVs + + IF ( IO_Status /= 0 ) THEN + Error_Status = FAILURE + WRITE( Message,'("Error reading SensorInfo line buffer in sensor header read. ",& + &"Sensors already read = ",i0,". IOSTAT = ",i0)' ) & + n_Sensors, IO_Status + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + CLOSE( FileID ) + RETURN + END IF + + + ! Allocate the SensorInfo structure pointer components + ! ---------------------------------------------------- + Error_Status = Allocate_SensorInfo( dummy%n_Channels, & + SensorInfo ) + IF ( Error_Status /= SUCCESS ) THEN + CALL Display_Message( ROUTINE_NAME, & + 'Error allocating SensorInfo structure for '//& + TRIM(dummy%Sensor_Id), & + Error_Status ) + CLOSE( FileID ) + RETURN + END IF + + + ! Assign the non-dimensional SensorInfo data + SensorInfo%Sensor_Name = dummy%Sensor_Name + SensorInfo%Satellite_Name = dummy%Satellite_Name + SensorInfo%Sensor_Id = dummy%Sensor_Id + SensorInfo%Sensor_Type = dummy%Sensor_Type + SensorInfo%WMO_Sensor_ID = dummy%WMO_Sensor_ID + SensorInfo%WMO_Satellite_ID = dummy%WMO_Satellite_ID + SensorInfo%n_FOVs = dummy%n_FOVs + + + ! Output an info message + ! ---------------------- + IF ( Noisy ) THEN + WRITE( Message,'("SENSOR ID: ",a,", N_CHANNELS=",i0)' ) & + TRIM(SensorInfo%Sensor_Id), & + SensorInfo%n_Channels + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + INFORMATION ) + END IF + + + ! Read the channel information + ! ---------------------------- + ChannelInfo_Read_loop: DO l = 1, SensorInfo%n_Channels + + READ( FileID, FMT =CHANNELINFO_FORMAT, & + IOSTAT=IO_Status ) SensorInfo%Sensor_Channel(l), & + SensorInfo%Use_Flag(l), & + SensorInfo%Noise(l) + IF ( IO_Status /= 0 ) THEN + Error_Status = FAILURE + WRITE( Message,'("Error reading ChannelInfo data for ",a,& + &", channel # ",i0,". IOSTAT = ",i0)' ) & + TRIM(SensorInfo%Sensor_Id), & + l, IO_Status + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + CLOSE( FileID ) + RETURN + END IF + + END DO ChannelInfo_Read_loop + + + ! Add the current SensorInfo structure to the list + ! ------------------------------------------------ + Error_Status = AddTo_SensorInfo_List( SensorInfo, & + SensorInfo_List, & + Node_Number=n_Sensors ) + IF ( Error_Status /= SUCCESS ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error adding '//& + TRIM(SensorInfo%Sensor_Id)//' to SensorInfo list.', & + Error_Status ) + CLOSE( FileID ) + RETURN + END IF + + + ! Destroy the SensorInfo structure for the next read + ! -------------------------------------------------- + Error_Status = Destroy_SensorInfo( SensorInfo ) + IF ( Error_Status /= SUCCESS ) THEN + Error_Status = FAILURE + WRITE( Message,'("Error destroying SensorInfo structures at sensor # ",i0)' ) & + n_Sensors + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + CLOSE( FileID ) + RETURN + END IF + + END DO SensorInfo_Read_loop + + + ! Output an info message + ! ---------------------- + IF ( Noisy ) THEN + WRITE( Message,'("FILE: ",a,", N_SENSORS=",i0)' ) & + TRIM(Filename), n_Sensors + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + INFORMATION ) + END IF + + + ! Close the file + ! -------------- + CLOSE( FileID, STATUS='KEEP', & + IOSTAT=IO_Status ) + IF ( IO_Status /= 0 ) THEN + Error_Status = WARNING + WRITE( Message,'("Error closing ",a,". IOSTAT = ",i0)' ) & + TRIM(Filename), IO_Status + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + END IF + + END FUNCTION Read_SensorInfo + + +!------------------------------------------------------------------------------ +! +! NAME: +! Write_SensorInfo +! +! PURPOSE: +! Function to write the data within a SensorInfo linked list to an +! ASCII format SensorInfo file. +! +! CALLING SEQUENCE: +! Error_Status = Write_SensorInfo( Filename, & ! Input +! SensorInfo_List, & ! Input +! Quiet =Quiet ) ! Optional input +! +! INPUT ARGUMENTS: +! Filename: Character string specifying the name of an output +! SensorInfo data file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! SensorInfo_List: Linked list containing the SensorInfo data to write. +! Each list node corresponds to a SensorInfo file entry. +! UNITS: N/A +! TYPE: SensorInfo_List_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT) +! +! OPTIONAL INPUT ARGUMENTS: +! Quiet: Set this keyword 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 +! +! 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 SensorInfo data 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 in this routine, the output file is deleted +! before returning to the calling routine. +! +! RESTRICTIONS: +! This function checks the association status of the SensorInfo linked +! list nodes. Therefore, this function should *only* be called +! *after* the SensorInfo linked list has been filled with data. +! +!------------------------------------------------------------------------------ + + FUNCTION Write_SensorInfo( Filename, & ! Input + SensorInfo_List, & ! Input + Quiet ) & ! Optional input + RESULT( Error_Status ) + ! Arguments + CHARACTER(*) , INTENT(IN) :: Filename + TYPE(SensorInfo_List_type), INTENT(IN) :: SensorInfo_List + INTEGER , OPTIONAL, INTENT(IN) :: Quiet + ! Function result + INTEGER :: Error_Status + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Write_SensorInfo' + ! Function variables + CHARACTER(256) :: Message + LOGICAL :: Noisy + INTEGER :: IO_Status + INTEGER :: FileID + INTEGER :: l + INTEGER :: n_Sensors, n + TYPE(SensorInfo_type) :: SensorInfo + + ! Set up + ! ------ + Error_Status = SUCCESS + + ! Does the file exist? + IF ( File_Exists( TRIM(Filename) ) ) THEN + CALL Display_Message( ROUTINE_NAME, & + 'File '//TRIM(Filename)//' will be overwritten.', & + WARNING ) + END IF + + ! Output informational Messages.... + Noisy = .TRUE. + ! ....unless the QUIET keyword is set. + IF ( PRESENT( Quiet ) ) THEN + IF ( Quiet == SET ) Noisy = .FALSE. + END IF + + + ! Create the SensorInfo file + ! -------------------------- + FileID = Get_Lun() + IF ( FileID < 0 ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error obtaining file unit number.', & + Error_Status ) + RETURN + END IF + OPEN( FileID, FILE = Filename, & + STATUS = 'REPLACE', & + ACCESS = 'SEQUENTIAL', & + FORM = 'FORMATTED', & + ACTION = 'WRITE', & + IOSTAT = IO_Status ) + IF ( IO_Status /= 0 ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error opening '//TRIM(Filename), & + Error_Status ) + RETURN + END IF + + + ! Determine the number of sensors in the list + ! ------------------------------------------- + n_Sensors = Count_SensorInfo_Nodes( SensorInfo_List ) + IF ( n_Sensors < 1 ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'SensorInfo list is empty', & + Error_Status ) + CLOSE( FileID, STATUS='DELETE' ) + RETURN + END IF + + + ! Loop over the number of sensors + ! ------------------------------- + SensorInfo_Write_loop: DO n = 1, n_Sensors + + ! Get the current sensor data from the list + Error_Status = GetFrom_SensorInfo_List( SensorInfo_List, & + n, & + SensorInfo ) + IF ( Error_Status /= SUCCESS ) THEN + Error_Status = FAILURE + WRITE( Message,'("Error retrieving SensorInfo data for sensor # ",i0)' ) n + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + CLOSE( FileID, STATUS='DELETE' ) + RETURN + END IF + + ! Write the SensorInfo data + WRITE( FileID, FMT =SENSORINFO_FORMAT, & + IOSTAT=IO_Status ) SensorInfo%Sensor_Name, & + SensorInfo%Satellite_Name, & + SensorInfo%Sensor_Id, & + SensorInfo%Sensor_Type, & + SensorInfo%WMO_Sensor_ID, & + SensorInfo%WMO_Satellite_ID, & + SensorInfo%n_Channels, & + SensorInfo%n_FOVs + IF ( IO_Status /= 0 ) THEN + Error_Status = FAILURE + WRITE( Message,'("Error writing SensorInfo data for sensor # ",i0,& + &". IOSTAT = ",i0)' ) n, IO_Status + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + CLOSE( FileID, STATUS='DELETE' ) + RETURN + END IF + + + ! Output an info message + IF ( Noisy ) THEN + WRITE( Message,'("SENSOR ID: ",a,", N_CHANNELS=",i0)' ) & + TRIM(SensorInfo%Sensor_Id), SensorInfo%n_Channels + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + INFORMATION ) + END IF + + ! Write the ChannelInfo data + ChannelInfo_Write_loop: DO l = 1, SensorInfo%n_Channels + WRITE( FileID, FMT =CHANNELINFO_FORMAT, & + IOSTAT=IO_Status ) SensorInfo%Sensor_Channel(l), & + SensorInfo%Use_Flag(l), & + SensorInfo%Noise(l) + IF ( IO_Status /= 0 ) THEN + Error_Status = FAILURE + WRITE( Message,'("Error writing ChannelInfo data for ", a, & + &", channel # ",i0,". IOSTAT = ",i0)' ) & + TRIM(SensorInfo%Sensor_Id), l, IO_Status + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + CLOSE( FileID, STATUS='DELETE' ) + RETURN + END IF + END DO ChannelInfo_Write_loop + + ! Destroy the SensorInfo structure for the next node + Error_Status = Destroy_SensorInfo( SensorInfo ) + IF ( Error_Status /= SUCCESS ) THEN + Error_Status = FAILURE + WRITE( Message,'("Error destroying SensorInfo structure at sensor # ",i0)' ) & + n_Sensors + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + CLOSE( FileID, STATUS='DELETE' ) + RETURN + END IF + + END DO SensorInfo_Write_loop + + + ! Output an info message + ! ---------------------- + IF ( Noisy ) THEN + WRITE( Message,'("FILE: ",a,", N_SENSORS=",i0)' ) & + TRIM(Filename), n_Sensors + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + INFORMATION ) + END IF + + + ! Close the file + ! -------------- + CLOSE( FileID, STATUS='KEEP', & + IOSTAT=IO_Status ) + IF ( IO_Status /= 0 ) THEN + Error_Status = WARNING + WRITE( Message,'("Error closing ",a,". IOSTAT = ",i0)' ) & + TRIM(Filename), IO_Status + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + END IF + + END FUNCTION Write_SensorInfo + +END MODULE SensorInfo_IO diff --git a/libsrc/SensorInfo_LinkedList.f90 b/libsrc/SensorInfo_LinkedList.f90 new file mode 100644 index 000000000..49d9aaf71 --- /dev/null +++ b/libsrc/SensorInfo_LinkedList.f90 @@ -0,0 +1,1178 @@ +! +! SensorInfo_LinkedList +! +! Module containing type definitions for a SensorInfo linked list +! and routines to manipulate it. +! +! +! CREATION HISTORY: +! Written by: Paul van Delst, CIMSS/SSEC 15-Apr-2003 +! paul.vandelst@ssec.wisc.edu +! + +MODULE SensorInfo_LinkedList + + ! ------------------ + ! Environment set up + ! ------------------ + ! Module use + USE Message_Handler , ONLY: SUCCESS, FAILURE, WARNING, INFORMATION, & + Display_Message + USE SensorInfo_Define, ONLY: SensorInfo_type, & + Destroy_SensorInfo, & + Assign_SensorInfo + ! Disable all implicit typing + IMPLICIT NONE + + + ! ------------ + ! Visibilities + ! ------------ + PRIVATE + ! Data type + PUBLIC :: SensorInfo_List_type + ! Methods + PUBLIC :: New_SensorInfo_List + PUBLIC :: Destroy_SensorInfo_List + PUBLIC :: AddTo_SensorInfo_List + PUBLIC :: GetFrom_SensorInfo_List + PUBLIC :: Count_SensorInfo_Nodes + + + ! ----------------- + ! Module parameters + ! ----------------- + CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = & + ! Keyword set value + INTEGER, PARAMETER :: SET = 1 + ! Message string length + INTEGER, PARAMETER :: ML = 256 + + + ! --------- + ! Overloads + ! --------- + INTERFACE GetFrom_SensorInfo_List + MODULE PROCEDURE GetFrom_by_Node_Number + MODULE PROCEDURE GetFrom_by_Sensor_Id + END INTERFACE GetFrom_SensorInfo_List + + + ! ------------------------ + ! Derived type definitions + ! ------------------------ + ! Node definition + TYPE :: SensorInfo_Node_type + TYPE(SensorInfo_type) :: SensorInfo ! Node data + TYPE(SensorInfo_Node_type), POINTER :: Previous => NULL() ! Pointer to previous node + TYPE(SensorInfo_Node_type), POINTER :: Next => NULL() ! Pointer to next node + END TYPE SensorInfo_Node_type + + ! Linked list definition + TYPE :: SensorInfo_List_type + PRIVATE + INTEGER :: n_Nodes = 0 ! The number of SensorInfo nodes + TYPE(SensorInfo_Node_type), POINTER :: First => NULL() ! Pointer to the first node + END TYPE SensorInfo_List_type + + +CONTAINS + + +!################################################################################## +!################################################################################## +!## ## +!## ## PRIVATE MODULE ROUTINES ## ## +!## ## +!################################################################################## +!################################################################################## + +!------------------------------------------------------------------------------ +! +! NAME: +! List_Is_Empty +! +! PURPOSE: +! Function to determine if a SensorInfo linked list is empty. +! +! CALLING SEQUENCE: +! Empty_Status = List_Is_Empty( SensorInfo_List ) ! Input +! +! INPUT ARGUMENTS: +! SensorInfo_List: The SensorInfo linked list. +! UNITS: N/A +! TYPE: SensorInfo_List_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! FUNCTION RESULT: +! Empty_Status: The return value is a logical value indicating the +! status of the SensorInfo linked list. +! .TRUE. - the list is empty with no valid nodes. +! .FALSE. - the list is not empty and contains valid +! nodes. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! +! RESTRICTIONS: +! This function checks the association status of various components +! of the linked list. Thus this function should only be called after +! a list has at least been initialised. +! +!------------------------------------------------------------------------------ + + FUNCTION List_Is_Empty( SensorInfo_List ) RESULT( Boolean ) + ! Arguments + TYPE(SensorInfo_List_type), INTENT(IN) :: SensorInfo_List + ! Function result + LOGICAL :: Boolean + + ! Is there a valid first node? + Boolean = .NOT. ASSOCIATED(SensorInfo_List%First%Next) + + END FUNCTION List_Is_Empty + + +!------------------------------------------------------------------------------ +! +! NAME: +! Get_Node_Pointer +! +! PURPOSE: +! Subroutine to traverse a SensorInfo linked list to a specified +! node and return a pointer to that node. +! +! CALLING SEQUENCE: +! CALL Get_Node_Pointer( SensorInfo_List, & ! Input +! Node_Numnber, & ! Input +! Node_Pointer ) ! Output +! +! INPUT ARGUMENTS: +! SensorInfo_List: The SensorInfo linked list. +! UNITS: N/A +! TYPE: SensorInfo_List_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Node_Number: The SensorInfo_List node for which a pointer +! is required. +! UNITS: None +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUT ARGUMENTS: +! Node_Pointer: The pointer to the requested SensorInfo node +! in the linked list. The dummy argument is not +! nullified so the actual argument should be +! nullified BEFORE calling this routine. +! * Note that pointer dummy arguments cannot have +! an INTENT attribute. However, the programmer's +! intent of this argument is for OUTPUT. +! UNITS: N/A +! TYPE: SensorInfo_Node_type +! DIMENSION: Scalar +! ATTRIBUTES: POINTER +! +! RESTRICTIONS: +! This function checks the association status of various components +! of the linked list. Thus this function should only be called after +! a list has at least been initialised. +! +!------------------------------------------------------------------------------ + + SUBROUTINE Get_Node_Pointer( SensorInfo_List, & + Node_Number, & + Node_Pointer ) + ! Arguments + TYPE(SensorInfo_List_type), INTENT(IN) :: SensorInfo_List + INTEGER , INTENT(IN) :: Node_Number + TYPE(SensorInfo_Node_type), POINTER :: Node_Pointer ! INTENT(OUT) + ! Local variables + TYPE(SensorInfo_Node_type), POINTER :: Current + INTEGER :: n_Nodes + + + ! Set up + ! ------ + NULLIFY( Current ) + + ! Initialise node counter + n_Nodes = 0 + + ! Check input + IF ( Node_Number < 1 ) RETURN + IF ( Node_Number > SensorInfo_List%n_Nodes ) RETURN + IF ( List_Is_Empty( SensorInfo_List ) ) RETURN + + + ! Initialise pointer to first node + ! -------------------------------- + Current => SensorInfo_List%First%Next + + + ! Traverse list + ! ------------- + List_Loop: DO + + ! At end of list before required node + IF ( .NOT. ASSOCIATED( Current ) ) THEN + RETURN + END IF + + ! Increment node counter + n_Nodes = n_Nodes + 1 + + ! Is the current node the one required? + IF ( n_Nodes == Node_Number ) THEN + EXIT List_Loop + END IF + + ! Go to next node + Current => Current%Next + + END DO List_Loop + + + ! Point return argument to requested node + ! --------------------------------------- + Node_Pointer => Current + + END SUBROUTINE Get_Node_Pointer + + +!################################################################################ +!################################################################################ +!## ## +!## ## PUBLIC MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ + +!------------------------------------------------------------------------------ +! +! NAME: +! New_SensorInfo_List +! +! PURPOSE: +! Function to return an initialised SensorInfo linked list. +! +! CALLING SEQUENCE: +! SensorInfo_List = New_SensorInfo_List() +! +! FUNCTION RESULT: +! SensorInfo_List: The initialised (but empty) SensorInfo linked list. +! UNITS: N/A +! TYPE: SensorInfo_List_type +! DIMENSION: Scalar +! +!------------------------------------------------------------------------------ + + FUNCTION New_SensorInfo_List() RESULT( SensorInfo_List ) + ! Function result + TYPE(SensorInfo_List_type) :: SensorInfo_List + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'New_SensorInfo_List' + ! Local variables + CHARACTER(ML) :: Message + INTEGER :: Allocate_Status + + + ! Set up + ! ...Set the number of sensors(nodes) to zero + SensorInfo_List%n_Nodes = 0 + ! ...Nullify the First pointer...just in case + NULLIFY( SensorInfo_List%First ) + + + ! Allocate space for the first node + ! --------------------------------- + ALLOCATE( SensorInfo_List%First, STAT = Allocate_Status ) + IF ( Allocate_Status /= 0 ) THEN + WRITE( Message,'("Error allocating SensorInfo_List First ", & + &"member. STAT = ",i0)' ) & + Allocate_Status + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + FAILURE ) + RETURN + END IF + + + ! Nullify the node pointers + ! ------------------------- + NULLIFY( SensorInfo_List%First%Previous, & + SensorInfo_List%First%Next ) + + END FUNCTION New_SensorInfo_List + + +!------------------------------------------------------------------------------ +! +! NAME: +! Destroy_SensorInfo_List +! +! PURPOSE: +! Function to destroy a SensorInfo linked list. +! +! CALLING SEQUENCE: +! Error_status = Destroy_SensorInfo_List( SensorInfo_List, & ! Output +! Quiet=Quie ) ! Optional input +! +! +! OUTPUT ARGUMENTS: +! SensorInfo_List: The destroyed SensorInfo linked list. +! UNITS: N/A +! TYPE: SensorInfo_List_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN OUT) +! +! OPTIONAL INPUT ARGUMENTS: +! Quiet: Set this keyword 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: None +! TYPE: INTEGER +! 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 list destruction was successful, +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +! COMMENTS: +! Note the INTENT on the output SensorInfo_List argument is IN OUT rather +! than just OUT. This is necessary because the argument may be defined +! (at least its components may be) upon input. To prevent memory leaks, +! the IN OUT INTENT is a must. +! +!------------------------------------------------------------------------------ + + FUNCTION Destroy_SensorInfo_List( SensorInfo_List, & ! Output + Quiet ) & ! Optional input + RESULT( Error_Status ) + ! Arguments + TYPE(SensorInfo_List_type), INTENT(IN OUT) :: SensorInfo_List + INTEGER , OPTIONAL, INTENT(IN) :: Quiet + ! Function result + INTEGER :: Error_Status + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Destroy_SensorInfo_List' + ! Local variables + CHARACTER(ML) :: Message + LOGICAL :: Noisy + INTEGER :: Allocate_Status + INTEGER :: n_Nodes + TYPE(SensorInfo_Node_type), POINTER :: Current + + ! Set up + ! ------ + Error_Status = SUCCESS + + ! Output informational messages.... + Noisy = .TRUE. + ! ....unless the QUIET keyword is set. + IF ( PRESENT( Quiet ) ) THEN + IF ( Quiet == SET ) Noisy = .FALSE. + END IF + + ! Check the list header + IF ( .NOT. ASSOCIATED( SensorInfo_List%First ) ) RETURN + + + ! Initialise the node counter + ! --------------------------- + n_Nodes = 0 + + + ! Traverse the list + ! ----------------- + Traverse_List_Loop: DO + + + ! Get the pointer to the current node + ! + ! ---------- + ! First => |X| Hdr |N| + ! ---------- + ! /|\ | + ! | | + ! | \|/ + ! ---------- + ! |P| Data |N| <= Current + ! ---------- + ! /|\ | + ! | | + ! | \|/ + ! ---------- + ! |P| Data |N| + ! ---------- + ! /|\ | + ! | | + ! | \|/ + ! ---------- + ! |P| Data |X| + ! ---------- + ! + ! X == NULL pointer + ! N == NEXT pointer + ! P == PREVIOUS pointer + Current => SensorInfo_List%First%Next + + ! If the pointer is not associated, then + ! there are no more nodes in the list. + IF ( .NOT. ASSOCIATED(Current) ) EXIT Traverse_List_Loop + + ! Increment the node counter + n_Nodes = n_Nodes + 1 + + ! Make previous node's NEXT pointer (N) point to + ! the node AFTER the current one, i.e. break the + ! forward link. + ! + ! ---------- + ! First => |X| Hdr |N| + ! ---------- + ! /|\ | + ! | -------------- + ! | | + ! ---------- | + ! |P| Data |N| <= Current | + ! ---------- | + ! /|\ | | + ! | | | + ! | \|/ | + ! ---------- | + ! |P| Data |N| <----------- + ! ---------- + ! /|\ | + ! | | + ! | \|/ + ! ---------- + ! |P| Data |X| + ! ---------- + ! + ! X == NULL pointer + ! N == NEXT pointer + ! P == PREVIOUS pointer + Current%Previous%Next => Current%Next + + ! If we are not at the end of the list, make the + ! next node's PREVIOUS pointer (P) point to the + ! node BEFORE the current one, i.e. break the + ! backward link. + ! + ! ---------- + ! First => --> |X| Hdr |N| + ! | ---------- + ! | /|\ | + ! | | -------------- + ! | | | + ! | ---------- | + ! | |P| Data |N| <= Current | + ! | ---------- | + ! | | | + ! ----- | | + ! | \|/ | + ! ---------- | + ! |P| Data |N| <----------- + ! ---------- + ! /|\ | + ! | | + ! | \|/ + ! ---------- + ! |P| Data |X| + ! ---------- + ! + ! X == NULL pointer + ! N == NEXT pointer + ! P == PREVIOUS pointer + IF ( ASSOCIATED( Current%Next ) ) Current%Next%Previous => Current%Previous + + ! Nullify the pointers for the current node + ! + ! ---------- + ! First => --> |X| Hdr |N| + ! | ---------- + ! | | + ! | -------------- + ! | | + ! | ---------- | + ! | |X| Data |X| <= Current | + ! | ---------- | + ! | | + ! ----- | + ! | | + ! ---------- | + ! |P| Data |N| <----------- + ! ---------- + ! /|\ | + ! | | + ! | \|/ + ! ---------- + ! |P| Data |X| + ! ---------- + ! + ! X == NULL pointer + ! N == NEXT pointer + ! P == PREVIOUS pointer + NULLIFY( Current%Previous, & + Current%Next ) + + ! Destroy the current node's SensorInfo object + ! + ! ---------- + ! First => --> |X| Hdr |N| + ! | ---------- + ! | | + ! | -------------- + ! | | + ! | ---------- | + ! | |X| |X| <= Current | + ! | ---------- | + ! | | + ! ----- | + ! | | + ! ---------- | + ! |P| Data |N| <----------- + ! ---------- + ! /|\ | + ! | | + ! | \|/ + ! ---------- + ! |P| Data |X| + ! ---------- + ! + ! X == NULL pointer + ! N == NEXT pointer + ! P == PREVIOUS pointer + Error_Status = Destroy_SensorInfo( Current%SensorInfo ) + IF ( Error_Status /= SUCCESS ) THEN + WRITE( Message,'("Error destroying SensorInfo object at node # ",i0)' ) & + n_Nodes + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + END IF + + ! Deallocate the current node + ! + ! ---------- + ! First => |X| Hdr |N| + ! ---------- + ! /|\ | + ! | | + ! | | + ! | | + ! | | X <= Current + ! | | + ! | | + ! | | + ! | \|/ + ! ---------- + ! |P| Data |N| + ! ---------- + ! /|\ | + ! | | + ! | \|/ + ! ---------- + ! |P| Data |X| + ! ---------- + ! + ! X == NULL pointer + ! N == NEXT pointer + ! P == PREVIOUS pointer + DEALLOCATE( Current, STAT=Allocate_Status ) + IF ( Allocate_Status /= 0 ) THEN + Error_Status = FAILURE + WRITE( Message,'("Error deallocating Current node # ",i0,". STAT = ",i0)' ) & + n_Nodes, Allocate_Status + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + END IF + + END DO Traverse_List_Loop + + + ! Deallocate the pointer to the list header + ! + ! First => X + ! + ! X == NULL pointer + ! ----------------------------------------- + DEALLOCATE( SensorInfo_List%First, STAT=Allocate_Status ) + IF ( Allocate_Status /= 0 ) THEN + Error_Status = FAILURE + WRITE( Message,'("Error deallocating list header. STAT = ",i0)' ) & + Allocate_Status + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + END IF + + + ! Set the node count to zero + ! -------------------------- + SensorInfo_List%n_Nodes = 0 + + + ! Output an info message + ! ---------------------- + IF ( Noisy ) THEN + WRITE( Message,'("Number of nodes deallocated: ",i0)' ) n_Nodes + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + INFORMATION ) + END IF + + END FUNCTION Destroy_SensorInfo_List + + +!------------------------------------------------------------------------------ +! +! NAME: +! AddTo_SensorInfo_List +! +! PURPOSE: +! Function to ADD a SensorInfo node TO a SensorInfo linked list. +! +! CALLING SEQUENCE: +! Error_Status = AddTo_SensorInfo_List( SensorInfo, & ! Input +! SensorInfo_List, & ! In/Output +! Node_Number = Node_Number ) ! Optional input +! +! INPUT ARGUMENTS: +! SensorInfo: SensorInfo structure to be added to the linked list. +! UNITS: N/A +! TYPE: SensorInfo_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUT ARGUMENTS: +! SensorInfo_List: SensorInfo linked list to which the new SensorInfo +! node was added. +! UNITS: N/A +! TYPE: SensorInfo_List_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN OUT) +! +! OPTIONAL INPUT ARGUMENTS: +! Node_Number: Set this argument to the position in the linked list +! that the new node will have. If not specified, the +! default action is to add the node at the END of the +! list. +! UNITS: None +! TYPE: INTEGER +! 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 list addition was successful, +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +! COMMENTS: +! Note the INTENT on the output SensorInfo_List argument is IN OUT rather +! than just OUT. This is necessary because the argument is defined on +! input. To prevent memory leaks, the IN OUT INTENT is a must. +! +!------------------------------------------------------------------------------ + + FUNCTION AddTo_SensorInfo_List( SensorInfo, & ! Input + SensorInfo_List, & ! In/Output + Node_Number ) & ! Optional input + RESULT ( Error_Status ) + ! Arguments + TYPE(SensorInfo_type) , INTENT(IN) :: SensorInfo + TYPE(SensorInfo_List_type), INTENT(IN OUT) :: SensorInfo_List + INTEGER , OPTIONAL, INTENT(IN) :: Node_Number + ! Function result + INTEGER :: Error_Status + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'AddTo_SensorInfo_List' + ! Local variables + CHARACTER(ML) :: Message + LOGICAL :: Insert_Node + INTEGER :: Allocate_Status + INTEGER :: n_Nodes + TYPE(SensorInfo_Node_type), POINTER :: Previous + TYPE(SensorInfo_Node_type), POINTER :: Current + + ! Set up + ! ------ + Error_Status = SUCCESS + + ! Nullify local pointers + NULLIFY( Previous, Current ) + + ! Check the list header + IF ( .NOT. ASSOCIATED( SensorInfo_List%First ) ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Input SensorInfo_List has not been initialised.', & + Error_Status ) + RETURN + END IF + + ! Default is to add the node at the end of the list... + Insert_Node = .FALSE. + ! ...unless a valid node number is specified. + IF ( PRESENT(Node_Number) ) THEN + IF ( Node_Number > 0 ) THEN + Insert_Node = .TRUE. + ELSE + CALL Display_Message( ROUTINE_NAME, & + 'Invalid node number specified. Adding new node to end of list.', & + WARNING ) + END IF + END IF + + + ! Initialise node counter + ! ----------------------- + n_Nodes = 0 + + + ! Initialise the node pointers to the start + ! of the list. + ! + ! ---------- + ! Previous => |X| Hdr |N| + ! ---------- + ! /|\ | + ! | | + ! | \|/ + ! ---------- + ! |P| Data |N| <= Current + ! ---------- + ! /|\ | + ! | \|/ + ! ... ... + ! + ! X == NULL pointer + ! N == NEXT pointer + ! P == PREVIOUS pointer + ! ----------------------------------------- + Previous => SensorInfo_List%First + Current => Previous%Next + + + ! Traverse the list to the end + ! ---------------------------- + Traverse_List_Loop: DO + + ! If the current node pointer is unassociated + ! we're at the end of the list...or we're at + ! the beginning and the list is empty. + ! + ! .... .... + ! /|\ | + ! | \|/ + ! ---------- + ! Previous => |P| Hdr |X| + ! ---------- + ! + ! X <= Current + ! + ! X == NULL pointer + ! N == NEXT pointer + ! P == PREVIOUS pointer + IF ( .NOT. ASSOCIATED(Current) ) EXIT Traverse_List_Loop + + ! If a valid node number was passed, then exit + ! the traversal loop if we're at the node before + ! which the insertion is to be performed + ! + ! .... .... + ! /|\ | + ! | \|/ + ! ---------- + ! Previous => |P| Hdr |N| + ! ---------- + ! /|\ | New node + ! | | <---- will slot + ! | \|/ in here + ! ---------- + ! |P| Data |N| <= Current + ! ---------- + ! /|\ | + ! | \|/ + ! ... ... + ! + ! X == NULL pointer + ! N == NEXT pointer + ! P == PREVIOUS pointer + IF ( Insert_Node ) THEN + IF ( n_Nodes == ( Node_Number - 1 ) ) EXIT Traverse_List_Loop + END IF + + ! We're not at the end of the list, so + ! move past the current node + Previous => Current + Current => Current%Next + + ! Increment node counter + n_Nodes = n_Nodes + 1 + + END DO Traverse_List_Loop + + + ! Allocate and fill the new node + ! ------------------------------ + ! First simply allocate the pointer. Note that + ! now, Previous%Next points to the NEW NODE, + ! *not* the CURRENT NODE. + ALLOCATE( Previous%Next, STAT=Allocate_Status ) + IF ( Allocate_Status /= 0 ) THEN + Error_Status = FAILURE + WRITE( Message,'("Error allocating new SensorInfo_List node member. ",& + &"STAT = ",i0)' ) & + Allocate_Status + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + RETURN + END IF + + ! Copy over the SensorInfo structure to the new node + Error_Status = Assign_SensorInfo( SensorInfo, & + Previous%Next%SensorInfo ) + IF ( Error_Status /= SUCCESS ) THEN + CALL Display_Message( ROUTINE_NAME, & + 'Error copying SensorInfo structure into new list node.', & + Error_Status ) + RETURN + END IF + + + ! Insert the new node pointers into the list + ! ------------------------------------------ + ! Are we at the end of the list? + IF ( .NOT. ASSOCIATED( Current ) ) THEN + + !!! YES. The new node is added to the end of the list !!! + !!! ----------------------------------------------------- + + ! Mark the end of the list + NULLIFY( Previous%Next%Next ) + + ! Make the new node PREVIOUS node pointer + ! point to the previous node. + Previous%Next%Previous => Previous + + ELSE + + !!! NO. The new node is slotted between the Previous and Current nodes !!! + !!! ---------------------------------------------------------------------- + + ! Make the new node NEXT pointer + ! point to the Current node + Previous%Next%Next => Current + + ! Make the new node PREVIOUS pointer + ! point to the Previous node + Previous%Next%Previous => Previous + + ! Make the Current node PREVIOUS pointer + ! point to the new node + Current%Previous => Previous%Next + + END IF + + + ! Increment the list total node counter + ! ------------------------------------- + SensorInfo_List%n_Nodes = SensorInfo_List%n_Nodes + 1 + + END FUNCTION AddTo_SensorInfo_List + + +!------------------------------------------------------------------------------ +! +! NAME: +! GetFrom_SensorInfo_List +! +! PURPOSE: +! Function to GET a SensorInfo node FROM a SensorInfo linked list. +! +! CALLING SEQUENCE: +! Error_Status = GetFrom_SensorInfo_List( SensorInfo_List,& ! Input +! Node_Number, & ! Input +! SensorInfo, ) ! Output +! +! INPUT ARGUMENTS: +! SensorInfo_List: SensorInfo linked list from which the SensorInfo +! node is to be retrieved. +! UNITS: N/A +! TYPE: SensorInfo_List_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! Node_Number: The SensorInfo_List node number to retrieve. +! UNITS: None +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUT ARGUMENTS: +! SensorInfo: SensorInfo structure retrieved from the linked list. +! UNITS: N/A +! TYPE: SensorInfo_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN 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 SensorInfo node retrieval was successful, +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +! COMMENTS: +! Note the INTENT on the output SensorInfo argument is IN OUT rather than +! just OUT. This is necessary because the argument may be defined (at least +! its components may be) upon input. To prevent memory leaks, the IN OUT +! INTENT is a must. +! +!------------------------------------------------------------------------------ + + FUNCTION GetFrom_by_Node_Number( & + SensorInfo_List, & ! Input + Node_Number , & ! Input + SensorInfo ) & ! Output + RESULT( Error_Status ) + ! Arguments + TYPE(SensorInfo_List_type), INTENT(IN) :: SensorInfo_List + INTEGER , INTENT(IN) :: Node_Number + TYPE(SensorInfo_type) , INTENT(IN OUT) :: SensorInfo + ! Function result + INTEGER :: Error_Status + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'GetFrom_SensorInfo_List(Node_Number)' + ! Local variables + CHARACTER(ML) :: Message + TYPE(SensorInfo_Node_type), POINTER :: Node_Pointer + + + ! Set up + Error_Status = SUCCESS + ! ...Nullify local pointers + Node_Pointer => NULL() + ! ...Check node number + IF ( Node_Number < 1 .OR. & + Node_Number > SensorInfo_List%n_Nodes ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Invalid node number specified.', & + Error_Status ) + RETURN + END IF + + + ! Traverse list to the required node + ! ---------------------------------- + CALL Get_Node_Pointer( SensorInfo_List, & + Node_Number, & + Node_Pointer ) + IF ( .NOT. ASSOCIATED(Node_Pointer) ) THEN + Error_Status = FAILURE + WRITE( Message,'("Requested node #, ",i0," does not exist in list.")' ) & + Node_Number + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + RETURN + END IF + + + ! Copy out the SensorInfo data from the node + ! ------------------------------------------ + Error_Status = Assign_SensorInfo( Node_Pointer%SensorInfo, & + SensorInfo ) + IF ( Error_Status /= SUCCESS ) THEN + WRITE( Message,'("Error copying SensorInfo data from requested node #, ",i0,".")' ) & + Node_Number + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + ! Don't want RETURN here so that the + ! Node_Pointer can still be nullified + END IF + + + ! Nullify the local pointer + ! ------------------------- + NULLIFY( Node_Pointer ) + + END FUNCTION GetFrom_by_Node_Number + + + + FUNCTION GetFrom_by_Sensor_Id( & + SensorInfo_List, & ! Input + Sensor_Id , & ! Input + SensorInfo ) & ! Output + RESULT( err_stat ) + ! Arguments + TYPE(SensorInfo_List_type), INTENT(IN) :: SensorInfo_List + CHARACTER(*) , INTENT(IN) :: Sensor_Id + TYPE(SensorInfo_type) , INTENT(IN OUT) :: SensorInfo + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'GetFrom_SensorInfo_List(Sensor_Id)' + ! Local variables + CHARACTER(ML) :: msg + TYPE(SensorInfo_Node_type), POINTER :: current + INTEGER :: n_nodes + INTEGER :: destroy_stat + + + ! Set up + err_stat = SUCCESS + ! ...Reinit the output + err_stat = Destroy_SensorInfo(SensorInfo) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error destroying SensorInfo output argument' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ); RETURN + END IF + ! ...Check the list + IF ( List_Is_Empty( SensorInfo_List ) ) THEN + msg = 'List is empty!' + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + ! ...Initialise local counters and pointers + current => NULL() + n_nodes = 0 + + + ! Traverse list + ! ...Initialise pointer to first node + current => SensorInfo_List%First%Next + ! ...Loop over nodes + List_Loop: DO + + ! At end of list before required node + IF ( .NOT. ASSOCIATED( current ) ) THEN + msg = 'At end of list before required Sensor_Id found!' + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + EXIT List_Loop + END IF + + ! Increment node counter + n_nodes = n_nodes + 1 + + ! Is the current SensorInfo the one required? + IF ( TRIM(current%SensorInfo%Sensor_Id) == TRIM(Sensor_Id) ) THEN + + ! Copy out the SensorInfo data from the node + err_stat = Assign_SensorInfo( current%SensorInfo, SensorInfo ) + IF ( err_stat /= SUCCESS ) THEN + WRITE( msg,'("Error copying SensorInfo data from node #",i0)' ) n_nodes + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + END IF + EXIT List_Loop + END IF + + ! Go to next node + current => current%Next + + END DO List_Loop + + + ! Clean up + current => NULL() + IF ( err_stat /= SUCCESS ) destroy_stat = Destroy_SensorInfo( SensorInfo ) + + END FUNCTION GetFrom_by_Sensor_Id + + +!------------------------------------------------------------------------------ +! +! NAME: +! Count_SensorInfo_Nodes +! +! PURPOSE: +! Function to count the number of nodes in a SensorInfo linked list. +! +! CALLING SEQUENCE: +! n_Nodes = Count_SensorInfo_Nodes( SensorInfo_List ) ! Input +! +! INPUT ARGUMENTS: +! SensorInfo_List: SensorInfo linked list in which the nodes are to +! be counted. +! UNITS: N/A +! TYPE: SensorInfo_List_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! FUNCTION RESULT: +! n_Nodes: The number of nodes in the SensorInfo linked list. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!------------------------------------------------------------------------------ + + FUNCTION Count_SensorInfo_Nodes( SensorInfo_List ) RESULT( n_Nodes ) + ! Arguments + TYPE(SensorInfo_List_type), INTENT(IN) :: SensorInfo_List + ! Function result + INTEGER :: n_Nodes + ! Local variables + TYPE(SensorInfo_Node_type), POINTER :: Current + + + ! Set up + ! ------ + ! Nullify local pointers + NULLIFY( Current ) + + ! Initialise node counter + n_Nodes = 0 + + ! Check the list + IF ( List_Is_Empty( SensorInfo_List ) ) RETURN + + ! Initialise pointer to first node + ! -------------------------------- + Current => SensorInfo_List%First%Next + + + ! Traverse list + ! ------------- + Traverse_List_Loop: DO + + ! Check for end of list + IF ( .NOT. ASSOCIATED(Current) ) RETURN + + ! Increment node counter + n_Nodes = n_Nodes + 1 + + ! Go to next node + Current => Current%Next + + END DO Traverse_List_Loop + + END FUNCTION Count_SensorInfo_Nodes + +END MODULE SensorInfo_LinkedList diff --git a/libsrc/SensorInfo_Parameters.f90 b/libsrc/SensorInfo_Parameters.f90 index 7990da2d7..2a964a0ea 100644 --- a/libsrc/SensorInfo_Parameters.f90 +++ b/libsrc/SensorInfo_Parameters.f90 @@ -1,3 +1,18 @@ +! +! SensorInfo_Parameters.f90 +! +! Description: +! ============ +! +! +! Record of Revisions: +! ==================== +! +! Date: Author: Description: +! ===== ======= ============ +! 2021-08-31 Patrick Stegmann Added PRA_POLARIZATION. +! +! MODULE SensorInfo_Parameters ! ----------------- @@ -40,8 +55,10 @@ MODULE SensorInfo_Parameters PUBLIC :: minus45L_POLARIZATION PUBLIC :: VL_MIXED_POLARIZATION PUBLIC :: HL_MIXED_POLARIZATION + PUBLIC :: CONST_MIXED_POLARIZATION PUBLIC :: RC_POLARIZATION - PUBLIC :: LC_POLARIZATION + PUBLIC :: LC_POLARIZATION + PUBLIC :: PRA_POLARIZATION PUBLIC :: POLARIZATION_TYPE_NAME @@ -66,7 +83,7 @@ MODULE SensorInfo_Parameters 'Ultraviolet' /) ! The polarisation flags - INTEGER, PARAMETER :: N_POLARIZATION_TYPES = 12 + INTEGER, PARAMETER :: N_POLARIZATION_TYPES = 14 INTEGER, PARAMETER :: INVALID_POLARIZATION = 0 INTEGER, PARAMETER :: UNPOLARIZED = 1 INTEGER, PARAMETER :: INTENSITY = UNPOLARIZED @@ -82,6 +99,8 @@ MODULE SensorInfo_Parameters INTEGER, PARAMETER :: HL_MIXED_POLARIZATION = 10 INTEGER, PARAMETER :: RC_POLARIZATION = 11 INTEGER, PARAMETER :: LC_POLARIZATION = 12 + INTEGER, PARAMETER :: CONST_MIXED_POLARIZATION= 13 + INTEGER, PARAMETER :: PRA_POLARIZATION = 14 CHARACTER(*), PARAMETER, DIMENSION( 0:N_POLARIZATION_TYPES ) :: & POLARIZATION_TYPE_NAME = (/ 'Invalid ', & 'Unpolarized/Intensity/First Stokes component (I) ', & @@ -95,7 +114,9 @@ MODULE SensorInfo_Parameters 'Vertical polarization at nadir; mixed off nadir ', & 'Horizontal polarization at nadir; mixed off nadir', & 'Right circular polarization ', & - 'Left circular polarization ' /) + 'Left circular polarization ', & + 'Mixed polarization with constant mixing angle ', & + 'Polarization rotation angle '/) END MODULE SensorInfo_Parameters diff --git a/libsrc/SpcCoeff_Binary_IO.f90 b/libsrc/SpcCoeff_Binary_IO.f90 index 6b5ebd05d..216bf8742 100644 --- a/libsrc/SpcCoeff_Binary_IO.f90 +++ b/libsrc/SpcCoeff_Binary_IO.f90 @@ -397,18 +397,42 @@ FUNCTION SpcCoeff_Binary_ReadFile( & CALL Read_Cleanup(); RETURN END IF ! ...Read the channel data - READ( fid, IOSTAT=io_stat, IOMSG=io_msg ) & - SpcCoeff%Sensor_Channel , & - SpcCoeff%Polarization , & - SpcCoeff%Channel_Flag , & - SpcCoeff%Frequency , & - SpcCoeff%Wavenumber , & - SpcCoeff%Planck_C1 , & - SpcCoeff%Planck_C2 , & - SpcCoeff%Band_C1 , & - SpcCoeff%Band_C2 , & - SpcCoeff%Cosmic_Background_Radiance, & - SpcCoeff%Solar_Irradiance + IF( dummy%Version > 3 ) THEN + ! Binary coefficient version 3 introduced for TROPICS instrument. + ! The SpcCoeff coefficients contain 'PolAngle' as an additional + ! array. + READ ( fid, IOSTAT=io_stat, IOMSG=io_msg ) & + SpcCoeff%Sensor_Channel , & + SpcCoeff%Polarization , & + SpcCoeff%PolAngle , & + SpcCoeff%Channel_Flag , & + SpcCoeff%Frequency , & + SpcCoeff%Wavenumber , & + SpcCoeff%Planck_C1 , & + SpcCoeff%Planck_C2 , & + SpcCoeff%Band_C1 , & + SpcCoeff%Band_C2 , & + SpcCoeff%Cosmic_Background_Radiance, & + SpcCoeff%Solar_Irradiance + ELSE IF( dummy%Version < 4 ) THEN + ! Version 2 is the default binary SpcCoeff version for + ! REL-2.4.0 and older. + READ ( fid, IOSTAT=io_stat, IOMSG=io_msg ) & + SpcCoeff%Sensor_Channel , & + SpcCoeff%Polarization , & + SpcCoeff%Channel_Flag , & + SpcCoeff%Frequency , & + SpcCoeff%Wavenumber , & + SpcCoeff%Planck_C1 , & + SpcCoeff%Planck_C2 , & + SpcCoeff%Band_C1 , & + SpcCoeff%Band_C2 , & + SpcCoeff%Cosmic_Background_Radiance, & + SpcCoeff%Solar_Irradiance + ELSE + msg = 'Unrecognized SpcCoeff version. '//TRIM(io_msg) + CALL Read_Cleanup(); RETURN + END IF IF ( io_stat /= 0 ) THEN msg = 'Error reading channel data. '//TRIM(io_msg) CALL Read_Cleanup(); RETURN @@ -639,18 +663,38 @@ FUNCTION SpcCoeff_Binary_WriteFile( & CALL Write_Cleanup(); RETURN END IF ! ...Write the channel data - WRITE( fid, IOSTAT=io_stat ) & - SpcCoeff%Sensor_Channel , & - SpcCoeff%Polarization , & - SpcCoeff%Channel_Flag , & - SpcCoeff%Frequency , & - SpcCoeff%Wavenumber , & - SpcCoeff%Planck_C1 , & - SpcCoeff%Planck_C2 , & - SpcCoeff%Band_C1 , & - SpcCoeff%Band_C2 , & - SpcCoeff%Cosmic_Background_Radiance, & - SpcCoeff%Solar_Irradiance + IF(SpcCoeff%Version > 2) THEN + WRITE( fid, IOSTAT=io_stat ) & + SpcCoeff%Sensor_Channel , & + SpcCoeff%Polarization , & + SpcCoeff%PolAngle , & + SpcCoeff%Channel_Flag , & + SpcCoeff%Frequency , & + SpcCoeff%Wavenumber , & + SpcCoeff%Planck_C1 , & + SpcCoeff%Planck_C2 , & + SpcCoeff%Band_C1 , & + SpcCoeff%Band_C2 , & + SpcCoeff%Cosmic_Background_Radiance, & + SpcCoeff%Solar_Irradiance + ELSE IF(SpcCoeff%Version < 3) THEN + WRITE( fid, IOSTAT=io_stat ) & + SpcCoeff%Sensor_Channel , & + SpcCoeff%Polarization , & + SpcCoeff%Channel_Flag , & + SpcCoeff%Frequency , & + SpcCoeff%Wavenumber , & + SpcCoeff%Planck_C1 , & + SpcCoeff%Planck_C2 , & + SpcCoeff%Band_C1 , & + SpcCoeff%Band_C2 , & + SpcCoeff%Cosmic_Background_Radiance, & + SpcCoeff%Solar_Irradiance + ELSE + WRITE( msg,'("Unrecognized SpcCoeff Version. Version = ",i0)' ) & + SpcCoeff%Version + CALL Write_Cleanup(); RETURN + END IF IF ( io_stat /= 0 ) THEN WRITE( msg,'("Error writing channel data. IOSTAT = ",i0)' ) io_stat CALL Write_Cleanup(); RETURN diff --git a/libsrc/SpcCoeff_Define.f90 b/libsrc/SpcCoeff_Define.f90 index c42298ef2..a46fb5bdb 100644 --- a/libsrc/SpcCoeff_Define.f90 +++ b/libsrc/SpcCoeff_Define.f90 @@ -9,7 +9,14 @@ ! Written by: Paul van Delst, 18-Mar-2002 ! paul.vandelst@noaa.gov ! - +! MODIFICATION HISTORY: +! ===================== +! +! Author: Date: Description: +! ======= ===== ============ +! Patrick Stegmann 2021-01-22 Added SpcCoeff_type%PolAngle for the TROPICS +! instrument polarization scheme in SfcOptics. +! MODULE SpcCoeff_Define ! ----------------- @@ -46,8 +53,10 @@ MODULE SpcCoeff_Define minus45L_POLARIZATION , & VL_MIXED_POLARIZATION , & HL_MIXED_POLARIZATION , & + CONST_MIXED_POLARIZATION, & RC_POLARIZATION , & LC_POLARIZATION , & + PRA_POLARIZATION , & POLARIZATION_TYPE_NAME USE ACCoeff_Define , ONLY: ACCoeff_type , & OPERATOR(==) , & @@ -162,6 +171,7 @@ MODULE SpcCoeff_Define ! Channel data arrays INTEGER(Long), ALLOCATABLE :: Sensor_Channel(:) ! L INTEGER(Long), ALLOCATABLE :: Polarization(:) ! L + REAL(Double), ALLOCATABLE :: PolAngle(:) ! L, Units: [deg] INTEGER(Long), ALLOCATABLE :: Channel_Flag(:) ! L REAL(Double) , ALLOCATABLE :: Frequency(:) ! L REAL(Double) , ALLOCATABLE :: Wavenumber(:) ! L @@ -309,6 +319,7 @@ ELEMENTAL SUBROUTINE SpcCoeff_Create( & ! Perform the allocation ALLOCATE( SpcCoeff%Sensor_Channel( n_Channels ), & SpcCoeff%Polarization( n_Channels ), & + SpcCoeff%PolAngle( n_Channels ), & SpcCoeff%Channel_Flag( n_Channels ), & SpcCoeff%Frequency( n_Channels ), & SpcCoeff%Wavenumber( n_Channels ), & @@ -328,6 +339,7 @@ ELEMENTAL SUBROUTINE SpcCoeff_Create( & ! ...Arrays SpcCoeff%Sensor_Channel = 0 SpcCoeff%Polarization = INVALID_POLARIZATION + SpcCoeff%PolAngle = ZERO SpcCoeff%Channel_Flag = 0 SpcCoeff%Frequency = ZERO SpcCoeff%Wavenumber = ZERO @@ -390,6 +402,11 @@ SUBROUTINE SpcCoeff_Inspect( SpcCoeff ) WRITE(*,'(5x,"Channel ",i0,": ",a)') SpcCoeff%Sensor_Channel(n), & POLARIZATION_TYPE_NAME(SpcCoeff%Polarization(n)) END DO + WRITE(*,*) "Fixed Polarization Angle: " + DO n = 1, SpcCoeff%n_Channels + WRITE(*,'(3x,"Channel ",i0,": ")') SpcCoeff%Sensor_Channel(n) + WRITE(*,'(es22.15)') SpcCoeff%PolAngle(n) + END DO END IF WRITE(*,'(3x,"Channel_Flag :")') WRITE(*,'(3(1x,b32.32,:))') SpcCoeff%Channel_Flag @@ -653,6 +670,7 @@ SUBROUTINE SpcCoeff_Subset( & ! ...and now extract the subset SC_Subset%Sensor_Channel = SpcCoeff%Sensor_Channel(idx) SC_Subset%Polarization = SpcCoeff%Polarization(idx) + SC_Subset%PolAngle = SpcCoeff%PolAngle(idx) SC_Subset%Channel_Flag = SpcCoeff%Channel_Flag(idx) SC_Subset%Frequency = SpcCoeff%Frequency(idx) SC_Subset%Wavenumber = SpcCoeff%Wavenumber(idx) @@ -776,7 +794,8 @@ SUBROUTINE SpcCoeff_Concat( & ch2 = ch1 + SC_Array(i)%n_Channels - 1 SpcCoeff%Sensor_Channel(ch1:ch2) = SC_Array(i)%Sensor_Channel - SpcCoeff%Polarization(ch1:ch2) = SC_Array(i)%Polarization + SpcCoeff%Polarization(ch1:ch2) = SC_Array(i)%Polarization + SpcCoeff%PolAngle(ch1:ch2) = SC_Array(i)%PolAngle SpcCoeff%Channel_Flag(ch1:ch2) = SC_Array(i)%Channel_Flag SpcCoeff%Frequency(ch1:ch2) = SC_Array(i)%Frequency SpcCoeff%Wavenumber(ch1:ch2) = SC_Array(i)%Wavenumber @@ -1504,6 +1523,7 @@ ELEMENTAL FUNCTION SpcCoeff_Equal( x, y ) RESULT( is_equal ) ! ...Arrays IF ( ALL(x%Sensor_Channel == y%Sensor_Channel ) .AND. & ALL(x%Polarization == y%Polarization ) .AND. & + ALL(x%PolAngle == y%PolAngle ) .AND. & ALL(x%Channel_Flag == y%Channel_Flag ) .AND. & ALL(x%Frequency .EqualTo. y%Frequency ) .AND. & ALL(x%Wavenumber .EqualTo. y%Wavenumber ) .AND. & diff --git a/libsrc/SpcCoeff_IO.f90 b/libsrc/SpcCoeff_IO.f90 new file mode 100644 index 000000000..5f462d9ac --- /dev/null +++ b/libsrc/SpcCoeff_IO.f90 @@ -0,0 +1,746 @@ +! +! SpcCoeff_IO +! +! Container module for Binary and netCDF SpcCoeff I/O modules. +! +! +! CREATION HISTORY: +! Written by: Paul van Delst, 02-Feb-2011 +! paul.vandelst@noaa.gov +! + +MODULE SpcCoeff_IO + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module use + USE Type_Kinds , ONLY: fp + USE Message_Handler , ONLY: SUCCESS, FAILURE, INFORMATION, Display_Message + USE File_Utility , ONLY: File_Exists + USE SpcCoeff_Define , ONLY: SpcCoeff_type, OPERATOR(==) + USE SpcCoeff_Binary_IO , ONLY: SpcCoeff_Binary_InquireFile, & + SpcCoeff_Binary_ReadFile , & + SpcCoeff_Binary_WriteFile + USE SpcCoeff_netCDF_IO , ONLY: SpcCoeff_netCDF_InquireFile, & + SpcCoeff_netCDF_ReadFile , & + SpcCoeff_netCDF_WriteFile + USE ACCoeff_netCDF_IO , ONLY: ACCoeff_netCDF_ReadFile + USE NLTECoeff_netCDF_IO, ONLY: NLTECoeff_netCDF_ReadFile + ! Disable implicit typing + IMPLICIT NONE + + + ! ------------ + ! Visibilities + ! ------------ + PRIVATE + PUBLIC :: SpcCoeff_InquireFile + PUBLIC :: SpcCoeff_ReadFile + PUBLIC :: SpcCoeff_WriteFile + PUBLIC :: SpcCoeff_netCDF_to_Binary + !PUBLIC :: SpcCoeff_IOVersion + + + ! ----------------- + ! Module parameters + ! ----------------- + + +CONTAINS + + +!################################################################################ +!################################################################################ +!## ## +!## ## PUBLIC MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! SpcCoeff_InquireFile +! +! PURPOSE: +! Function to inquire SpcCoeff object files. +! +! CALLING SEQUENCE: +! Error_Status = SpcCoeff_InquireFile( & +! Filename, & +! netCDF = netCDF , & +! n_Channels = n_Channels , & +! Release = Release , & +! Version = Version , & +! Sensor_Id = Sensor_Id , & +! WMO_Satellite_Id = WMO_Satellite_Id, & +! WMO_Sensor_Id = WMO_Sensor_Id , & +! Title = Title , & +! History = History , & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of a +! SpcCoeff data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUTS: +! netCDF: Set this logical argument to access netCDF format +! SpcCoeff datafiles. +! If == .FALSE., file format is BINARY [DEFAULT]. +! == .TRUE., file format is NETCDF. +! If not specified, default is .FALSE. +! UNITS: N/A +! TYPE: LOGICAL +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! OPTIONAL OUTPUTS: +! n_Channels: Number of sensor channels. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Release: The release number of the SpcCoeff file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Version: The version number of the SpcCoeff file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Sensor_Id: Character string sensor/platform identifier. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! WMO_Satellite_Id: The WMO code used to identify satellite platforms. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! WMO_Sensor_Id: The WMO code used to identify sensors. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Title: Character string written into the TITLE global +! attribute field of the SpcCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the SpcCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the SpcCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! 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 inquire was successful +! == FAILURE, an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION SpcCoeff_InquireFile( & + Filename , & ! Input + netCDF , & ! Optional input + n_Channels , & ! Optional output + Release , & ! Optional Output + Version , & ! Optional Output + Sensor_Id , & ! Optional Output + WMO_Satellite_Id, & ! Optional Output + WMO_Sensor_Id , & ! Optional Output + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + LOGICAL, OPTIONAL, INTENT(IN) :: netCDF + INTEGER, OPTIONAL, INTENT(OUT) :: n_Channels + INTEGER, OPTIONAL, INTENT(OUT) :: Release + INTEGER, OPTIONAL, INTENT(OUT) :: Version + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Sensor_Id + INTEGER, OPTIONAL, INTENT(OUT) :: WMO_Satellite_Id + INTEGER, OPTIONAL, INTENT(OUT) :: WMO_Sensor_Id + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Function variables + LOGICAL :: binary + + ! Set up + err_stat = SUCCESS + ! ...Check netCDF argument + binary = .TRUE. + IF ( PRESENT(netCDF) ) binary = .NOT. netCDF + + + ! Call the appropriate function + IF ( binary ) THEN + err_stat = SpcCoeff_Binary_InquireFile( & + Filename, & + n_Channels = n_Channels , & + Release = Release , & + Version = Version , & + Sensor_Id = Sensor_Id , & + WMO_Satellite_Id = WMO_Satellite_Id, & + WMO_Sensor_Id = WMO_Sensor_Id ) + ELSE + err_stat = SpcCoeff_netCDF_InquireFile( & + Filename, & + n_Channels = n_Channels , & + Release = Release , & + Version = Version , & + Sensor_Id = Sensor_Id , & + WMO_Satellite_Id = WMO_Satellite_Id, & + WMO_Sensor_Id = WMO_Sensor_Id , & + Title = Title , & + History = History , & + Comment = Comment ) + END IF + + END FUNCTION SpcCoeff_InquireFile + + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! SpcCoeff_ReadFile +! +! PURPOSE: +! Function to read SpcCoeff object files. +! +! CALLING SEQUENCE: +! Error_Status = SpcCoeff_ReadFile( & +! Filename, & +! SpcCoeff , & +! netCDF = netCDF , & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of the +! SpcCoeff data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUTS: +! SpcCoeff: SpcCoeff object containing the spectral +! coefficient data. +! UNITS: N/A +! TYPE: SpcCoeff_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT) +! +! OPTIONAL INPUTS: +! netCDF: Set this logical argument to access netCDF format +! SpcCoeff datafiles. +! If == .FALSE., file format is BINARY [DEFAULT]. +! == .TRUE., file format is NETCDF. +! 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 written into the TITLE global +! attribute field of the SpcCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the SpcCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the SpcCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! 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 data write was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION SpcCoeff_ReadFile( & + Filename, & ! Input + SpcCoeff, & ! Output + netCDF , & ! Optional input + Quiet , & ! Optional input + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + TYPE(SpcCoeff_type), INTENT(OUT) :: SpcCoeff + LOGICAL, OPTIONAL, INTENT(IN) :: netCDF + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Function variables + LOGICAL :: binary + + ! Set up + err_stat = SUCCESS + ! ...Check netCDF argument + binary = .TRUE. + IF ( PRESENT(netCDF) ) binary = .NOT. netCDF + + ! Call the appropriate function + IF ( binary ) THEN + err_stat = SpcCoeff_Binary_ReadFile( & + Filename, & + SpcCoeff, & + Quiet = Quiet ) + ELSE + err_stat = SpcCoeff_netCDF_ReadFile( & + Filename, & + SpcCoeff, & + Quiet = Quiet , & + Title = Title , & + History = History, & + Comment = Comment ) + END IF + + END FUNCTION SpcCoeff_ReadFile + + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! SpcCoeff_WriteFile +! +! PURPOSE: +! Function to write SpcCoeff object files. +! +! CALLING SEQUENCE: +! Error_Status = SpcCoeff_WriteFile( & +! Filename, & +! SpcCoeff, & +! netCDF = netCDF , & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of the +! SpcCoeff data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! SpcCoeff: SpcCoeff object containing the spectral +! coefficient data. +! UNITS: N/A +! TYPE: SpcCoeff_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUTS: +! netCDF: Set this logical argument to access netCDF format +! SpcCoeff datafiles. +! If == .FALSE., file format is BINARY [DEFAULT]. +! == .TRUE., file format is NETCDF. +! 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 written into the TITLE global +! attribute field of the SpcCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the SpcCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the SpcCoeff file. +! This argument is ignored if the netCDF argument +! is not supplied or set. +! 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 data write was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION SpcCoeff_WriteFile( & + Filename, & ! Input + SpcCoeff, & ! Input + netCDF , & ! Optional input + Quiet , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment ) & ! Optional input + RESULT ( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + TYPE(SpcCoeff_type), INTENT(IN) :: SpcCoeff + LOGICAL, OPTIONAL, INTENT(IN) :: netCDF + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + ! Function result + INTEGER :: err_stat + ! Local variables + LOGICAL :: binary + + ! Set up + err_stat = SUCCESS + ! ...Check netCDF argument + binary = .TRUE. + IF ( PRESENT(netCDF) ) binary = .NOT. netCDF + + ! Call the appropriate function + IF ( binary ) THEN + err_stat = SpcCoeff_Binary_WriteFile( & + Filename, & + SpcCoeff, & + Quiet = Quiet ) + ELSE + err_stat = SpcCoeff_netCDF_WriteFile( & + Filename, & + SpcCoeff, & + Quiet = Quiet , & + Title = Title , & + History = History, & + Comment = Comment ) + END IF + + END FUNCTION SpcCoeff_WriteFile + + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! SpcCoeff_netCDF_to_Binary +! +! PURPOSE: +! Function to convert a netCDF SpcCoeff file to Binary format. +! +! NOTE: If the netCDF files for the SpcCoeff substructure components +! are also present, they are read and included in the binary +! file output. The substructure components filenames are +! constructed from the SpcCoeff sensor id, e.g. +! sensor_id.ACCoeff.nc +! sensor_id.NLTECoeff.nc +! etc.. +! +! CALLING SEQUENCE: +! Error_Status = SpcCoeff_netCDF_to_Binary( & +! NC_Filename , & +! BIN_Filename, & +! Quiet = Quiet , & +! Version = Version ) +! +! INPUTS: +! NC_Filename: Character string specifying the name of the +! netCDF format SpcCoeff data file to read. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! BIN_Filename: Character string specifying the name of the +! Binary format SpcCoeff data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! 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 +! +! Version: Set this argument to the version number value to be +! used in the output binary file. +! If > 0, the value REPLACES the current Version. +! <= 0, the current version is INCREMENTED by the |value|. +! UNITS: N/A +! TYPE: INTEGER +! 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 conversion 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, the output file is deleted before +! returning to the calling routine. +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION SpcCoeff_netCDF_to_Binary( & + NC_Filename , & ! Input + BIN_Filename, & ! Input + Quiet , & ! Optional input + Version ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: NC_Filename + CHARACTER(*), INTENT(IN) :: BIN_Filename + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + INTEGER, OPTIONAL, INTENT(IN) :: Version + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'SpcCoeff_netCDF_to_Binary' + ! Function variables + CHARACTER(256) :: msg + CHARACTER(256) :: sub_filename + TYPE(SpcCoeff_type) :: spccoeff, spccoeff_copy + + ! Set up + err_stat = SUCCESS + + + ! Read the netCDF file + WRITE(*,'(/5x,"Reading the input netCDF datafile(s)...")') + err_stat = SpcCoeff_netCDF_ReadFile( NC_Filename, spccoeff, Quiet = Quiet ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading netCDF file '//TRIM(NC_Filename) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + + ! Update version number if necessary + IF ( PRESENT(Version) ) THEN + IF ( Version > 0 ) THEN + spccoeff%Version = Version ! Replace + ELSE + spccoeff%Version = spccoeff%Version + ABS(Version) ! Increment + END IF + END IF + + + ! Read the substructure netCDF filenames + ! ...ACCoeff + sub_filename = TRIM(spccoeff%Sensor_Id)//'.ACCoeff.nc' + IF ( File_Exists(sub_filename) ) THEN + err_stat = ACCoeff_netCDF_ReadFile( sub_filename, spccoeff%AC, Quiet = Quiet ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading netCDF file '//TRIM(sub_filename) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + END IF + ! ...NLTECoeff + sub_filename = TRIM(spccoeff%Sensor_Id)//'.NLTECoeff.nc' + IF ( File_Exists(sub_filename) ) THEN + err_stat = NLTECoeff_netCDF_ReadFile( sub_filename, spccoeff%NC, Quiet = Quiet ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading netCDF file '//TRIM(sub_filename) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + END IF + + + ! Write the Binary file + WRITE(*,'(/5x,"Writing the output binary datafile...")') + err_stat = SpcCoeff_WriteFile( BIN_Filename, spccoeff, Quiet = Quiet ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error writing Binary file '//TRIM(BIN_Filename) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + + ! Check the write was successful + WRITE(*,'(/5x,"Test reading the output binary datafile...")') + ! ...Read the Binary file + err_stat = SpcCoeff_ReadFile( BIN_Filename, spccoeff_copy, Quiet = Quiet ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading Binary file '//TRIM(BIN_Filename)//' for test' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + ! ...Compare the SpcCoeff objects + IF ( .NOT. (spccoeff == spccoeff_copy) ) THEN + err_stat = FAILURE + msg = 'SpcCoeff object comparison failed.' + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + RETURN + END IF + + END FUNCTION SpcCoeff_netCDF_to_Binary + + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! SpcCoeff_IOVersion +! +! PURPOSE: +! Subroutine to return the version information for the I/O modules. +! +! CALLING SEQUENCE: +! CALL SpcCoeff_IOVersion( Id ) +! +! OUTPUTS: +! Id: Character string containing the version Id information +! for the I/O module(s). If the string length is sufficient, +! the version information for all the modules (this, the +! Binary I/O, and netCDF I/O modules) are concatenated. Otherwise +! only the version id for this module is returned. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT) +! +!:sdoc-: +!-------------------------------------------------------------------------------- + +! SUBROUTINE SpcCoeff_IOVersion( Id ) +! CHARACTER(*), INTENT(OUT) :: Id +! INTEGER, PARAMETER :: CARRIAGE_RETURN = 13 +! INTEGER, PARAMETER :: LINEFEED = 10 +! INTEGER, PARAMETER :: SL = 256 +! CHARACTER(SL) :: Binary_IO_Id, netCDF_IO_Id +! CHARACTER(SL*3) :: IO_Id +! Binary_IO_Id = 'Empty' +! netCDF_IO_Id = 'Empty' +! !CALL SpcCoeff_Binary_IOVersion( Binary_IO_Id ) +! !CALL SpcCoeff_netCDF_IOVersion( netCDF_IO_Id ) +! IO_Id = MODULE_VERSION_ID//';'//ACHAR(CARRIAGE_RETURN)//ACHAR(LINEFEED)//& +! ' '//TRIM(Binary_IO_Id)//';'//ACHAR(CARRIAGE_RETURN)//ACHAR(LINEFEED)//& +! ' '//TRIM(netCDF_IO_Id) +! IF ( LEN_TRIM(IO_Id) <= LEN(Id) ) THEN +! Id = IO_Id +! ELSE +! Id = MODULE_VERSION_ID +! END IF +! END SUBROUTINE SpcCoeff_IOVersion + +END MODULE SpcCoeff_IO diff --git a/libsrc/SpcCoeff_Parameters.f90 b/libsrc/SpcCoeff_Parameters.f90 new file mode 100644 index 000000000..71c70d30d --- /dev/null +++ b/libsrc/SpcCoeff_Parameters.f90 @@ -0,0 +1,71 @@ +! +! SpcCoeff_Parameters +! +! Module to hold parameter definitions used in SpcCoeff applications +! +! +! CREATION HISTORY: +! Written by: Paul van Delst, 03-Oct-2007 +! paul.vandelst@noaa.gov +! + +MODULE SpcCoeff_Parameters + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module usage + USE Type_Kinds, ONLY: fp + ! Disable implicit typing + IMPLICIT NONE + + + ! ------------ + ! Visibilities + ! ------------ + PRIVATE + + + ! ----------------- + ! Module parameters + ! ----------------- + ! The following scaling factors are applied to produce radiances in units + ! of mW/(m^2.sr.cm^-1) when they are used. + ! + ! First Planck function constant (C_1) scale factors. Units of C_1 are W.m^2. + ! Length scaling: To convert to W/(m^2.cm^-4) requires a scaling of m->cm, + ! which is 100, to the fourth power, which is 1.0e+08. + ! Power scaling: To convert to mW.m^2 requires a scaling of 1000. + REAL(fp), PUBLIC, PARAMETER :: C_1_LENGTH_SCALE_FACTOR = 1.0e+08_fp + REAL(fp), PUBLIC, PARAMETER :: C_1_POWER_SCALE_FACTOR = 1.0e+03_fp + REAL(fp), PUBLIC, PARAMETER :: C_1_SCALE_FACTOR = C_1_LENGTH_SCALE_FACTOR * & + C_1_POWER_SCALE_FACTOR + ! Second Planck function constant (C_2) scale factor. Units of C_2 are K.m, + ! So to convert to K.cm, a scaling of 100 is applied. + REAL(fp), PUBLIC, PARAMETER :: C_2_SCALE_FACTOR = 100.0_fp + + ! The number and range of temperatures used in determining the + ! polychromatic correction coefficients + INTEGER, PUBLIC, PARAMETER :: N_TEMPERATURES = 17 + REAL(fp), PUBLIC, PARAMETER :: MIN_TEMPERATURE = 180.0_fp + REAL(fp), PUBLIC, PARAMETER :: MAX_TEMPERATURE = 340.0_fp + + ! Solar channel cut-off frequency + REAL(fp), PUBLIC, PARAMETER :: SOLAR_CUTOFF_WAVENUMBER = 1800.0_fp + + ! Integration methods + INTEGER, PUBLIC, PARAMETER :: N_INTEGRATION_METHODS = 2 + INTEGER, PUBLIC, PARAMETER :: SUMMATION_METHOD = 1 + INTEGER, PUBLIC, PARAMETER :: INTEGRATE_METHOD = 2 + INTEGER, PUBLIC, PARAMETER :: INTEGRATION_METHOD(N_INTEGRATION_METHODS) = & + (/ SUMMATION_METHOD, & + INTEGRATE_METHOD /) + CHARACTER(*), PUBLIC, PARAMETER :: INTEGRATION_METHOD_NAME(N_INTEGRATION_METHODS) = & + (/ 'Summation ', & + 'Integration' /) + + ! Interpolation order + INTEGER, PUBLIC, PARAMETER :: LINEAR_ORDER = 1 + INTEGER, PUBLIC, PARAMETER :: CUBIC_ORDER = 3 + +END MODULE SpcCoeff_Parameters diff --git a/libsrc/SpcCoeff_netCDF_IO.f90 b/libsrc/SpcCoeff_netCDF_IO.f90 new file mode 100644 index 000000000..536fe6ac0 --- /dev/null +++ b/libsrc/SpcCoeff_netCDF_IO.f90 @@ -0,0 +1,1787 @@ +! +! SpcCoeff_netCDF_IO +! +! Module containing routines to read and write SpcCoeff netCDF +! format files. +! +! +! CREATION HISTORY: +! Written by: Paul van Delst, 17-Dec-2002 +! paul.vandelst@noaa.gov +! + +MODULE SpcCoeff_netCDF_IO + + ! ----------------- + ! Environment setup + ! ----------------- + ! Module use + USE Type_Kinds , ONLY: Long, Double + USE Message_Handler, ONLY: SUCCESS, FAILURE, INFORMATION, Display_Message + USE File_Utility , ONLY: File_Exists + USE String_Utility , ONLY: StrClean + USE SpcCoeff_Define, ONLY: SpcCoeff_type , & + SpcCoeff_Associated , & + SpcCoeff_Destroy , & + SpcCoeff_Create , & + SpcCoeff_Inspect , & + SpcCoeff_ValidRelease , & + SpcCoeff_Info + + USE netcdf + ! Disable implicit typing + IMPLICIT NONE + + + ! ------------ + ! Visibilities + ! ------------ + ! Everything private by default + PRIVATE + ! Procedures + PUBLIC :: SpcCoeff_netCDF_InquireFile + PUBLIC :: SpcCoeff_netCDF_ReadFile + PUBLIC :: SpcCoeff_netCDF_WriteFile + PUBLIC :: SpcCoeff_netCDF_IOVersion + + + ! ----------------- + ! Module parameters + ! ----------------- + CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = & + '$Id: SpcCoeff_netCDF_IO.f90 13519 2021-01-29 19:34:34Z patrick.stegmann@noaa.gov $' + ! Default message string length + INTEGER, PARAMETER :: ML = 1024 + ! Literal constants + REAL(Double), PARAMETER :: ZERO = 0.0_Double + REAL(Double), PARAMETER :: ONE = 1.0_Double + + + ! Global attribute names. + CHARACTER(*), PARAMETER :: RELEASE_GATTNAME = 'Release' + CHARACTER(*), PARAMETER :: VERSION_GATTNAME = 'Version' + CHARACTER(*), PARAMETER :: TITLE_GATTNAME = 'Title' + CHARACTER(*), PARAMETER :: HISTORY_GATTNAME = 'History' + CHARACTER(*), PARAMETER :: COMMENT_GATTNAME = 'Comment' + CHARACTER(*), PARAMETER :: SENSOR_ID_GATTNAME = 'Sensor_Id' + CHARACTER(*), PARAMETER :: WMO_SATELLITE_ID_GATTNAME = 'WMO_Satellite_Id' + CHARACTER(*), PARAMETER :: WMO_SENSOR_ID_GATTNAME = 'WMO_Sensor_Id' + + + ! Dimension names + CHARACTER(*), PARAMETER :: CHANNEL_DIMNAME = 'n_Channels' + + + ! Variable names. + CHARACTER(*), PARAMETER :: SENSOR_TYPE_VARNAME = 'Sensor_Type' + CHARACTER(*), PARAMETER :: SENSOR_CHANNEL_VARNAME = 'Sensor_Channel' + CHARACTER(*), PARAMETER :: POLARIZATION_VARNAME = 'Polarization' + CHARACTER(*), PARAMETER :: POLANGLE_VARNAME = 'Polarization_Angle' + CHARACTER(*), PARAMETER :: CHANNEL_FLAG_VARNAME = 'Channel_Flag' + CHARACTER(*), PARAMETER :: FREQUENCY_VARNAME = 'Frequency' + CHARACTER(*), PARAMETER :: WAVENUMBER_VARNAME = 'Wavenumber' + CHARACTER(*), PARAMETER :: PLANCK_C1_VARNAME = 'Planck_C1' + CHARACTER(*), PARAMETER :: PLANCK_C2_VARNAME = 'Planck_C2' + CHARACTER(*), PARAMETER :: BAND_C1_VARNAME = 'Band_C1' + CHARACTER(*), PARAMETER :: BAND_C2_VARNAME = 'Band_C2' + CHARACTER(*), PARAMETER :: CBR_VARNAME = 'Cosmic_Background_Radiance' + CHARACTER(*), PARAMETER :: SOLAR_IRRADIANCE_VARNAME = 'Solar_Irradiance' + + + ! Variable long name attribute. + CHARACTER(*), PARAMETER :: LONGNAME_ATTNAME = 'long_name' + + CHARACTER(*), PARAMETER :: SENSOR_TYPE_LONGNAME = 'Sensor Type' + CHARACTER(*), PARAMETER :: SENSOR_CHANNEL_LONGNAME = 'Sensor Channel' + CHARACTER(*), PARAMETER :: POLARIZATION_LONGNAME = 'Polarization type flag' + CHARACTER(*), PARAMETER :: POLANGLE_LONGNAME = 'Polarization Angle' + CHARACTER(*), PARAMETER :: CHANNEL_FLAG_LONGNAME = 'Channel flag' + CHARACTER(*), PARAMETER :: FREQUENCY_LONGNAME = 'Frequency' + CHARACTER(*), PARAMETER :: WAVENUMBER_LONGNAME = 'Wavenumber' + CHARACTER(*), PARAMETER :: PLANCK_C1_LONGNAME = 'Planck C1' + CHARACTER(*), PARAMETER :: PLANCK_C2_LONGNAME = 'Planck C2' + CHARACTER(*), PARAMETER :: BAND_C1_LONGNAME = 'Band C1' + CHARACTER(*), PARAMETER :: BAND_C2_LONGNAME = 'Band C2' + CHARACTER(*), PARAMETER :: CBR_LONGNAME = 'Cosmic Background Radiance' + CHARACTER(*), PARAMETER :: SOLAR_IRRADIANCE_LONGNAME = 'Kurucz Solar Irradiance' + + + ! Variable description attribute. + CHARACTER(*), PARAMETER :: DESCRIPTION_ATTNAME = 'description' + + CHARACTER(*), PARAMETER :: SENSOR_TYPE_DESCRIPTION = 'Sensor type to identify uW, IR, VIS, UV, etc sensor channels' + CHARACTER(*), PARAMETER :: SENSOR_CHANNEL_DESCRIPTION = 'List of sensor channel numbers' + CHARACTER(*), PARAMETER :: POLARIZATION_DESCRIPTION = 'Polarization type flag.' + CHARACTER(*), PARAMETER :: POLANGLE_DESCRIPTION = 'Polarization angle offset' + CHARACTER(*), PARAMETER :: CHANNEL_FLAG_DESCRIPTION = 'Bit position flags for channels' + CHARACTER(*), PARAMETER :: FREQUENCY_DESCRIPTION = 'Channel central frequency, f' + CHARACTER(*), PARAMETER :: WAVENUMBER_DESCRIPTION = 'Channel central wavenumber, v' + CHARACTER(*), PARAMETER :: PLANCK_C1_DESCRIPTION = 'First Planck coefficient, c1.v^3' + CHARACTER(*), PARAMETER :: PLANCK_C2_DESCRIPTION = 'Second Planck coefficient, c2.v' + CHARACTER(*), PARAMETER :: BAND_C1_DESCRIPTION = 'Polychromatic band correction offset' + CHARACTER(*), PARAMETER :: BAND_C2_DESCRIPTION = 'Polychromatic band correction slope' + CHARACTER(*), PARAMETER :: CBR_DESCRIPTION = 'Planck radiance for the cosmic background temperature' + CHARACTER(*), PARAMETER :: SOLAR_IRRADIANCE_DESCRIPTION = 'TOA solar irradiance using Kurucz spectrum' + + + ! Variable units attribute. + CHARACTER(*), PARAMETER :: UNITS_ATTNAME = 'units' + + CHARACTER(*), PARAMETER :: SENSOR_TYPE_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: SENSOR_CHANNEL_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: POLARIZATION_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: POLANGLE_UNITS = 'degrees (^o)' + CHARACTER(*), PARAMETER :: CHANNEL_FLAG_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: FREQUENCY_UNITS = 'Gigahertz (GHz)' + CHARACTER(*), PARAMETER :: WAVENUMBER_UNITS = 'Inverse centimetres (cm^-1)' + CHARACTER(*), PARAMETER :: PLANCK_C1_UNITS = 'mW/(m^2.sr.cm^-1)' + CHARACTER(*), PARAMETER :: PLANCK_C2_UNITS = 'Kelvin (K)' + CHARACTER(*), PARAMETER :: BAND_C1_UNITS = 'Kelvin (K)' + CHARACTER(*), PARAMETER :: BAND_C2_UNITS = 'K/K' + CHARACTER(*), PARAMETER :: CBR_UNITS = 'mW/(m^2.sr.cm^-1)' + CHARACTER(*), PARAMETER :: SOLAR_IRRADIANCE_UNITS = 'mW/(m^2.cm^-1)' + + + ! Variable _FillValue attribute. + CHARACTER(*), PARAMETER :: FILLVALUE_ATTNAME = '_FillValue' + + INTEGER(Long), PARAMETER :: SENSOR_TYPE_FILLVALUE = 0 + INTEGER(Long), PARAMETER :: SENSOR_CHANNEL_FILLVALUE = 0 + INTEGER(Long), PARAMETER :: POLARIZATION_FILLVALUE = 0 + REAL(Double), PARAMETER :: POLANGLE_FILLVALUE = ZERO + INTEGER(Long), PARAMETER :: CHANNEL_FLAG_FILLVALUE = 0 + REAL(Double), PARAMETER :: FREQUENCY_FILLVALUE = ZERO + REAL(Double), PARAMETER :: WAVENUMBER_FILLVALUE = ZERO + REAL(Double), PARAMETER :: PLANCK_C1_FILLVALUE = ZERO + REAL(Double), PARAMETER :: PLANCK_C2_FILLVALUE = ZERO + REAL(Double), PARAMETER :: BAND_C1_FILLVALUE = ZERO + REAL(Double), PARAMETER :: BAND_C2_FILLVALUE = ZERO + REAL(Double), PARAMETER :: CBR_FILLVALUE = ZERO + REAL(Double), PARAMETER :: SOLAR_IRRADIANCE_FILLVALUE = ZERO + + + ! Variable netCDF datatypes + INTEGER, PARAMETER :: SENSOR_TYPE_TYPE = NF90_INT + INTEGER, PARAMETER :: SENSOR_CHANNEL_TYPE = NF90_INT + INTEGER, PARAMETER :: POLARIZATION_TYPE = NF90_INT + INTEGER, PARAMETER :: POLANGLE_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: CHANNEL_FLAG_TYPE = NF90_INT + INTEGER, PARAMETER :: FREQUENCY_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: WAVENUMBER_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: PLANCK_C1_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: PLANCK_C2_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: BAND_C1_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: BAND_C2_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: CBR_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: SOLAR_IRRADIANCE_TYPE = NF90_DOUBLE + + +CONTAINS + + +!################################################################################ +!################################################################################ +!## ## +!## ## PUBLIC MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! SpcCoeff_netCDF_InquireFile +! +! PURPOSE: +! Function to inquire SpcCoeff object netCDF format files. +! +! CALLING SEQUENCE: +! Error_Status = SpcCoeff_netCDF_InquireFile( & +! Filename, & +! n_Channels = n_Channels , & +! Release = Release , & +! Version = Version , & +! Sensor_Id = Sensor_Id , & +! WMO_Satellite_Id = WMO_Satellite_Id, & +! WMO_Sensor_Id = WMO_Sensor_Id , & +! Title = Title , & +! History = History , & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of the +! SpcCoeff data file to inquire. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL OUTPUTS: +! n_Channels: Total number of sensor channels. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Release: The release number of the SpcCoeff file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Version: The version number of the SpcCoeff file. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Sensor_Id: Character string sensor/platform identifier. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! WMO_Satellite_Id: The WMO code used to identify satellite platforms. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! WMO_Sensor_Id: The WMO code used to identify sensors. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Title: Character string written into the TITLE global +! attribute field of the SpcCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the SpcCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the SpcCoeff file. +! 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 inquiry was successful +! == FAILURE an error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION SpcCoeff_netCDF_InquireFile( & + Filename , & ! Input + n_Channels , & ! Optional output + Release , & ! Optional Output + Version , & ! Optional Output + Sensor_Id , & ! Optional Output + WMO_Satellite_Id, & ! Optional Output + WMO_Sensor_Id , & ! Optional Output + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , OPTIONAL, INTENT(OUT) :: n_Channels + INTEGER , OPTIONAL, INTENT(OUT) :: Release + INTEGER , OPTIONAL, INTENT(OUT) :: Version + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Sensor_Id + INTEGER , OPTIONAL, INTENT(OUT) :: WMO_Satellite_Id + INTEGER , OPTIONAL, INTENT(OUT) :: WMO_Sensor_Id + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'SpcCoeff_InquireFile(netCDF)' + ! Function variables + CHARACTER(ML) :: msg + LOGICAL :: close_file + INTEGER :: nf90_status + INTEGER :: fileid + INTEGER :: dimid + TYPE(SpcCoeff_type) :: spccoeff + + ! Set up + err_stat = SUCCESS + close_file = .FALSE. + + + ! Open the file + nf90_status = NF90_OPEN( Filename,NF90_NOWRITE,fileid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error opening '//TRIM(Filename)//' for read access - '// & + TRIM(NF90_STRERROR( nf90_status )) + CALL Inquire_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + close_file = .TRUE. + + + ! Get the dimensions + ! ...n_Channels dimension + nf90_status = NF90_INQ_DIMID( FileId,CHANNEL_DIMNAME,DimId ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring dimension ID for '//CHANNEL_DIMNAME//' - '// & + TRIM(NF90_STRERROR( nf90_status )) + CALL Inquire_Cleanup(); RETURN + END IF + nf90_status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=spccoeff%n_Channels ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading dimension value for '//CHANNEL_DIMNAME//' - '// & + TRIM(NF90_STRERROR( nf90_status )) + CALL Inquire_Cleanup(); RETURN + END IF + + + ! Get the global attributes + err_stat = ReadGAtts( Filename, & + fileid , & + Release = Release , & + Version = Version , & + Sensor_Id = Sensor_Id , & + WMO_Satellite_Id = WMO_Satellite_Id, & + WMO_Sensor_Id = WMO_Sensor_Id , & + Title = Title , & + History = History , & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading global attributes from '//TRIM(Filename) + CALL Inquire_Cleanup(); RETURN + END IF + + + ! Close the file + nf90_status = NF90_CLOSE( fileid ) + close_file = .FALSE. + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error closing input file - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Inquire_Cleanup(); RETURN + END IF + + + ! Set the return values + IF ( PRESENT(n_Channels) ) n_Channels = spccoeff%n_Channels + + CONTAINS + + SUBROUTINE Inquire_CleanUp() + IF ( close_file ) THEN + nf90_status = NF90_CLOSE( fileid ) + IF ( nf90_status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup.' + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Inquire_CleanUp + + END FUNCTION SpcCoeff_netCDF_InquireFile + + + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! SpcCoeff_netCDF_WriteFile +! +! PURPOSE: +! Function to write SpcCoeff object files in netCDF format. +! +! CALLING SEQUENCE: +! Error_Status = SpcCoeff_netCDF_WriteFile( & +! Filename , & +! SpcCoeff , & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of the +! SpcCoeff data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! SpcCoeff: SpcCoeff object containing the spectral +! coefficient data. +! UNITS: N/A +! TYPE: SpcCoeff_type +! DIMENSION: Scalar +! 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 +! +! Title: Character string written into the TITLE global +! attribute field of the SpcCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the SpcCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the SpcCoeff file. +! 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 data write was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION SpcCoeff_netCDF_WriteFile( & + Filename, & ! Input + SpcCoeff, & ! Input + Quiet , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + TYPE(SpcCoeff_type), INTENT(IN) :: SpcCoeff + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'SpcCoeff_WriteFile(netCDF)' + ! Local variables + CHARACTER(ML) :: msg + LOGICAL :: close_file + LOGICAL :: noisy + INTEGER :: nf90_status + INTEGER :: fileid + INTEGER :: varid + + ! Set up + err_stat = SUCCESS + close_file = .FALSE. + ! ...Check structure pointer association status + IF ( .NOT. SpcCoeff_Associated( SpcCoeff ) ) THEN + msg = 'SpcCoeff structure is empty. Nothing to do!' + CALL Write_CleanUp(); RETURN + END IF + ! ...Check if release is valid + IF ( .NOT. SpcCoeff_ValidRelease( SpcCoeff ) ) THEN + msg = 'SpcCoeff Release check failed.' + CALL Write_Cleanup(); RETURN + END IF + ! ...Check Quiet argument + noisy = .TRUE. + IF ( PRESENT(Quiet) ) noisy = .NOT. Quiet + + + ! Create the output file + err_stat = CreateFile( & + Filename , & ! Input + SpcCoeff%n_Channels , & ! Input + fileid , & ! Output + Version = SpcCoeff%Version , & ! Optional input + Sensor_Id = SpcCoeff%Sensor_Id , & ! Optional input + WMO_Satellite_Id = SpcCoeff%WMO_Satellite_Id, & ! Optional input + WMO_Sensor_Id = SpcCoeff%WMO_Sensor_Id , & ! Optional input + Title = Title , & ! Optional input + History = History , & ! Optional input + Comment = Comment ) ! Optional input + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error creating output file '//TRIM(Filename) + CALL Write_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + close_file = .TRUE. + + + ! Write the data items + ! ...Sensor_Type variable + NF90_Status = NF90_INQ_VARID( FileId,SENSOR_TYPE_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//SENSOR_TYPE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,SpcCoeff%Sensor_Type ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//SENSOR_TYPE_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Sensor_Channel variable + NF90_Status = NF90_INQ_VARID( FileId,SENSOR_CHANNEL_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//SENSOR_CHANNEL_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,SpcCoeff%Sensor_Channel ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//SENSOR_CHANNEL_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Polarization variable + NF90_Status = NF90_INQ_VARID( FileId,POLARIZATION_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//POLARIZATION_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,SpcCoeff%Polarization ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//POLARIZATION_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Polarization angle variable + IF( SpcCoeff%Version > 2 ) THEN + NF90_Status = NF90_INQ_VARID( FileId,POLANGLE_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//POLANGLE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,SpcCoeff%PolAngle ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//POLANGLE_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + END IF + ! ...Channel_Flag variable + NF90_Status = NF90_INQ_VARID( FileId,CHANNEL_FLAG_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//CHANNEL_FLAG_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,SpcCoeff%Channel_Flag ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//CHANNEL_FLAG_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Frequency variable + NF90_Status = NF90_INQ_VARID( FileId,FREQUENCY_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//FREQUENCY_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,SpcCoeff%Frequency ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//FREQUENCY_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Wavenumber variable + NF90_Status = NF90_INQ_VARID( FileId,WAVENUMBER_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//WAVENUMBER_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,SpcCoeff%Wavenumber ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//WAVENUMBER_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Planck_C1 variable + NF90_Status = NF90_INQ_VARID( FileId,PLANCK_C1_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//PLANCK_C1_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,SpcCoeff%Planck_C1 ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//PLANCK_C1_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Planck_C2 variable + NF90_Status = NF90_INQ_VARID( FileId,PLANCK_C2_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//PLANCK_C2_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,SpcCoeff%Planck_C2 ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//PLANCK_C2_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Band_C1 variable + NF90_Status = NF90_INQ_VARID( FileId,BAND_C1_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//BAND_C1_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,SpcCoeff%Band_C1 ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//BAND_C1_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Band_C2 variable + NF90_Status = NF90_INQ_VARID( FileId,BAND_C2_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//BAND_C2_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,SpcCoeff%Band_C2 ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//BAND_C2_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Cosmic_Background_Radiance variable + NF90_Status = NF90_INQ_VARID( FileId,CBR_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//CBR_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,SpcCoeff%Cosmic_Background_Radiance ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//CBR_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + ! ...Solar_Irradiance variable + NF90_Status = NF90_INQ_VARID( FileId,SOLAR_IRRADIANCE_VARNAME,VarId ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//SOLAR_IRRADIANCE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + NF90_Status = NF90_PUT_VAR( FileId,VarID,SpcCoeff%Solar_Irradiance ) + IF ( NF90_Status /= NF90_NOERR ) THEN + msg = 'Error writing '//SOLAR_IRRADIANCE_VARNAME//' to '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( NF90_Status )) + CALL Write_Cleanup(); RETURN + END IF + + + ! Close the file + nf90_status = NF90_CLOSE( fileid ) + close_file = .FALSE. + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error closing output file - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Write_Cleanup(); RETURN + END IF + + + ! Output an info message + IF ( noisy ) THEN + CALL SpcCoeff_Info( SpcCoeff, msg ) + CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION ) + END IF + + CONTAINS + + SUBROUTINE Write_CleanUp() + IF ( close_file ) THEN + nf90_status = NF90_CLOSE( fileid ) + IF ( nf90_status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing output file during error cleanup - '//& + TRIM(NF90_STRERROR( nf90_status )) + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Write_CleanUp + + END FUNCTION SpcCoeff_netCDF_WriteFile + + +!------------------------------------------------------------------------------ +!:sdoc+: +! +! NAME: +! SpcCoeff_netCDF_ReadFile +! +! PURPOSE: +! Function to read SpcCoeff object files in netCDF format. +! +! CALLING SEQUENCE: +! Error_Status = SpcCoeff_netCDF_ReadFile( & +! Filename , & +! SpcCoeff , & +! Quiet = Quiet , & +! Title = Title , & +! History = History, & +! Comment = Comment ) +! +! INPUTS: +! Filename: Character string specifying the name of the +! SpcCoeff data file to write. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OUTPUTS: +! SpcCoeff: SpcCoeff object containing the spectral +! coefficient data. +! UNITS: N/A +! TYPE: SpcCoeff_type +! DIMENSION: Scalar +! 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: +! Title: Character string written into the TITLE global +! attribute field of the SpcCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! History: Character string written into the HISTORY global +! attribute field of the SpcCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT), OPTIONAL +! +! Comment: Character string written into the COMMENT global +! attribute field of the SpcCoeff file. +! 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 data write was successful +! == FAILURE an unrecoverable error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!:sdoc-: +!------------------------------------------------------------------------------ + + FUNCTION SpcCoeff_netCDF_ReadFile( & + Filename, & ! Input + SpcCoeff, & ! Output + Quiet , & ! Optional input + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + TYPE(SpcCoeff_type), INTENT(OUT) :: SpcCoeff + LOGICAL, OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'SpcCoeff_ReadFile(netCDF)' + ! Function variables + CHARACTER(ML) :: msg + LOGICAL :: close_file + LOGICAL :: noisy + INTEGER :: nf90_status + INTEGER :: fileid + INTEGER :: n_channels + INTEGER :: varid + + + ! Set up + err_stat = SUCCESS + close_file = .FALSE. + ! ...Check that the file exists + IF ( .NOT. File_Exists(Filename) ) THEN + msg = 'File '//TRIM(Filename)//' not found.' + CALL Read_Cleanup(); RETURN + END IF + ! ...Check Quiet argument + noisy = .TRUE. + IF ( PRESENT(Quiet) ) noisy = .NOT. Quiet + + + ! Inquire the file to get the dimensions + err_stat = SpcCoeff_netCDF_InquireFile( & + Filename, & + n_Channels = n_channels ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error obtaining SpcCoeff dimensions from '//TRIM(Filename) + CALL Read_Cleanup(); RETURN + END IF + + + ! Allocate the output structure + CALL SpcCoeff_Create( SpcCoeff, n_channels ) + IF ( .NOT. SpcCoeff_Associated(SpcCoeff) ) THEN + msg = 'Error allocating output SpcCoeff' + CALL Read_Cleanup(); RETURN + END IF + + + ! Open the file for reading + nf90_status = NF90_OPEN( Filename,NF90_NOWRITE,fileid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error opening '//TRIM(Filename)//' for read access - '//& + TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + close_file = .TRUE. + + + ! Read the global attributes + err_stat = ReadGAtts( & + Filename, & + fileid , & + Release = SpcCoeff%Release , & + Version = SpcCoeff%Version , & + Sensor_Id = SpcCoeff%Sensor_Id , & + WMO_Satellite_Id = SpcCoeff%WMO_Satellite_Id, & + WMO_Sensor_Id = SpcCoeff%WMO_Sensor_Id , & + Title = Title , & + History = History , & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading global attribute from '//TRIM(Filename) + CALL Read_Cleanup(); RETURN + END IF + ! ...Check if release is valid + IF ( .NOT. SpcCoeff_ValidRelease( SpcCoeff ) ) THEN + msg = 'SpcCoeff Release check failed.' + CALL Read_Cleanup(); RETURN + END IF + + + ! Read the SpcCoeff data + ! ...Sensor_Type variable + nf90_status = NF90_INQ_VARID( fileid,SENSOR_TYPE_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//SENSOR_TYPE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,SpcCoeff%Sensor_Type ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//SENSOR_TYPE_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Sensor_Channel variable + nf90_status = NF90_INQ_VARID( fileid,SENSOR_CHANNEL_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//SENSOR_CHANNEL_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,SpcCoeff%Sensor_Channel ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//SENSOR_CHANNEL_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Polarization variable + nf90_status = NF90_INQ_VARID( fileid,POLARIZATION_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//POLARIZATION_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,SpcCoeff%Polarization ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//POLARIZATION_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Polarization angle variable + IF ( SpcCoeff%Version > 2 ) THEN + nf90_status = NF90_INQ_VARID( fileid,POLANGLE_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//POLANGLE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,SpcCoeff%PolAngle ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//POLANGLE_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + END IF + ! ...Channel_Flag variable + nf90_status = NF90_INQ_VARID( fileid,CHANNEL_FLAG_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//CHANNEL_FLAG_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,SpcCoeff%Channel_Flag ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//CHANNEL_FLAG_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Frequency variable + nf90_status = NF90_INQ_VARID( fileid,FREQUENCY_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//FREQUENCY_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,SpcCoeff%Frequency ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//FREQUENCY_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Wavenumber variable + nf90_status = NF90_INQ_VARID( fileid,WAVENUMBER_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//WAVENUMBER_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,SpcCoeff%Wavenumber ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//WAVENUMBER_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Planck_C1 variable + nf90_status = NF90_INQ_VARID( fileid,PLANCK_C1_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//PLANCK_C1_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,SpcCoeff%Planck_C1 ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//PLANCK_C1_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Planck_C2 variable + nf90_status = NF90_INQ_VARID( fileid,PLANCK_C2_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//PLANCK_C2_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,SpcCoeff%Planck_C2 ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//PLANCK_C2_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Band_C1 variable + nf90_status = NF90_INQ_VARID( fileid,BAND_C1_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//BAND_C1_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,SpcCoeff%Band_C1 ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//BAND_C1_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Band_C2 variable + nf90_status = NF90_INQ_VARID( fileid,BAND_C2_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//BAND_C2_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,SpcCoeff%Band_C2 ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//BAND_C2_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Cosmic_Background_Radiance variable + nf90_status = NF90_INQ_VARID( fileid,CBR_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//CBR_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,SpcCoeff%Cosmic_Background_Radiance ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//CBR_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + ! ...Solar_Irradiance variable + nf90_status = NF90_INQ_VARID( fileid,SOLAR_IRRADIANCE_VARNAME,varid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error inquiring '//TRIM(Filename)//' for '//SOLAR_IRRADIANCE_VARNAME//& + ' variable ID - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + nf90_status = NF90_GET_VAR( fileid,varid,SpcCoeff%Solar_Irradiance ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error reading '//SOLAR_IRRADIANCE_VARNAME//' from '//TRIM(Filename)//& + ' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + + + ! Close the file + nf90_status = NF90_CLOSE( fileid ); CLOSE_FILE = .FALSE. + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error closing output file - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Read_Cleanup(); RETURN + END IF + + + ! Output an info message + IF ( noisy ) THEN + CALL SpcCoeff_Info( SpcCoeff, msg ) + CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION ) + END IF + + CONTAINS + + SUBROUTINE Read_CleanUp() + IF ( close_file ) THEN + nf90_status = NF90_CLOSE( fileid ) + IF ( nf90_status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup- '//& + TRIM(NF90_STRERROR( nf90_status )) + END IF + CALL SpcCoeff_Destroy( SpcCoeff ) + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Read_CleanUp + + END FUNCTION SpcCoeff_netCDF_ReadFile + + +!-------------------------------------------------------------------------------- +!:sdoc+: +! +! NAME: +! SpcCoeff_netCDF_IOVersion +! +! PURPOSE: +! Subroutine to return the module version information. +! +! CALLING SEQUENCE: +! CALL SpcCoeff_netCDF_IOVersion( Id ) +! +! OUTPUT ARGUMENTS: +! Id: Character string containing the version Id information +! for the module. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(OUT) +! +!:sdoc-: +!-------------------------------------------------------------------------------- + + SUBROUTINE SpcCoeff_netCDF_IOVersion( Id ) + CHARACTER(*), INTENT(OUT) :: Id + Id = MODULE_VERSION_ID + END SUBROUTINE SpcCoeff_netCDF_IOVersion + + +!################################################################################## +!################################################################################## +!## ## +!## ## PRIVATE MODULE ROUTINES ## ## +!## ## +!################################################################################## +!################################################################################## + + ! Function to write the global attributes to a SpcCoeff data file. + + FUNCTION WriteGAtts( & + Filename , & ! Input + FileId , & ! Input + Version , & ! Optional input + Sensor_Id , & ! Optional input + WMO_Satellite_Id, & ! Optional input + WMO_Sensor_Id , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: FileId + INTEGER , OPTIONAL, INTENT(IN) :: Version + CHARACTER(*), OPTIONAL, INTENT(IN) :: Sensor_Id + INTEGER , OPTIONAL, INTENT(IN) :: WMO_Satellite_Id + INTEGER , OPTIONAL, INTENT(IN) :: WMO_Sensor_Id + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'SpcCoeff_WriteGAtts(netCDF)' + CHARACTER(*), PARAMETER :: WRITE_MODULE_HISTORY_GATTNAME = 'write_module_history' + CHARACTER(*), PARAMETER :: CREATION_DATE_AND_TIME_GATTNAME = 'creation_date_and_time' + ! Local variables + CHARACTER(ML) :: msg + CHARACTER(ML) :: gattname + CHARACTER(8) :: cdate + CHARACTER(10) :: ctime + CHARACTER(5) :: czone + INTEGER :: ver + INTEGER :: nf90_status + TYPE(SpcCoeff_type) :: SpcCoeff + + ! Set up + err_stat = SUCCESS + msg = ' ' + + ! Mandatory global attributes + ! ...Software ID + gattname = WRITE_MODULE_HISTORY_GATTNAME + nf90_status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(gattname),MODULE_VERSION_ID ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + ! ...Creation date + CALL DATE_AND_TIME( cdate, ctime, czone ) + gattname = CREATION_DATE_AND_TIME_GATTNAME + nf90_status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(gattname), & + cdate(1:4)//'/'//cdate(5:6)//'/'//cdate(7:8)//', '// & + ctime(1:2)//':'//ctime(3:4)//':'//ctime(5:6)//' '// & + czone//'UTC' ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + ! ...The Release + gattname = RELEASE_GATTNAME + nf90_status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(gattname),SpcCoeff%Release ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + + + ! Optional global attributes + ! ...The Version + IF ( PRESENT(Version) ) THEN + ver = Version + ELSE + ver = SpcCoeff%Version + END IF + gattname = VERSION_GATTNAME + nf90_status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(gattname),Ver ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + ! ...The Sensor_Id + IF ( PRESENT(Sensor_Id) ) THEN + gattname = SENSOR_ID_GATTNAME + nf90_status = NF90_PUT_ATT( FileID,NF90_GLOBAL,TRIM(gattname),Sensor_Id ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The WMO_Satellite_Id + IF ( PRESENT(WMO_Satellite_Id) ) THEN + gattname = WMO_SATELLITE_ID_GATTNAME + nf90_status = NF90_PUT_ATT( FileID,NF90_GLOBAL,TRIM(gattname),WMO_Satellite_Id ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The WMO_Sensor_Id + IF ( PRESENT(WMO_Sensor_Id) ) THEN + gattname = WMO_SENSOR_ID_GATTNAME + nf90_status = NF90_PUT_ATT( FileID,NF90_GLOBAL,TRIM(gattname),WMO_Sensor_Id ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The title + IF ( PRESENT(title) ) THEN + gattname = TITLE_GATTNAME + nf90_status = NF90_PUT_ATT( FileID,NF90_GLOBAL,TRIM(gattname),title ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The history + IF ( PRESENT(history) ) THEN + gattname = HISTORY_GATTNAME + nf90_status = NF90_PUT_ATT( FileID,NF90_GLOBAL,TRIM(gattname),history ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The comment + IF ( PRESENT(comment) ) THEN + gattname = COMMENT_GATTNAME + nf90_status = NF90_PUT_ATT( FileID,NF90_GLOBAL,TRIM(gattname),comment ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL WriteGAtts_Cleanup(); RETURN + END IF + END IF + + CONTAINS + + SUBROUTINE WriteGAtts_CleanUp() + nf90_status = NF90_CLOSE( FileId ) + IF ( nf90_status /= NF90_NOERR ) & + msg = '; Error closing input file during error cleanup - '//& + TRIM(NF90_STRERROR( nf90_status ) ) + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//TRIM(gattname)//' attribute to '//& + TRIM(Filename)//' - '// & + TRIM(NF90_STRERROR( nf90_status ) )//TRIM(msg), & + err_stat ) + END SUBROUTINE WriteGAtts_CleanUp + + END FUNCTION WriteGAtts + + + ! Function to read the global attributes from a SpcCoeff data file. + + FUNCTION ReadGAtts( & + Filename , & ! Input + FileId , & ! Input + Release , & ! Optional output + Version , & ! Optional output + Sensor_Id , & ! Optional output + WMO_Satellite_Id, & ! Optional output + WMO_Sensor_Id , & ! Optional output + Title , & ! Optional output + History , & ! Optional output + Comment ) & ! Optional output + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: FileId + INTEGER , OPTIONAL, INTENT(OUT) :: Release + INTEGER , OPTIONAL, INTENT(OUT) :: Version + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Sensor_Id + INTEGER , OPTIONAL, INTENT(OUT) :: WMO_Satellite_Id + INTEGER , OPTIONAL, INTENT(OUT) :: WMO_Sensor_Id + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'SpcCoeff_ReadGAtts(netCDF)' + ! Local variables + CHARACTER(ML) :: msg + CHARACTER(256) :: gattname + CHARACTER(5000) :: gattstring + INTEGER :: nf90_status + + ! Set up + err_stat = SUCCESS + + ! The global attributes + ! ...The Release + IF ( PRESENT(Release) ) THEN + gattname = RELEASE_GATTNAME + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),Release ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The Version + IF ( PRESENT(Version) ) THEN + gattname = VERSION_GATTNAME + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),Version ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The Sensor_Id + IF ( PRESENT(Sensor_Id) ) THEN + gattname = SENSOR_ID_GATTNAME; gattstring = '' + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),gattstring ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( gattstring ) + Sensor_Id = gattstring(1:MIN(LEN(Sensor_Id), LEN_TRIM(gattstring))) + END IF + ! ...The WMO_Satellite_Id + IF ( PRESENT(WMO_Satellite_Id) ) THEN + gattname = WMO_SATELLITE_ID_GATTNAME + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),WMO_Satellite_Id ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The WMO_Sensor_Id + IF ( PRESENT(WMO_Sensor_Id) ) THEN + gattname = WMO_SENSOR_ID_GATTNAME + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),WMO_Sensor_Id ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + END IF + ! ...The Title + IF ( PRESENT(Title) ) THEN + gattname = TITLE_GATTNAME; gattstring = '' + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),gattstring ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( gattstring ) + Title = gattstring(1:MIN(LEN(Title), LEN_TRIM(gattstring))) + END IF + ! ...The History + IF ( PRESENT(History) ) THEN + gattname = HISTORY_GATTNAME; gattstring = '' + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),gattstring ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( gattstring ) + History = gattstring(1:MIN(LEN(History), LEN_TRIM(gattstring))) + END IF + ! ...The Comment + IF ( PRESENT(Comment) ) THEN + gattname = COMMENT_GATTNAME; gattstring = '' + nf90_status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(gattname),gattstring ) + IF ( nf90_status /= NF90_NOERR ) THEN + CALL ReadGAtts_Cleanup(); RETURN + END IF + CALL StrClean( gattstring ) + Comment = gattstring(1:MIN(LEN(Comment), LEN_TRIM(gattstring))) + END IF + + CONTAINS + + SUBROUTINE ReadGAtts_CleanUp() + err_stat = FAILURE + msg = 'Error reading '//TRIM(gattname)//' attribute from '//TRIM(Filename)//' - '// & + TRIM(NF90_STRERROR( nf90_status ) ) + CALL Display_Message( ROUTINE_NAME, msg, err_stat ) + END SUBROUTINE ReadGAtts_CleanUp + + END FUNCTION ReadGAtts + + + ! Function to create a SpcCoeff file for writing + + FUNCTION CreateFile( & + Filename , & ! Input + n_Channels , & ! Input + FileId , & ! Output + Version , & ! Optional input + Sensor_Id , & ! Optional input + WMO_Satellite_Id, & ! Optional input + WMO_Sensor_Id , & ! Optional input + Title , & ! Optional input + History , & ! Optional input + Comment ) & ! Optional input + RESULT( err_stat ) + ! Arguments + CHARACTER(*), INTENT(IN) :: Filename + INTEGER , INTENT(IN) :: n_Channels + INTEGER , INTENT(OUT) :: FileId + INTEGER , OPTIONAL, INTENT(IN) :: Version + CHARACTER(*), OPTIONAL, INTENT(IN) :: Sensor_Id + INTEGER , OPTIONAL, INTENT(IN) :: WMO_Satellite_Id + INTEGER , OPTIONAL, INTENT(IN) :: WMO_Sensor_Id + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + ! Function result + INTEGER :: err_stat + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'SpcCoeff_CreateFile(netCDF)' + ! Local variables + CHARACTER(ML) :: msg + LOGICAL :: close_file + INTEGER :: nf90_status + INTEGER :: n_channels_dimid + INTEGER :: varid + INTEGER :: put_status(4) + + ! Setup + err_stat = SUCCESS + close_file = .FALSE. + + + ! Create the data file + nf90_status = NF90_CREATE( Filename,NF90_CLOBBER,FileId ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error creating '//TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + ! ...Close the file if any error from here on + close_file = .TRUE. + + + ! Define the dimensions + ! ...Total number of channels for the sensor + nf90_status = NF90_DEF_DIM( FileID,CHANNEL_DIMNAME,n_Channels,n_Channels_dimid ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//CHANNEL_DIMNAME//' dimension in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + + + ! Write the global attributes + err_stat = WriteGAtts( & + Filename, & + FileId , & + Version = Version , & + Sensor_Id = Sensor_Id , & + WMO_Satellite_Id = WMO_Satellite_Id, & + WMO_Sensor_Id = WMO_Sensor_Id , & + Title = Title , & + History = History , & + Comment = Comment ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error writing global attribute to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + + + ! Define the variables + ! ...Sensor_Type variable + nf90_status = NF90_DEF_VAR( FileID, & + SENSOR_TYPE_VARNAME, & + SENSOR_TYPE_TYPE, & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//SENSOR_TYPE_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,SENSOR_TYPE_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,SENSOR_TYPE_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,SENSOR_TYPE_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,SENSOR_TYPE_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//SENSOR_TYPE_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Sensor_Channel variable + nf90_status = NF90_DEF_VAR( FileID, & + SENSOR_CHANNEL_VARNAME, & + SENSOR_CHANNEL_TYPE, & + dimIDs=(/n_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//SENSOR_CHANNEL_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,SENSOR_CHANNEL_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,SENSOR_CHANNEL_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,SENSOR_CHANNEL_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,SENSOR_CHANNEL_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//SENSOR_CHANNEL_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Polarization variable + nf90_status = NF90_DEF_VAR( FileID, & + POLARIZATION_VARNAME, & + POLARIZATION_TYPE, & + dimIDs=(/n_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//POLARIZATION_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,POLARIZATION_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,POLARIZATION_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,POLARIZATION_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,POLARIZATION_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//POLARIZATION_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Polarization angle variable + nf90_status = NF90_DEF_VAR( FileID, & + POLANGLE_VARNAME, & + POLANGLE_TYPE, & + dimIDs=(/n_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//POLANGLE_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,POLANGLE_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,POLANGLE_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,POLANGLE_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,POLANGLE_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//POLANGLE_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Channel_Flag variable + nf90_status = NF90_DEF_VAR( FileID, & + CHANNEL_FLAG_VARNAME, & + CHANNEL_FLAG_TYPE, & + dimIDs=(/n_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//CHANNEL_FLAG_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,CHANNEL_FLAG_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,CHANNEL_FLAG_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,CHANNEL_FLAG_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,CHANNEL_FLAG_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//CHANNEL_FLAG_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Frequency variable + nf90_status = NF90_DEF_VAR( FileID, & + FREQUENCY_VARNAME, & + FREQUENCY_TYPE, & + dimIDs=(/n_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//FREQUENCY_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,FREQUENCY_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,FREQUENCY_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,FREQUENCY_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,FREQUENCY_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//FREQUENCY_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Wavenumber variable + nf90_status = NF90_DEF_VAR( FileID, & + WAVENUMBER_VARNAME, & + WAVENUMBER_TYPE, & + dimIDs=(/n_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//WAVENUMBER_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,WAVENUMBER_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,WAVENUMBER_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,WAVENUMBER_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,WAVENUMBER_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//WAVENUMBER_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Planck_C1 variable + nf90_status = NF90_DEF_VAR( FileID, & + PLANCK_C1_VARNAME, & + PLANCK_C1_TYPE, & + dimIDs=(/n_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//PLANCK_C1_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,PLANCK_C1_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,PLANCK_C1_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,PLANCK_C1_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,PLANCK_C1_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//PLANCK_C1_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Planck_C2 variable + nf90_status = NF90_DEF_VAR( FileID, & + PLANCK_C2_VARNAME, & + PLANCK_C2_TYPE, & + dimIDs=(/n_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//PLANCK_C2_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,PLANCK_C2_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,PLANCK_C2_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,PLANCK_C2_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,PLANCK_C2_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//PLANCK_C2_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Band_C1 variable + nf90_status = NF90_DEF_VAR( FileID, & + BAND_C1_VARNAME, & + BAND_C1_TYPE, & + dimIDs=(/n_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//BAND_C1_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,BAND_C1_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,BAND_C1_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,BAND_C1_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,BAND_C1_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//BAND_C1_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Band_C2 variable + nf90_status = NF90_DEF_VAR( FileID, & + BAND_C2_VARNAME, & + BAND_C2_TYPE, & + dimIDs=(/n_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//BAND_C2_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,BAND_C2_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,BAND_C2_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,BAND_C2_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,BAND_C2_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//BAND_C2_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Cosmic_Background_Radiance variable + nf90_status = NF90_DEF_VAR( FileID, & + CBR_VARNAME, & + CBR_TYPE, & + dimIDs=(/n_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//CBR_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,CBR_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,CBR_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,CBR_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,CBR_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//CBR_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + ! ...Solar_Irradiance variable + nf90_status = NF90_DEF_VAR( FileID, & + SOLAR_IRRADIANCE_VARNAME, & + SOLAR_IRRADIANCE_TYPE, & + dimIDs=(/n_channels_dimid/), & + varID=variD ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error defining '//SOLAR_IRRADIANCE_VARNAME//' variable in '//& + TRIM(Filename)//' - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + put_status(1) = NF90_PUT_ATT( FileID,varid,LONGNAME_ATTNAME ,SOLAR_IRRADIANCE_LONGNAME ) + put_status(2) = NF90_PUT_ATT( FileID,varid,DESCRIPTION_ATTNAME,SOLAR_IRRADIANCE_DESCRIPTION ) + put_status(3) = NF90_PUT_ATT( FileID,varid,UNITS_ATTNAME ,SOLAR_IRRADIANCE_UNITS ) + put_status(4) = NF90_PUT_ATT( FileID,varid,FILLVALUE_ATTNAME ,SOLAR_IRRADIANCE_FILLVALUE ) + IF ( ANY(put_status /= NF90_NOERR) ) THEN + msg = 'Error writing '//SOLAR_IRRADIANCE_VARNAME//' variable attributes to '//TRIM(Filename) + CALL Create_Cleanup(); RETURN + END IF + + + ! Take netCDF file out of define mode + nf90_status = NF90_ENDDEF( FileId ) + IF ( nf90_status /= NF90_NOERR ) THEN + msg = 'Error taking file '//TRIM(Filename)// & + ' out of define mode - '//TRIM(NF90_STRERROR( nf90_status )) + CALL Create_Cleanup(); RETURN + END IF + + CONTAINS + + SUBROUTINE Create_CleanUp() + IF ( close_file ) THEN + nf90_status = NF90_CLOSE( FileID ) + IF ( nf90_status /= NF90_NOERR ) & + msg = TRIM(msg)//'; Error closing input file during error cleanup - '//& + TRIM(NF90_STRERROR( nf90_status )) + END IF + err_stat = FAILURE + CALL Display_Message( ROUTINE_NAME,msg,err_stat ) + END SUBROUTINE Create_CleanUp + + END FUNCTION CreateFile + +END MODULE SpcCoeff_netCDF_IO diff --git a/libsrc/TauCoeff_netCDF_IO.f90 b/libsrc/TauCoeff_netCDF_IO.f90 new file mode 100644 index 000000000..5854c70f0 --- /dev/null +++ b/libsrc/TauCoeff_netCDF_IO.f90 @@ -0,0 +1,2584 @@ +! +! TauCoeff_netCDF_IO +! +! Module containing routines to create, inquire, read and write netCDF +! format TauCoeff files. +! +! +! CREATION HISTORY: +! Written by: Paul van Delst, CIMSS/SSEC 30-Dec-2002 +! paul.vandelst@ssec.wisc.edu +! + +MODULE TauCoeff_netCDF_IO + + ! ------------------ + ! Environment set up + ! ------------------ + ! Module use + USE Message_Handler, ONLY: SUCCESS, FAILURE, WARNING, INFORMATION, Display_Message + USE TauCoeff_Define, ONLY: TauCoeff_Type, & + Associated_TauCoeff, & + Allocate_TauCoeff, & + Destroy_TauCoeff, & + Check_TauCoeff_Release, & + Count_TauCoeff_Sensors, & + Info_TauCoeff + USE netcdf + USE netCDF_Utility, Open_TauCoeff_netCDF => Open_netCDF, & + Close_TauCoeff_netCDF => Close_netCDF + ! Disable implicit typing + IMPLICIT NONE + + + ! ------------ + ! Visibilities + ! ------------ + PRIVATE + PUBLIC :: Inquire_TauCoeff_netCDF + PUBLIC :: Write_TauCoeff_netCDF + PUBLIC :: Read_TauCoeff_netCDF + + + ! ----------------- + ! Module parameters + ! ----------------- + ! Module RCS Id string + CHARACTER(*), PARAMETER :: MODULE_RCS_ID = & + + ! Global attribute names. Case sensitive + CHARACTER(*), PARAMETER :: TITLE_GATTNAME = 'title' + CHARACTER(*), PARAMETER :: HISTORY_GATTNAME = 'history' + CHARACTER(*), PARAMETER :: SENSOR_NAME_GATTNAME = 'sensor_name' + CHARACTER(*), PARAMETER :: PLATFORM_NAME_GATTNAME = 'platform_name' + CHARACTER(*), PARAMETER :: COMMENT_GATTNAME = 'comment' + CHARACTER(*), PARAMETER :: ID_TAG_GATTNAME = 'id_tag' + + ! Dimension names + CHARACTER(*), PARAMETER :: ORDER_DIMNAME = 'n_Orders' + CHARACTER(*), PARAMETER :: PREDICTOR_DIMNAME = 'n_Predictors' + CHARACTER(*), PARAMETER :: CHANNEL_DIMNAME = 'n_Channels' + CHARACTER(*), PARAMETER :: ABSORBER_DIMNAME = 'n_Absorbers' + CHARACTER(*), PARAMETER :: STRLEN_DIMNAME = 'sdsl' + + ! Variable names. Case sensitive. + CHARACTER(*), PARAMETER :: RELEASE_VARNAME = 'Release' + CHARACTER(*), PARAMETER :: VERSION_VARNAME = 'Version' + CHARACTER(*), PARAMETER :: SENSOR_DESCRIPTOR_VARNAME = 'Sensor_Descriptor' + CHARACTER(*), PARAMETER :: NCEP_SENSOR_ID_VARNAME = 'NCEP_Sensor_ID' + CHARACTER(*), PARAMETER :: WMO_SATELLITE_ID_VARNAME = 'WMO_Satellite_ID' + CHARACTER(*), PARAMETER :: WMO_SENSOR_ID_VARNAME = 'WMO_Sensor_ID' + CHARACTER(*), PARAMETER :: SENSOR_CHANNEL_VARNAME = 'Sensor_Channel' + CHARACTER(*), PARAMETER :: ABSORBER_ID_VARNAME = 'Absorber_ID' + CHARACTER(*), PARAMETER :: ALPHA_VARNAME = 'Alpha' + CHARACTER(*), PARAMETER :: ALPHA_C1_VARNAME = 'Alpha_C1' + CHARACTER(*), PARAMETER :: ALPHA_C2_VARNAME = 'Alpha_C2' + CHARACTER(*), PARAMETER :: ORDER_INDEX_VARNAME = 'Order_Index' + CHARACTER(*), PARAMETER :: PREDICTOR_INDEX_VARNAME = 'Predictor_Index' + CHARACTER(*), PARAMETER :: TAU_COEFFICIENTS_VARNAME = 'Tau_Coefficients' + + ! Variable long name attribute. + CHARACTER(*), PARAMETER :: LONGNAME_ATTNAME = 'long_name' + + CHARACTER(*), PARAMETER :: RELEASE_LONGNAME = & +'Release number of TauCoeff data file' + CHARACTER(*), PARAMETER :: VERSION_LONGNAME = & +'Version number of TauCoeff data file' + CHARACTER(*), PARAMETER :: SENSOR_DESCRIPTOR_LONGNAME = & +'Short text string containing the sensor/satellite description' + CHARACTER(*), PARAMETER :: NCEP_SENSOR_ID_LONGNAME = & +'ID used at NOAA/NCEP/EMC to identify a satellite/sensor (-1 == none available)' + CHARACTER(*), PARAMETER :: WMO_SATELLITE_ID_LONGNAME = & +'WMO code for identifying satellite platforms (1023 == none available)' + CHARACTER(*), PARAMETER :: WMO_SENSOR_ID_LONGNAME = & +'WMO code for identifying a satellite sensor (2047 == none available)' + CHARACTER(*), PARAMETER :: SENSOR_CHANNEL_LONGNAME = & +'List of sensor channel numbers associated with the TauCoeff data' + CHARACTER(*), PARAMETER :: ABSORBER_ID_LONGNAME = & +'List of absorber ID values for distinguishing the absorber type.' + CHARACTER(*), PARAMETER :: ALPHA_LONGNAME = & +'Alpha values used to generate the absorber space levels.' + CHARACTER(*), PARAMETER :: ALPHA_C1_LONGNAME = & +'First constant (slope) used in defining the Alpha to absorber space equation.' + CHARACTER(*), PARAMETER :: ALPHA_C2_LONGNAME = & +'Second constant (offset) used in defining the Alpha to absorber space equation.' + CHARACTER(*), PARAMETER :: ORDER_INDEX_LONGNAME = & +'Index list of polynomial orders to use in the gas absorption calculation.' + CHARACTER(*), PARAMETER :: PREDICTOR_INDEX_LONGNAME = & +'Index list of predictors to use in the gas absorption calculation.' + CHARACTER(*), PARAMETER :: TAU_COEFFICIENTS_LONGNAME = & +'Regression model gas absorption coefficients.' + + ! Variable units attribute. + CHARACTER(*), PARAMETER :: UNITS_ATTNAME = 'units' + + CHARACTER(*), PARAMETER :: RELEASE_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: VERSION_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: NCEP_SENSOR_ID_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: WMO_SATELLITE_ID_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: WMO_SENSOR_ID_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: SENSOR_CHANNEL_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: ABSORBER_ID_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: ALPHA_UNITS = 'Absorber dependent.' + CHARACTER(*), PARAMETER :: ALPHA_C1_UNITS = 'Absorber dependent.' + CHARACTER(*), PARAMETER :: ALPHA_C2_UNITS = 'Absorber dependent.' + CHARACTER(*), PARAMETER :: ORDER_INDEX_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: PREDICTOR_INDEX_UNITS = 'N/A' + CHARACTER(*), PARAMETER :: TAU_COEFFICIENTS_UNITS = 'Absorber and predictor dependent.' + + ! Variable netCDF datatypes + INTEGER, PARAMETER :: RELEASE_TYPE = NF90_INT + INTEGER, PARAMETER :: VERSION_TYPE = NF90_INT + INTEGER, PARAMETER :: SENSOR_DESCRIPTOR_TYPE = NF90_CHAR + INTEGER, PARAMETER :: NCEP_SENSOR_ID_TYPE = NF90_INT + INTEGER, PARAMETER :: WMO_SATELLITE_ID_TYPE = NF90_INT + INTEGER, PARAMETER :: WMO_SENSOR_ID_TYPE = NF90_INT + INTEGER, PARAMETER :: SENSOR_CHANNEL_TYPE = NF90_INT + INTEGER, PARAMETER :: ABSORBER_ID_TYPE = NF90_INT + INTEGER, PARAMETER :: ALPHA_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: ALPHA_C1_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: ALPHA_C2_TYPE = NF90_DOUBLE + INTEGER, PARAMETER :: ORDER_INDEX_TYPE = NF90_INT + INTEGER, PARAMETER :: PREDICTOR_INDEX_TYPE = NF90_INT + INTEGER, PARAMETER :: TAU_COEFFICIENTS_TYPE = NF90_DOUBLE + + +CONTAINS + + +!################################################################################## +!################################################################################## +!## ## +!## ## PRIVATE MODULE ROUTINES ## ## +!## ## +!################################################################################## +!################################################################################## + +!-------------------------------------------------------------------------------- +! +! NAME: +! Write_TauCoeff_GAtts +! +! PURPOSE: +! Function to write the global attributes to a netCDF TauCoeff data file. +! +! CALLING SEQUENCE: +! Error_Status = Write_TauCoeff_GAtts( NC_Filename, & ! Input +! NC_FileID, & ! Input +! Title = Title, & ! Optional input +! History = History, & ! Optional input +! Sensor_Name = Sensor_Name, & ! Optional input +! Platform_Name = Platform_Name, & ! Optional input +! Comment = Comment, & ! Optional input +! ID_Tag = ID_Tag, & ! Optional input +! Message_Log = Message_Log ) ! Error messaging +! +! INPUT ARGUMENTS: +! NC_Filename: Character string specifying the name of the +! netCDF TauCoeff format data file to create. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! NC_FileID: NetCDF file ID number returned from the +! Open_ or Create_TauCoeff_netCDF() function. +! UNITS: N/A +! TYPE: Integer +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! +! OPTIONAL INPUT ARGUMENTS: +! Title: Character string written into the TITLE global +! attribute field of the netCDF TauCoeff file. +! Should contain a succinct description of what +! is in the netCDF datafile. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(IN) +! +! History: Character string written into the HISTORY global +! attribute field of the netCDF TauCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(IN) +! +! Sensor_Name: Character string written into the SENSOR_NAME +! global attribute field of the netCDF TauCoeff +! file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(IN) +! +! Platform_Name: Character string written into the PLATFORM_NAME +! global attribute field of the netCDF TauCoeff +! file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(IN) +! +! Comment: Character string written into the COMMENT global +! attribute field of the netCDF TauCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(IN) +! +! ID_Tag: Character string written into the ID_TAG global +! attribute field of the netCDF TauCoeff file. +! Should contain a short tag used to identify the +! dependent profile set used to generate the +! coefficient data. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(IN) +! +! 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: OPTIONAL, 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 global attribute write was successful +! == FAILURE an error occurred writing the supplied +! global attribute(s). +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +! SIDE EFFECTS: +! If a FAILURE error occurs, the netCDF file is closed. +! +! COMMENTS: +! The netCDF file remains in DEFINE mode upon exiting this function. +! +!-------------------------------------------------------------------------------- + + FUNCTION Write_TauCoeff_GAtts( NC_Filename, & ! Input + NC_FileID, & ! Input + Title, & ! Optional input + History, & ! Optional input + Sensor_Name, & ! Optional input + Platform_Name, & ! Optional input + Comment, & ! Optional input + ID_Tag, & ! Optional input + Message_Log ) & ! Error messaging + RESULT ( Error_Status ) + ! Arguments + CHARACTER(*), INTENT(IN) :: NC_Filename + INTEGER, INTENT(IN) :: NC_FileID + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Sensor_Name + CHARACTER(*), OPTIONAL, INTENT(IN) :: Platform_Name + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + CHARACTER(*), OPTIONAL, INTENT(IN) :: ID_Tag + CHARACTER(*), OPTIONAL, INTENT(IN) :: Message_Log + ! Function result + INTEGER :: Error_Status + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Write_TauCoeff_GAtts' + CHARACTER(*), PARAMETER :: WRITE_MODULE_HISTORY_GATTNAME = 'write_module_history' + CHARACTER(*), PARAMETER :: CREATION_DATE_AND_TIME_GATTNAME = 'creation_date_and_time' + INTEGER, PARAMETER :: nPutGAtts = 8 + ! Local variables + INTEGER :: Put_Status(nPutGAtts), n + CHARACTER(8) :: cdate + CHARACTER(10) :: ctime + CHARACTER(5) :: czone + + ! Set up + Error_Status = SUCCESS + Put_Status = SUCCESS + n = 0 + + ! Software ID + n = n + 1 + Put_Status(n) = Put_GAttString(WRITE_MODULE_HISTORY_GATTNAME, & + MODULE_RCS_ID, & + Message_Log=Message_Log ) + + ! Creation date + CALL DATE_AND_TIME( cdate, ctime, czone ) + n = n + 1 + Put_Status(n) = Put_GAttString(CREATION_DATE_AND_TIME_GATTNAME, & + cdate(1:4)//'/'//cdate(5:6)//'/'//cdate(7:8)//', '// & + ctime(1:2)//':'//ctime(3:4)//':'//ctime(5:6)//' '// & + czone//'UTC', & + Message_Log=Message_Log ) + + ! The TITLE + n = n + 1 + IF ( PRESENT( Title ) ) THEN + Put_Status(n) = Put_GAttString(TITLE_GATTNAME, Title, & + Message_Log=Message_Log ) + END IF + + ! The HISTORY + n = n + 1 + IF ( PRESENT( History ) ) THEN + Put_Status(n) = Put_GAttString(HISTORY_GATTNAME, History, & + Message_Log=Message_Log ) + END IF + + ! The SENSOR_NAME + n = n + 1 + IF ( PRESENT( Sensor_Name ) ) THEN + Put_Status(n) = Put_GAttString(SENSOR_NAME_GATTNAME, Sensor_Name, & + Message_Log=Message_Log ) + END IF + + ! The PLATFORM_NAME + n = n + 1 + IF ( PRESENT( Platform_Name ) ) THEN + Put_Status(n) = Put_GAttString(PLATFORM_NAME_GATTNAME, Platform_Name, & + Message_Log=Message_Log ) + END IF + + ! The COMMENT + n = n + 1 + IF ( PRESENT( Comment ) ) THEN + Put_Status(n) = Put_GAttString(COMMENT_GATTNAME, Comment, & + Message_Log=Message_Log ) + END IF + + ! The ID_TAG + n = n + 1 + IF ( PRESENT( ID_Tag ) ) THEN + Put_Status(n) = Put_GAttString(ID_TAG_GATTNAME, ID_Tag, & + Message_Log=Message_Log ) + END IF + + ! Check for any errors + IF ( ANY( Put_Status /= SUCCESS ) ) Error_Status = WARNING + + CONTAINS + + FUNCTION Put_GAttString(GAttName, GAttString, Message_Log) RESULT(Error_Status) + CHARACTER(*), INTENT(IN) :: GAttName + CHARACTER(*), INTENT(IN) :: GAttString + CHARACTER(*), OPTIONAL, INTENT(IN) :: Message_Log + INTEGER :: Error_Status + INTEGER :: NF90_Status + Error_Status = SUCCESS + NF90_Status = NF90_PUT_ATT( NC_FileID, & + NF90_GLOBAL, & + TRIM(GAttName), & + TRIM(GAttString) ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = WARNING + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//TRIM(GAttName)//' attribute to '//& + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + END IF + END FUNCTION Put_GAttString + + END FUNCTION Write_TauCoeff_GAtts + + +!-------------------------------------------------------------------------------- +! +! NAME: +! Read_TauCoeff_GAtts +! +! PURPOSE: +! Function to read the global attributes from a netCDF TauCoeff data file. +! +! CALLING SEQUENCE: +! Error_Status = Read_TauCoeff_GAtts( NC_Filename, & ! Input +! NC_FileID, & ! Input +! Title = Title, & ! Optional output +! History = History, & ! Optional output +! Sensor_Name = Sensor_Name, & ! Optional output +! Platform_Name = Platform_Name, & ! Optional output +! Comment = Comment, & ! Optional output +! ID_Tag = ID_Tag, & ! Optional output +! Message_Log = Message_Log ) ! Error messaging +! +! INPUT ARGUMENTS: +! NC_Filename: Character string specifying the name of the +! netCDF TauCoeff format data file to create. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! NC_FileID: NetCDF file ID number returned from the +! Open_ or Create_TauCoeff_netCDF() function. +! UNITS: N/A +! TYPE: Integer +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! +! OPTIONAL INPUT ARGUMENTS: +! 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: OPTIONAL, INTENT(IN) +! +! OPTIONAL OUTPUT ARGUMENTS: +! Title: Character string written into the TITLE global +! attribute field of the netCDF TauCoeff file. +! Should contain a succinct description of what +! is in the netCDF datafile. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! History: Character string written into the HISTORY global +! attribute field of the netCDF TauCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! Sensor_Name: Character string written into the SENSOR_NAME +! global attribute field of the netCDF TauCoeff +! file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! Platform_Name: Character string written into the PLATFORM_NAME +! global attribute field of the netCDF TauCoeff +! file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! Comment: Character string written into the COMMENT global +! attribute field of the netCDF TauCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! ID_Tag: Character string written into the ID_TAG global +! attribute field of the netCDF TauCoeff file. +! Should contain a short tag used to identify the +! dependent profile set used to generate the +! coefficient data. +! UNITS: N/A +! TYPE: CHARACTER(*) +! 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 global attribute read was successful +! == FAILURE an error occurred reading the requested +! global attribute(s). +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!-------------------------------------------------------------------------------- + + FUNCTION Read_TauCoeff_GAtts( NC_Filename, & ! Input + NC_FileID, & ! Input + Title, & ! Optional output + History, & ! Optional output + Sensor_Name, & ! Optional output + Platform_Name, & ! Optional output + Comment, & ! Optional output + ID_Tag, & ! Optional output + Message_Log ) & ! Error messaging + RESULT ( Error_Status ) + ! Arguments + CHARACTER(*), INTENT(IN) :: NC_Filename + INTEGER, INTENT(IN) :: NC_FileID + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Sensor_Name + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Platform_Name + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + CHARACTER(*), OPTIONAL, INTENT(OUT) :: ID_Tag + CHARACTER(*), OPTIONAL, INTENT(IN) :: Message_Log + ! Function result + INTEGER :: Error_Status + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Read_TauCoeff_GAtts' + INTEGER, PARAMETER :: nGetGAtts = 6 + ! Local variables + INTEGER :: Get_Status(nGetGAtts), n + + ! Set up + Error_Status = SUCCESS + Get_Status = SUCCESS + n = 0 + + ! The TITLE + n = n + 1 + IF ( PRESENT( Title ) ) THEN + Get_Status(n) = Get_GAttString(TITLE_GATTNAME, Title, & + Message_Log=Message_Log ) + END IF + + ! The HISTORY + n = n + 1 + IF ( PRESENT( History ) ) THEN + Get_Status(n) = Get_GAttString(HISTORY_GATTNAME, History, & + Message_Log=Message_Log ) + END IF + + ! The SENSOR_NAME + n = n + 1 + IF ( PRESENT( Sensor_Name ) ) THEN + Get_Status(n) = Get_GAttString(SENSOR_NAME_GATTNAME, Sensor_Name, & + Message_Log=Message_Log ) + END IF + + ! The PLATFORM_NAME + n = n + 1 + IF ( PRESENT( Platform_Name ) ) THEN + Get_Status(n) = Get_GAttString(PLATFORM_NAME_GATTNAME, Platform_Name, & + Message_Log=Message_Log ) + END IF + + ! The COMMENT + n = n + 1 + IF ( PRESENT( Comment ) ) THEN + Get_Status(n) = Get_GAttString(COMMENT_GATTNAME, Comment, & + Message_Log=Message_Log ) + END IF + + ! The ID_Tag + n = n + 1 + IF ( PRESENT( ID_TAG ) ) THEN + Get_Status(n) = Get_GAttString(ID_TAG_GATTNAME, ID_Tag, & + Message_Log=Message_Log ) + END IF + + ! Check for any errors + IF ( ANY( Get_Status /= SUCCESS ) ) Error_Status = WARNING + + CONTAINS + + FUNCTION Get_GAttString(GAttName, GAttString, Message_Log) RESULT(Error_Status) + CHARACTER(*), INTENT(IN) :: GAttName + CHARACTER(*), INTENT(OUT) :: GAttString + CHARACTER(*), OPTIONAL, INTENT(IN) :: Message_Log + INTEGER :: Error_Status + CHARACTER( 10000 ) :: LongString + GAttString = ' ' + LongString = ' ' + Error_Status = Get_netCDF_Attribute( NC_FileID, & + TRIM(GAttName), & + LongString, & + Message_Log = Message_Log ) + IF ( Error_Status /= SUCCESS ) THEN + Error_Status = WARNING + CALL Display_Message( ROUTINE_NAME, & + 'Error reading '//TRIM(GAttName)//& + ' attribute from '//TRIM( NC_Filename ), & + Error_Status, & + Message_Log = Message_Log ) + END IF + CALL Remove_NULL_Characters( LongString ) + GAttString = LongString(1:MIN( LEN(GAttString), LEN_TRIM(LongString) )) + END FUNCTION Get_GAttString + + END FUNCTION Read_TauCoeff_GAtts + + +!-------------------------------------------------------------------------------- +! +! NAME: +! Create_TauCoeff_netCDF +! +! PURPOSE: +! Function to create a netCDF TauCoeff data file for writing. +! +! CALLING SEQUENCE: +! Error_Status = Create_TauCoeff_netCDF( NC_Filename, & ! Input +! n_Orders, & ! Input +! n_Predictors, & ! Input +! n_Absorbers, & ! Input +! n_Channels, & ! Input +! NC_FileID, & ! Output +! Title = Title, & ! Optional input +! History = History, & ! Optional input +! Sensor_Name = Sensor_Name, & ! Optional input +! Platform_Name = Platform_Name, & ! Optional input +! Comment = Comment, & ! Optional input +! ID_Tag = ID_Tag, & ! Optional input +! Message_Log = Message_Log ) ! Error messaging +! +! INPUT ARGUMENTS: +! NC_Filename: Character string specifying the name of the +! netCDF TauCoeff format data file to create. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! n_Orders: The maximum order of polynomial used to reconstruct +! the gas absorption coefficients. +! NOTE: The data arrays using this dimension value are +! dimensioned as 0:n_Orders, where the +! 0'th term is the offset. Therefore the actual +! number of array elements along this dimension +! is n_Orders+1 +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! n_Predictors: The number of predictor functions used in generating +! the TauCoeff data. +! NOTE: The data arrays using this dimension value are +! dimensioned as 0:n_Predictors, where the 0'th +! term is the offset. Therefore the actual number +! of array elements along this dimension is +! n_Predictors+1 +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! n_Absorbers: The number of absorbers dimension of the TauCoeff data. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! n_Channels: The number of channels dimension of the TauCoeff data. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! +! OPTIONAL INPUT ARGUMENTS: +! Title: Character string written into the TITLE global +! attribute field of the netCDF TauCoeff file. +! Should contain a succinct description of what +! is in the netCDF datafile. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(IN) +! +! History: Character string written into the HISTORY global +! attribute field of the netCDF TauCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(IN) +! +! Sensor_Name: Character string written into the SENSOR_NAME +! global attribute field of the netCDF TauCoeff +! file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(IN) +! +! Platform_Name: Character string written into the PLATFORM_NAME +! global attribute field of the netCDF TauCoeff +! file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(IN) +! +! Comment: Character string written into the COMMENT global +! attribute field of the netCDF TauCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(IN) +! +! ID_Tag: Character string written into the ID_TAG global +! attribute field of the netCDF TauCoeff file. +! Should contain a short tag used to identify the +! dependent profile set used to generate the +! coefficient data. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(IN) +! +! 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: OPTIONAL, INTENT(IN) +! +! OUTPUT ARGUMENTS: +! NC_FileID: NetCDF file ID number to be used for subsequent +! writing to the output file. +! UNITS: N/A +! TYPE: Integer +! 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 netCDF file creation was successful. +! == FAILURE an unrecoverable error occurred. +! == WARNING an error occurred writing any of the requested +! global file attributes. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +! SIDE EFFECTS: +! - If the output data file already exists, it is overwritten. +! - The created netCDF file is in DATA mode upon exiting this function. +! - If a FAILURE error occurs, the created netCDF file is closed. +! +!-------------------------------------------------------------------------------- + + FUNCTION Create_TauCoeff_netCDF( NC_Filename, & ! Input + n_Orders, & ! Input + n_Predictors, & ! Input + n_Absorbers, & ! Input + n_Channels, & ! Input + NC_FileID, & ! Output + Title, & ! Optional input + History, & ! Optional input + Sensor_Name, & ! Optional input + Platform_Name, & ! Optional input + Comment, & ! Optional input + ID_Tag, & ! Optional input + Message_Log ) & ! Error messaging + RESULT ( Error_Status ) + ! Arguments + CHARACTER(*), INTENT(IN) :: NC_Filename + INTEGER, INTENT(IN) :: n_Orders + INTEGER, INTENT(IN) :: n_Predictors + INTEGER, INTENT(IN) :: n_Absorbers + INTEGER, INTENT(IN) :: n_Channels + INTEGER, INTENT(OUT) :: NC_FileID + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Sensor_Name + CHARACTER(*), OPTIONAL, INTENT(IN) :: Platform_Name + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + CHARACTER(*), OPTIONAL, INTENT(IN) :: ID_Tag + CHARACTER(*), OPTIONAL, INTENT(IN) :: Message_Log + ! Function result + INTEGER :: Error_Status + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Create_TauCoeff_netCDF' + ! Local variables + INTEGER :: NF90_Status + INTEGER :: NF90_Status1, NF90_Status2 + INTEGER :: Order_dimID + INTEGER :: Predictor_dimID + INTEGER :: Absorber_dimID + INTEGER :: Channel_dimID + INTEGER :: StrLen_dimID + INTEGER :: varID + TYPE(TauCoeff_type) :: TCdummy + + ! Set up + Error_Status = SUCCESS + + ! Check dimensions + IF ( n_Orders < 1 .OR. & + n_Predictors < 1 .OR. & + n_Absorbers < 1 .OR. & + n_Channels < 1 ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'All dimensions must be > 0.', & + Error_Status, & + Message_Log = Message_Log ) + RETURN + END IF + + ! Create the data file + NF90_Status = NF90_CREATE( NC_Filename, & + NF90_CLOBBER, & + NC_FileID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error creating '//TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + RETURN + END IF + + ! Define the dimensions + ! + ! The maximum polynomial order. Note that the defined + ! dimension value is "n + 1" as the array elements for + ! this dimension ranges from 0 -> n. + Error_Status = Def_Dim(ORDER_DIMNAME, n_Orders+1, Order_DimID ) + IF ( Error_Status /= SUCCESS ) RETURN + + ! The number of predictors. Note that the defined + ! dimension value is "n + 1" as the array elements for + ! this dimension ranges from 0 -> n. + Error_Status = Def_Dim(PREDICTOR_DIMNAME, n_Predictors+1, Predictor_DimID ) + IF ( Error_Status /= SUCCESS ) RETURN + + ! The number of sensor channels + Error_Status = Def_Dim(CHANNEL_DIMNAME, n_Channels, Channel_DimID ) + IF ( Error_Status /= SUCCESS ) RETURN + + ! The number of absorbers + Error_Status = Def_Dim(ABSORBER_DIMNAME, n_Absorbers, Absorber_DimID ) + IF ( Error_Status /= SUCCESS ) RETURN + + ! The Sensor_Descriptor string length + Error_Status = Def_Dim(STRLEN_DIMNAME, TCDummy%StrLen, StrLen_DimID ) + IF ( Error_Status /= SUCCESS ) RETURN + + ! Write the global attributes + Error_Status = Write_TauCoeff_GAtts( TRIM( NC_Filename ), & + NC_FileID, & + Title = Title, & + History = History, & + Sensor_Name = Sensor_Name, & + Platform_Name = Platform_Name, & + Comment = Comment, & + ID_Tag = ID_Tag, & + Message_Log = Message_Log ) + IF ( Error_Status /= SUCCESS ) THEN + Error_Status = WARNING + CALL Display_Message( ROUTINE_NAME, & + 'Error writing global attributes to '// & + TRIM( NC_Filename ), & + Error_Status, & + Message_Log = Message_Log ) + END IF + + ! Define the variables + ! + ! Define the release variable + NF90_Status = NF90_DEF_VAR( NC_FileID, & + RELEASE_VARNAME, & + RELEASE_TYPE, & + varid = varID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error defining '//RELEASE_VARNAME//' variable in '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + NF90_Status = NF90_PUT_ATT( NC_FileID, & + varID, & + LONGNAME_ATTNAME, & + RELEASE_LONGNAME ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//RELEASE_VARNAME//' variable attributes to '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + + ! Define the version variable + NF90_Status = NF90_DEF_VAR( NC_FileID, & + VERSION_VARNAME, & + VERSION_TYPE, & + varid = varID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error defining '//VERSION_VARNAME//' variable in '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + NF90_Status = NF90_PUT_ATT( NC_FileID, & + varID, & + LONGNAME_ATTNAME, & + VERSION_LONGNAME ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//VERSION_VARNAME//' variable attributes to '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + + ! Define the Sensor descriptor variable + NF90_Status = NF90_DEF_VAR( NC_FileID, & + SENSOR_DESCRIPTOR_VARNAME, & + SENSOR_DESCRIPTOR_TYPE, & + dimids = (/ StrLen_DimID, Channel_DimID /), & + varid = VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error defining '//SENSOR_DESCRIPTOR_VARNAME//' variable in '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + NF90_Status = NF90_PUT_ATT( NC_FileID, & + VarID, & + LONGNAME_ATTNAME, & + SENSOR_DESCRIPTOR_LONGNAME ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//SENSOR_DESCRIPTOR_VARNAME//' variable attributes to '// & + TRIM( NC_fileNAME )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + + ! Define the NCEP Sensor ID variable + NF90_Status = NF90_DEF_VAR( NC_FileID, & + NCEP_SENSOR_ID_VARNAME, & + NCEP_SENSOR_ID_TYPE, & + dimids = Channel_DimID, & + varid = VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error defining '//NCEP_SENSOR_ID_VARNAME//' variable in '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + NF90_Status = NF90_PUT_ATT( NC_FileID, & + VarID, & + LONGNAME_ATTNAME, & + NCEP_SENSOR_ID_LONGNAME ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//NCEP_SENSOR_ID_VARNAME//' variable attributes to '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + + ! Define the WMO satellite ID variable + NF90_Status = NF90_DEF_VAR( NC_FileID, & + WMO_SATELLITE_ID_VARNAME, & + WMO_SATELLITE_ID_TYPE, & + dimids = Channel_DimID, & + varid = VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error defining '//WMO_SATELLITE_ID_VARNAME//' variable in '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + NF90_Status = NF90_PUT_ATT( NC_FileID, & + VarID, & + LONGNAME_ATTNAME, & + WMO_SATELLITE_ID_LONGNAME ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//WMO_SATELLITE_ID_VARNAME//' variable attributes to '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + + ! Define the WMO Sensor ID variable + NF90_Status = NF90_DEF_VAR( NC_FileID, & + WMO_SENSOR_ID_VARNAME, & + WMO_SENSOR_ID_TYPE, & + dimids = Channel_DimID, & + varid = VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error defining '//WMO_SENSOR_ID_VARNAME//' variable in '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + NF90_Status = NF90_PUT_ATT( NC_FileID, & + VarID, & + LONGNAME_ATTNAME, & + WMO_SENSOR_ID_LONGNAME ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//WMO_SENSOR_ID_VARNAME//' variable attributes to '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + + ! Define the Sensor channel list variable + NF90_Status = NF90_DEF_VAR( NC_FileID, & + SENSOR_CHANNEL_VARNAME, & + SENSOR_CHANNEL_TYPE, & + dimids = Channel_DimID, & + varid = VarID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error defining '//SENSOR_CHANNEL_VARNAME//' variable in '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + NF90_Status = NF90_PUT_ATT( NC_FileID, & + VarID, & + LONGNAME_ATTNAME, & + SENSOR_CHANNEL_LONGNAME ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//SENSOR_CHANNEL_VARNAME//' variable attributes to '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + + ! Define the Absorber ID variable + NF90_Status = NF90_DEF_VAR( NC_FileID, & + ABSORBER_ID_VARNAME, & + ABSORBER_ID_TYPE, & + dimids = Absorber_dimID, & + varid = varID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error defining '//ABSORBER_ID_VARNAME//' variable in '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + NF90_Status1 = NF90_PUT_ATT( NC_FileID, & + VarID, & + LONGNAME_ATTNAME, & + ABSORBER_ID_LONGNAME ) + NF90_Status2 = NF90_PUT_ATT( NC_FileID, & + VarID, & + UNITS_ATTNAME, & + ABSORBER_ID_UNITS ) + IF ( NF90_Status1 /= NF90_NOERR .OR. & + NF90_Status2 /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//ABSORBER_ID_VARNAME//' variable attributes to '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + + ! Define the Alpha value variable + NF90_Status = NF90_DEF_VAR( NC_FileID, & + ALPHA_VARNAME, & + ALPHA_TYPE, & + dimids = Absorber_dimID, & + varid = varID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error defining '//ALPHA_VARNAME//' variable in '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + NF90_Status1 = NF90_PUT_ATT( NC_FileID, & + VarID, & + LONGNAME_ATTNAME, & + ALPHA_LONGNAME ) + + NF90_Status2 = NF90_PUT_ATT( NC_FileID, & + VarID, & + UNITS_ATTNAME, & + ALPHA_UNITS ) + IF ( NF90_Status1 /= NF90_NOERR .OR. & + NF90_Status2 /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//ALPHA_VARNAME//' variable attributes to '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + + ! Define the Alpha C1 value variable + NF90_Status = NF90_DEF_VAR( NC_FileID, & + ALPHA_C1_VARNAME, & + ALPHA_C1_TYPE, & + dimids = Absorber_dimID, & + varid = varID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error defining '//ALPHA_C1_VARNAME//' variable in '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + NF90_Status1 = NF90_PUT_ATT( NC_FileID, & + VarID, & + LONGNAME_ATTNAME, & + ALPHA_C1_LONGNAME ) + NF90_Status2 = NF90_PUT_ATT( NC_FileID, & + VarID, & + UNITS_ATTNAME, & + ALPHA_C1_UNITS ) + IF ( NF90_Status1 /= NF90_NOERR .OR. & + NF90_Status2 /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//ALPHA_C1_VARNAME//' variable attributes to '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + + ! Define the Alpha C2 value variable + NF90_Status = NF90_DEF_VAR( NC_FileID, & + ALPHA_C2_VARNAME, & + ALPHA_C2_TYPE, & + dimids = Absorber_dimID, & + varid = varID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error defining '//ALPHA_C2_VARNAME//' variable in '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + NF90_Status1 = NF90_PUT_ATT( NC_FileID, & + VarID, & + LONGNAME_ATTNAME, & + ALPHA_C2_LONGNAME ) + NF90_Status2 = NF90_PUT_ATT( NC_FileID, & + VarID, & + UNITS_ATTNAME, & + ALPHA_C2_UNITS ) + IF ( NF90_Status1 /= NF90_NOERR .OR. & + NF90_Status2 /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//ALPHA_C2_VARNAME//' variable attributes to '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + + ! Define the Order indices variable + NF90_Status = NF90_DEF_VAR( NC_FileID, & + ORDER_INDEX_VARNAME, & + ORDER_INDEX_TYPE, & + dimids = (/ Predictor_dimID, & + Absorber_dimID, & + Channel_dimID /), & + varid = varID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error defining '//ORDER_INDEX_VARNAME//' variable in '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + NF90_Status1 = NF90_PUT_ATT( NC_FileID, & + VarID, & + LONGNAME_ATTNAME, & + ORDER_INDEX_LONGNAME ) + NF90_Status2 = NF90_PUT_ATT( NC_FileID, & + VarID, & + UNITS_ATTNAME, & + ORDER_INDEX_UNITS ) + IF ( NF90_Status1 /= NF90_NOERR .OR. & + NF90_Status2 /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//ORDER_INDEX_VARNAME//' variable attributes to '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + + ! Define the Predictor indices variable + NF90_Status = NF90_DEF_VAR( NC_FileID, & + PREDICTOR_INDEX_VARNAME, & + PREDICTOR_INDEX_TYPE, & + dimids = (/ Predictor_dimID, & + Absorber_dimID, & + Channel_dimID /), & + varid = varID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error defining '//PREDICTOR_INDEX_VARNAME//' variable in '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + NF90_Status1 = NF90_PUT_ATT( NC_FileID, & + VarID, & + LONGNAME_ATTNAME, & + PREDICTOR_INDEX_LONGNAME ) + + NF90_Status2 = NF90_PUT_ATT( NC_FileID, & + VarID, & + UNITS_ATTNAME, & + PREDICTOR_INDEX_UNITS ) + IF ( NF90_Status1 /= NF90_NOERR .OR. & + NF90_Status2 /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//PREDICTOR_INDEX_VARNAME//' variable attributes to '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + + ! Define the Gas absorption coefficients variable + NF90_Status = NF90_DEF_VAR( NC_FileID, & + TAU_COEFFICIENTS_VARNAME, & + TAU_COEFFICIENTS_TYPE, & + dimids = (/ Order_dimID, & + Predictor_dimID, & + Absorber_dimID, & + Channel_dimID /), & + varid = varID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error defining '//TAU_COEFFICIENTS_VARNAME//' variable in '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + NF90_Status1 = NF90_PUT_ATT( NC_FileID, & + VarID, & + LONGNAME_ATTNAME, & + TAU_COEFFICIENTS_LONGNAME ) + NF90_Status2 = NF90_PUT_ATT( NC_FileID, & + VarID, & + UNITS_ATTNAME, & + TAU_COEFFICIENTS_UNITS ) + IF ( NF90_Status1 /= NF90_NOERR .OR. & + NF90_Status2 /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error writing '//TAU_COEFFICIENTS_VARNAME//' variable attributes to '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + + ! Take the netcdf file out of define mode + NF90_Status = NF90_ENDDEF( NC_FileID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error taking file '//TRIM( NC_Filename )// & + ' out of define mode - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + RETURN + END IF + + CONTAINS + + FUNCTION Def_Dim(DimName, DimSize, DimID) RESULT(Error_Status) + CHARACTER(*), INTENT(IN) :: DimName + INTEGER, INTENT(IN) :: DimSize + INTEGER, INTENT(OUT) :: DimID + INTEGER :: Error_Status + INTEGER :: NF90_Status + Error_Status = SUCCESS + NF90_Status = NF90_DEF_DIM( NC_FileID, & + TRIM(DimName), & + DimSize, & + DimID ) + IF ( NF90_Status /= NF90_NOERR ) THEN + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + 'Error defining the '//TRIM(DimName)//' dimension in '// & + TRIM( NC_Filename )//' - '// & + TRIM( NF90_STRERROR( NF90_Status ) ), & + Error_Status, & + Message_Log = Message_Log ) + NF90_Status = NF90_CLOSE( NC_FileID ) + END IF + END FUNCTION Def_Dim + + END FUNCTION Create_TauCoeff_netCDF + + +!################################################################################ +!################################################################################ +!## ## +!## ## PUBLIC MODULE ROUTINES ## ## +!## ## +!################################################################################ +!################################################################################ + +!-------------------------------------------------------------------------------- +! +! NAME: +! Inquire_TauCoeff_netCDF +! +! PURPOSE: +! Function to inquire a netCDF TauCoeff format file to obtain the +! dimension values and global attributes. +! +! CALLING SEQUENCE: +! Error_Status = Inquire_TauCoeff_netCDF( NC_Filename, & ! Input +! n_Orders = n_Orders, & ! Optional output +! n_Predictors = n_Predictors, & ! Optional output +! n_Absorbers = n_Absorbers, & ! Optional output +! n_Channels = n_Channels, & ! Optional output +! Release = Release, & ! Optional Output +! Version = Version, & ! Optional Output +! Title = Title, & ! Optional output +! History = History, & ! Optional output +! Sensor_Name = Sensor_Name, & ! Optional output +! Platform_Name = Platform_Name, & ! Optional output +! Comment = Comment, & ! Optional output +! ID_Tag = ID_Tag, & ! Optional output +! RCS_Id = RCS_Id, & ! Revision control +! Message_Log = Message_Log ) ! Error messaging +! +! INPUT ARGUMENTS: +! NC_Filename: Character string specifying the name of the netCDF TauCoeff +! format data file. Used only for message output. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUT ARGUMENTS: +! 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: OPTIONAL, INTENT(IN) +! +! OPTIONAL OUTPUT ARGUMENTS: +! n_Orders: The maximum polynomial order used in reconstructing +! the gas absorption coefficients. +! NOTE: The data arrays using this dimension value are +! dimensioned as 0:n_Orders, where the +! 0'th term is the offset. Therefore the actual +! number of array elements along this dimension +! is n_Orders+1 +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! n_Predictors: The number of predictor functions used in generating +! the TauCoeff data. +! NOTE: The data arrays using this dimension value are +! dimensioned as 0:n_Predictors, where the 0'th +! term is the offset. Therefore the actual number +! of array elements along this dimension is +! n_Predictors+1 +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! n_Absorbers: The number of absorbers dimension of the TauCoeff data. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! n_Channels: The number of channels dimension of the TauCoeff data. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! Release: The TauCoeff data/file release number. Used to check +! for data/software mismatch. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! Version: The TauCoeff data/file version number. Used for +! purposes only in identifying the dataset for +! a particular release. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! Title: Character string written into the TITLE global +! attribute field of the netCDF TauCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! History: Character string written into the HISTORY global +! attribute field of the netCDF TauCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! Sensor_Name: Character string written into the SENSOR_NAME global +! attribute field of the netCDF TauCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! Platform_Name: Character string written into the PLATFORM_NAME global +! attribute field of the netCDF TauCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! Comment: Character string written into the COMMENT global +! attribute field of the netCDF TauCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! ID_Tag: Character string written into the ID_TAG global +! attribute field of the netCDF TauCoeff file. +! Should contain a short tag used to identify the +! dependent profile set used to generate the +! coefficient data. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! RCS_Id: Character string containing the Revision Control +! System Id field for the module. +! UNITS: N/A +! TYPE: CHARACTER(*) +! 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 netCDF file inquiry was successful +! == FAILURE an error occurred reading any of the +! requested data. +! == WARNING an error occurred closing the netCDF +! file after a successful read. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +!-------------------------------------------------------------------------------- + + FUNCTION Inquire_TauCoeff_netCDF( NC_Filename, & ! Input + n_Orders, & ! Optional output + n_Predictors, & ! Optional output + n_Absorbers, & ! Optional output + n_Channels, & ! Optional output + Release, & ! Optional output + Version, & ! Optional output + Title, & ! Optional output + History, & ! Optional output + Sensor_Name, & ! Optional output + Platform_Name, & ! Optional output + Comment, & ! Optional output + ID_Tag, & ! Optional output + RCS_Id, & ! Revision control + Message_Log ) & ! Error messaging + RESULT ( Error_Status ) + ! Arguments + CHARACTER(*), INTENT(IN) :: NC_Filename + INTEGER, OPTIONAL, INTENT(OUT) :: n_Orders + INTEGER, OPTIONAL, INTENT(OUT) :: n_Predictors + INTEGER, OPTIONAL, INTENT(OUT) :: n_Absorbers + INTEGER, OPTIONAL, INTENT(OUT) :: n_Channels + INTEGER, OPTIONAL, INTENT(OUT) :: Release + INTEGER, OPTIONAL, INTENT(OUT) :: Version + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Sensor_Name + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Platform_Name + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + CHARACTER(*), OPTIONAL, INTENT(OUT) :: ID_Tag + CHARACTER(*), OPTIONAL, INTENT(OUT) :: RCS_Id + CHARACTER(*), OPTIONAL, INTENT(IN) :: Message_Log + ! Function result + INTEGER :: Error_Status + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Inquire_TauCoeff_netCDF' + ! Function variables + CHARACTER(256) :: Message + INTEGER :: Close_Status + INTEGER :: NC_FileID + INTEGER :: iOrder + INTEGER :: iPredictor + + ! Set up + Error_Status = SUCCESS + IF ( PRESENT( RCS_Id ) ) RCS_Id = MODULE_RCS_ID + + ! Open the file + Error_Status = Open_TauCoeff_netCDF( TRIM( NC_Filename ), & + NC_FileID, & + Mode = 'READ' ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error opening netCDF TauCoeff data file '//TRIM( NC_Filename ) + GOTO 2000 + END IF + + ! Get the dimensions + ! + ! The maximum polynomial order + IF ( PRESENT( n_Orders ) ) THEN + Error_Status = Get_netCDF_Dimension( NC_FileID, & + ORDER_DIMNAME, & + iOrder, & + Message_Log = Message_Log ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error obtaining '//ORDER_DIMNAME//' dimension from '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + ! Subtract one to account for the 0'th term. + n_Orders = iOrder - 1 + END IF + + ! The number of predictors + IF ( PRESENT( n_Predictors ) ) THEN + Error_Status = Get_netCDF_Dimension( NC_FileID, & + PREDICTOR_DIMNAME, & + iPredictor, & + Message_Log = Message_Log ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error obtaining '//PREDICTOR_DIMNAME//' dimension from '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + ! Subtract one to account for the 0'th term. + n_Predictors = iPredictor - 1 + END IF + + ! The number of absorbers + IF ( PRESENT( n_Absorbers ) ) THEN + Error_Status = Get_netCDF_Dimension( NC_FileID, & + ABSORBER_DIMNAME, & + n_Absorbers, & + Message_Log = Message_Log ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error obtaining '//ABSORBER_DIMNAME//' dimension from '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + END IF + + ! The number of channels + IF ( PRESENT( n_Channels ) ) THEN + Error_Status = Get_netCDF_Dimension( NC_FileID, & + CHANNEL_DIMNAME, & + n_Channels, & + Message_Log = Message_Log ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error obtaining '//CHANNEL_DIMNAME//' dimension from '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + END IF + + + ! Get release/version information + ! + ! File release + IF ( PRESENT( Release ) ) THEN + Error_Status = Get_netCDF_Variable( NC_FileID, & + RELEASE_VARNAME, & + Release, & + Message_Log = Message_Log ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error obtaining '//RELEASE_VARNAME//' value from '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + END IF + + ! File version + IF ( PRESENT( Version ) ) THEN + Error_Status = Get_netCDF_Variable( NC_FileID, & + VERSION_VARNAME, & + Version, & + Message_Log = Message_Log ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error obtaining '//VERSION_VARNAME//' value from '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + END IF + + ! Get the global attributes + Error_Status = Read_TauCoeff_GAtts( TRIM( NC_Filename ), & + NC_FileID, & + Title = Title, & + History = History, & + Sensor_Name = Sensor_Name, & + Platform_Name = Platform_Name, & + Comment = Comment, & + ID_Tag = ID_Tag, & + Message_Log = Message_Log ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error reading global attribute from '// & + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! Close the file + Close_Status = Close_TauCoeff_netCDF( NC_FileID ) + IF ( Close_Status /= SUCCESS ) THEN + Error_Status = WARNING + CALL Display_Message( ROUTINE_NAME, & + 'Error closing netCDF TauCoeff data file '// & + TRIM( NC_Filename ), & + Error_Status, & + Message_Log = Message_Log ) + END IF + + RETURN + + + !#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=# + !# -= CLEAN UP AFTER AN ERROR -= # + !#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=# + + 1000 CONTINUE + Close_Status = Close_TauCoeff_netCDF(NC_FileID) + IF ( Close_Status /= SUCCESS ) & + Message = TRIM(Message)//'; Error closing input file during error cleanup.' + + 2000 CONTINUE + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + TRIM( Message ), & + Error_Status, & + Message_Log=Message_Log ) + + END FUNCTION Inquire_TauCoeff_netCDF + + +!-------------------------------------------------------------------------------- +! +! NAME: +! Write_TauCoeff_netCDF +! +! PURPOSE: +! Function to write TauCoeff data to a netCDF format TauCoeff file. +! +! CALLING SEQUENCE: +! Error_Status = Write_TauCoeff_netCDF( NC_Filename, & ! Input +! TauCoeff, & ! Input +! Title = Title, & ! Optional input +! History = History, & ! Optional input +! Sensor_Name = Sensor_Name, & ! Optional input +! Platform_Name = Platform_Name, & ! Optional input +! Comment = Comment, & ! Optional input +! ID_Tag = ID_Tag, & ! Optional input +! Quiet = Quiet, & ! Optional input +! RCS_Id = RCS_Id, & ! Revision control +! Message_Log = Message_Log ) ! Error messaging +! +! INPUT ARGUMENTS: +! NC_Filename: Character string specifying the name of the output +! netCDF TauCoeff format data file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! TauCoeff: Structure to write to file. +! UNITS: N/A +! TYPE: TauCoeff_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUT ARGUMENTS: +! Title: Character string written into the TITLE global +! attribute field of the netCDF TauCoeff file. +! Should contain a succinct description of what +! is in the netCDF datafile. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(IN) +! +! History: Character string written into the HISTORY global +! attribute field of the netCDF TauCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(IN) +! +! Sensor_Name: Character string written into the SENSOR_NAME +! global attribute field of the netCDF TauCoeff +! file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(IN) +! +! Platform_Name: Character string written into the PLATFORM_NAME +! global attribute field of the netCDF TauCoeff +! file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(IN) +! +! Comment: Character string written into the COMMENT global +! attribute field of the netCDF TauCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(IN) +! +! ID_Tag: Character string written into the ID_TAG global +! attribute field of the netCDF TauCoeff file. +! Should contain a short tag used to identify the +! dependent profile set used to generate the +! coefficient data. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(IN) +! +! Quiet: Set this keyword 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: OPTIONAL, INTENT(IN) +! +! 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: OPTIONAL, INTENT(IN) +! +! OPTIONAL OUTPUT ARGUMENTS: +! RCS_Id: Character string containing the Revision Control +! System Id field for the module. +! UNITS: N/A +! TYPE: CHARACTER(*) +! 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 netCDF file write was successful +! == FAILURE - the input TauCoeff structure contains +! unassociated pointer members, or +! - a unrecoverable write error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +! SIDE EFFECTS: +! If the output file exists, it is overwritten. +! +!-------------------------------------------------------------------------------- + + FUNCTION Write_TauCoeff_netCDF( NC_Filename, & ! Input + TauCoeff, & ! Input + Title, & ! Optional input + History, & ! Optional input + Sensor_Name, & ! Optional input + Platform_Name, & ! Optional input + Comment, & ! Optional input + ID_Tag, & ! Optional input + Quiet, & ! Optional input + RCS_Id, & ! Revision control + Message_Log ) & ! Error messaging + RESULT ( Error_Status ) + ! Arguments + CHARACTER(*), INTENT(IN) :: NC_Filename + TYPE(TauCoeff_type), INTENT(IN) :: TauCoeff + CHARACTER(*), OPTIONAL, INTENT(IN) :: Title + CHARACTER(*), OPTIONAL, INTENT(IN) :: History + CHARACTER(*), OPTIONAL, INTENT(IN) :: Sensor_Name + CHARACTER(*), OPTIONAL, INTENT(IN) :: Platform_Name + CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment + CHARACTER(*), OPTIONAL, INTENT(IN) :: ID_Tag + INTEGER, OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(OUT) :: RCS_Id + CHARACTER(*), OPTIONAL, INTENT(IN) :: Message_Log + ! Function result + INTEGER :: Error_Status + ! Local parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Write_TauCoeff_netCDF' + ! Local variables + CHARACTER(256) :: Message + LOGICAL :: Noisy + INTEGER :: NC_FileID + INTEGER :: Close_Status + + ! Set up + Error_Status = SUCCESS + IF ( PRESENT( RCS_Id ) ) RCS_Id = MODULE_RCS_ID + + ! Output informational messages.... + Noisy = .TRUE. + ! ....unless the QUIET keyword is set. + IF ( PRESENT( Quiet ) ) THEN + IF ( Quiet == 1 ) Noisy = .FALSE. + END IF + + ! Check structure association + IF ( .NOT. Associated_TauCoeff( TauCoeff ) ) THEN + Message = 'Some or all INPUT TauCoeff pointer members are NOT associated.' + GOTO 2000 + END IF + + ! Check structure release + Error_Status = Check_TauCoeff_Release( TauCoeff, & + Message_Log = Message_Log ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'TauCoeff Release check failed.' + GOTO 2000 + END IF + + ! Create the output file + Error_Status = Create_TauCoeff_netCDF( NC_Filename, & + TauCoeff%n_Orders, & + TauCoeff%n_Predictors, & + TauCoeff%n_Absorbers, & + TauCoeff%n_Channels, & + NC_FileID, & + Title = Title, & + History = History, & + Sensor_Name = Sensor_Name, & + Platform_Name = Platform_Name, & + Comment = Comment, & + ID_Tag = ID_Tag, & + Message_Log = Message_Log ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error creating output netCDF TauCoeff file '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! Write the TauCoeff data + ! + ! The Release number + Error_Status = Put_netCDF_Variable( NC_FileID, & + RELEASE_VARNAME, & + TauCoeff%Release ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing '//RELEASE_VARNAME//' number to '// & + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The Version number + Error_Status = Put_netCDF_Variable( NC_FileID, & + VERSION_VARNAME, & + TauCoeff%Version ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing '//VERSION_VARNAME//' number to '// & + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The sensor descriptor + Error_Status = Put_netCDF_Variable( NC_FileID, & + SENSOR_DESCRIPTOR_VARNAME, & + TauCoeff%Sensor_Descriptor ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing '//SENSOR_DESCRIPTOR_VARNAME//' to '// & + TRIM( NC_fileNAME ) + GOTO 1000 + END IF + + ! The NCEP_SENSOR_ID + Error_Status = Put_netCDF_Variable( NC_FileID, & + NCEP_SENSOR_ID_VARNAME, & + TauCoeff%NCEP_Sensor_ID ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing '//NCEP_SENSOR_ID_VARNAME//' to '// & + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The WMO_SATELLITE_ID + Error_Status = Put_netCDF_Variable( NC_FileID, & + WMO_SATELLITE_ID_VARNAME, & + TauCoeff%WMO_Satellite_ID ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing '//WMO_SATELLITE_ID_VARNAME//' to '// & + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The WMO_SENSOR_ID + Error_Status = Put_netCDF_Variable( NC_FileID, & + WMO_SENSOR_ID_VARNAME, & + TauCoeff%WMO_Sensor_ID ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing '//WMO_SENSOR_ID_VARNAME//' to '// & + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The channel list + Error_Status = Put_netCDF_Variable( NC_FileID, & + SENSOR_CHANNEL_VARNAME, & + TauCoeff%Sensor_Channel ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing '//SENSOR_CHANNEL_VARNAME//' to '// & + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The absorber ID + Error_Status = Put_netCDF_Variable( NC_FileID, & + ABSORBER_ID_VARNAME, & + TauCoeff%Absorber_ID ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing '//ABSORBER_ID_VARNAME//' to '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The Alpha value + Error_Status = Put_netCDF_Variable( NC_FileID, & + ALPHA_VARNAME, & + TauCoeff%Alpha ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing '//ALPHA_VARNAME//' to '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The Alpha_C1 value + Error_Status = Put_netCDF_Variable( NC_FileID, & + ALPHA_C1_VARNAME, & + TauCoeff%Alpha_C1 ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing '//ALPHA_C1_VARNAME//' to '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The Alpha_C2 value + Error_Status = Put_netCDF_Variable( NC_FileID, & + ALPHA_C2_VARNAME, & + TauCoeff%Alpha_C2 ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing '//ALPHA_C2_VARNAME//' to '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The polynomial order indices + Error_Status = Put_netCDF_Variable( NC_FileID, & + ORDER_INDEX_VARNAME, & + TauCoeff%Order_Index ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing '//ORDER_INDEX_VARNAME//' to '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The predictor indices + Error_Status = Put_netCDF_Variable( NC_FileID, & + PREDICTOR_INDEX_VARNAME, & + TauCoeff%Predictor_Index ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing '//PREDICTOR_INDEX_VARNAME//' to '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The gas absorption coefficients + Error_Status = Put_netCDF_Variable( NC_FileID, & + TAU_COEFFICIENTS_VARNAME, & + TauCoeff%C ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error writing '//TAU_COEFFICIENTS_VARNAME//' to '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! Close the file + Close_Status = Close_TauCoeff_netCDF( NC_FileID ) + IF ( Error_Status /= SUCCESS ) THEN + CALL Display_Message( ROUTINE_NAME, & + 'Error closing netCDF TauCoeff data file '// & + TRIM( NC_Filename ), & + WARNING, & + Message_Log = Message_Log ) + END IF + + ! Outut an info message + IF ( Noisy ) THEN + CALL Info_TauCoeff( TauCoeff, message ) + CALL Display_Message( ROUTINE_NAME, & + 'FILE: '//TRIM( NC_Filename )//'; '//TRIM( Message ), & + INFORMATION, & + Message_Log = Message_Log ) + END IF + + RETURN + + + !#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=# + !# -= CLEAN UP AFTER AN ERROR -= # + !#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=# + + 1000 CONTINUE + Close_Status = Close_TauCoeff_netCDF(NC_FileID) + IF ( Close_Status /= SUCCESS ) & + Message = TRIM(Message)//'; Error closing output file during error cleanup.' + + 2000 CONTINUE + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + TRIM( Message ), & + Error_Status, & + Message_Log = Message_Log ) + + END FUNCTION Write_TauCoeff_netCDF + + +!-------------------------------------------------------------------------------- +! +! NAME: +! Read_TauCoeff_netCDF +! +! PURPOSE: +! Function to read data from a netCDF format TauCoeff file. +! +! CALLING SEQUENCE: +! Error_Status = Read_TauCoeff_netCDF( NC_Filename, & ! Input +! TauCoeff, & ! Output +! Quiet = Quiet, & ! Optional input +! Title = Title, & ! Optional output +! History = History, & ! Optional output +! Sensor_Name = Sensor_Name, & ! Optional output +! Platform_Name = Platform_Name, & ! Optional output +! Comment = Comment, & ! Optional output +! ID_Tag = ID_Tag, & ! Optional output +! RCS_Id = RCS_Id, & ! Revision control +! Message_Log = Message_Log ) ! Error messaging +! +! INPUT ARGUMENTS: +! NC_Filename: Character string specifying the name of the netCDF TauCoeff +! format data file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN) +! +! OPTIONAL INPUT ARGUMENTS: +! Quiet: Set this keyword 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: OPTIONAL, INTENT(IN) +! +! 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: OPTIONAL, INTENT(IN) +! +! OUTPUT ARGUMENTS: +! TauCoeff: Structure to contain the gas absorption coefficient +! data read from the file. +! UNITS: N/A +! TYPE: TauCoeff_type +! DIMENSION: Scalar +! ATTRIBUTES: INTENT(IN OUT) +! +! +! OPTIONAL OUTPUT ARGUMENTS: +! Title: Character string written into the TITLE global +! attribute field of the netCDF TauCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! History: Character string written into the HISTORY global +! attribute field of the netCDF TauCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! Sensor_Name: Character string written into the SENSOR_NAME global +! attribute field of the netCDF TauCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! Platform_Name: Character string written into the PLATFORM_NAME global +! attribute field of the netCDF TauCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! Comment: Character string written into the COMMENT global +! attribute field of the netCDF TauCoeff file. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! ID_Tag: Character string written into the ID_TAG global +! attribute field of the netCDF TauCoeff file. +! Should contain a short tag used to identify the +! dependent profile set used to generate the +! coefficient data. +! UNITS: N/A +! TYPE: CHARACTER(*) +! DIMENSION: Scalar +! ATTRIBUTES: OPTIONAL, INTENT(OUT) +! +! RCS_Id: Character string containing the Revision Control +! System Id field for the module. +! UNITS: N/A +! TYPE: CHARACTER(*) +! 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 netCDF file read was successful +! == FAILURE an unrecoverable read error occurred. +! UNITS: N/A +! TYPE: INTEGER +! DIMENSION: Scalar +! +! SIDE EFFECTS: +! If the TauCoeff argument is defined upon input, it is redefined (or +! reinitialised) at output. +! +! COMMENTS: +! Note the INTENT on the output TauCoeff argument is IN OUT rather than +! just OUT. This is necessary because the argument may be defined upon +! input. To prevent memory leaks, the IN OUT INTENT is a must. +! +!-------------------------------------------------------------------------------- + + FUNCTION Read_TauCoeff_netCDF( NC_Filename, & ! Input + TauCoeff, & ! Output + Quiet, & ! Optional input + Title, & ! Optional output + History, & ! Optional output + Sensor_Name, & ! Optional output + Platform_Name, & ! Optional output + Comment, & ! Optional output + ID_Tag, & ! Optional output + RCS_Id, & ! Revision control + Message_Log ) & ! Error messaging + RESULT ( Error_Status ) + ! Arguments + CHARACTER(*), INTENT(IN) :: NC_Filename + TYPE(TauCoeff_type), INTENT(IN OUT) :: TauCoeff + INTEGER, OPTIONAL, INTENT(IN) :: Quiet + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title + CHARACTER(*), OPTIONAL, INTENT(OUT) :: History + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Sensor_Name + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Platform_Name + CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment + CHARACTER(*), OPTIONAL, INTENT(OUT) :: ID_Tag + CHARACTER(*), OPTIONAL, INTENT(OUT) :: RCS_Id + CHARACTER(*), OPTIONAL, INTENT(IN) :: Message_Log + ! Function result + INTEGER :: Error_Status + ! Function parameters + CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'Read_TauCoeff_netCDF' + ! Function variables + CHARACTER(1000) :: Message + LOGICAL :: Noisy + INTEGER :: Destroy_Status + INTEGER :: Close_Status + INTEGER :: NC_FileID + INTEGER :: n_Orders + INTEGER :: n_Predictors + INTEGER :: n_Absorbers + INTEGER :: n_Channels + + ! Set up + Error_Status = SUCCESS + IF ( PRESENT( RCS_Id ) ) RCS_Id = MODULE_RCS_ID + + ! Output informational messages.... + Noisy = .TRUE. + ! ....unless the QUIET keyword is set. + IF ( PRESENT( Quiet ) ) THEN + IF ( Quiet == 1 ) Noisy = .FALSE. + END IF + + ! Inquire the file + Error_Status = Inquire_TauCoeff_netCDF( TRIM( NC_Filename ), & + n_Orders = n_Orders, & + n_Predictors = n_Predictors, & + n_Absorbers = n_Absorbers, & + n_Channels = n_Channels, & + Release = TauCoeff%Release, & + Version = TauCoeff%Version, & + Title = Title, & + History = History, & + Sensor_Name = Sensor_Name, & + Platform_Name = Platform_Name, & + Comment = Comment, & + ID_Tag = ID_Tag, & + Message_Log = Message_Log ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error obtaining TauCoeff dimensions/attributes from '//& + TRIM( NC_Filename ) + GOTO 2000 + END IF + + ! Check the release + Error_Status = Check_TauCoeff_Release( TauCoeff, & + Message_Log=Message_Log ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'TauCoeff Release check failed for '//TRIM( NC_Filename ) + GOTO 2000 + END IF + + ! Allocate the output structure + Error_Status = Allocate_TauCoeff( n_Orders, & + n_Predictors, & + n_Absorbers, & + n_Channels, & + TauCoeff, & + Message_Log = Message_Log ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error occurred allocating TauCoeff structure.' + GOTO 2000 + END IF + + ! Open the file for reading + Error_Status = Open_TauCoeff_netCDF( TRIM( NC_Filename ), & + NC_FileID, & + Mode = 'READ' ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error opening netCDF TauCoeff data file '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! Read the TauCoeff data + ! + ! The sensor descriptor + Error_Status = Get_netCDF_Variable( NC_FileID, & + SENSOR_DESCRIPTOR_VARNAME, & + TauCoeff%Sensor_Descriptor ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error reading '//SENSOR_DESCRIPTOR_VARNAME//' from '// & + TRIM( NC_fileNAME ) + GOTO 1000 + END IF + + ! The NCEP_SENSOR_ID + Error_Status = Get_netCDF_Variable( NC_FileID, & + NCEP_SENSOR_ID_VARNAME, & + TauCoeff%NCEP_Sensor_ID ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error reading '//NCEP_SENSOR_ID_VARNAME//' from '// & + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The WMO_SATELLITE_ID + Error_Status = Get_netCDF_Variable( NC_FileID, & + WMO_SATELLITE_ID_VARNAME, & + TauCoeff%WMO_Satellite_ID ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error reading '//WMO_SATELLITE_ID_VARNAME//' from '// & + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The WMO_SENSOR_ID + Error_Status = Get_netCDF_Variable( NC_FileID, & + WMO_SENSOR_ID_VARNAME, & + TauCoeff%WMO_Sensor_ID ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error reading '//WMO_SENSOR_ID_VARNAME//' from '// & + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The channel list + Error_Status = Get_netCDF_Variable( NC_FileID, & + SENSOR_CHANNEL_VARNAME, & + TauCoeff%Sensor_Channel ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error reading '//SENSOR_CHANNEL_VARNAME//' from '// & + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The absorber ID variable + Error_Status = Get_netCDF_Variable( NC_FileID, & + ABSORBER_ID_VARNAME, & + TauCoeff%Absorber_ID ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error reading '//ABSORBER_ID_VARNAME//' from '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The Alpha value + Error_Status = Get_netCDF_Variable( NC_FileID, & + ALPHA_VARNAME, & + TauCoeff%Alpha ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error reading '//ALPHA_VARNAME//' from '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The Alpha_C1 value + Error_Status = Get_netCDF_Variable( NC_FileID, & + ALPHA_C1_VARNAME, & + TauCoeff%Alpha_C1 ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error reading '//ALPHA_C1_VARNAME//' from '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The Alpha_C2 value + Error_Status = Get_netCDF_Variable( NC_FileID, & + ALPHA_C2_VARNAME, & + TauCoeff%Alpha_C2 ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error reading '//ALPHA_C2_VARNAME//' from '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The order indices + Error_Status = Get_netCDF_Variable( NC_FileID, & + ORDER_INDEX_VARNAME, & + TauCoeff%ORDER_Index ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error reading '//ORDER_INDEX_VARNAME//' from '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The predictor indices + Error_Status = Get_netCDF_Variable( NC_FileID, & + PREDICTOR_INDEX_VARNAME, & + TauCoeff%Predictor_Index ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error reading '//PREDICTOR_INDEX_VARNAME//' from '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! The gas absorption coefficients + Error_Status = Get_netCDF_Variable( NC_FileID, & + TAU_COEFFICIENTS_VARNAME, & + TauCoeff%C ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error reading '//TAU_COEFFICIENTS_VARNAME//' from '//& + TRIM( NC_Filename ) + GOTO 1000 + END IF + + ! Close the file + Close_Status = Close_TauCoeff_netCDF( NC_FileID ) + IF ( Close_Status /= SUCCESS ) THEN + CALL Display_Message( ROUTINE_NAME, & + 'Error closing netCDF TauCoeff data file '// & + TRIM( NC_Filename ), & + WARNING, & + Message_Log = Message_Log ) + END IF + + ! Count the number of sensors + CALL Count_TauCoeff_Sensors( TauCoeff ) + + ! Output an info message + IF ( Noisy ) THEN + CALL Info_TauCoeff( TauCoeff, Message ) + CALL Display_Message( ROUTINE_NAME, & + 'FILE: '//TRIM( NC_Filename )//'; '//TRIM( Message ), & + INFORMATION, & + Message_Log = Message_Log ) + END IF + + RETURN + + + !#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=# + !# -= CLEAN UP AFTER AN ERROR -= # + !#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=# + + 1000 CONTINUE + Destroy_Status = Destroy_TauCoeff(TauCoeff, Message_Log=Message_Log) + IF ( Destroy_Status /= SUCCESS ) & + Message = TRIM(Message)//'; Error destroying TauCoeff during error cleanup.' + Close_Status = Close_TauCoeff_netCDF(NC_FileID) + IF ( Close_Status /= SUCCESS ) & + Message = TRIM(Message)//'; Error closing input file during error cleanup.' + + 2000 CONTINUE + Error_Status = FAILURE + CALL Display_Message( ROUTINE_NAME, & + TRIM( Message ), & + Error_Status, & + Message_Log=Message_Log ) + + END FUNCTION Read_TauCoeff_netCDF + +END MODULE TauCoeff_netCDF_IO diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index ce5fa1b49..d422b2118 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -7,16 +7,6 @@ cmake_minimum_required (VERSION 3.12) project("CRTM_Tests" VERSION 1.0.1 LANGUAGES Fortran C) enable_testing () -## Ecbuild integration -find_package( ecbuild QUIET ) -if(NOT ecbuild_FOUND) - message(WARNING "ecbuild is required for testing and was not found!") - message(WARNING "CRTM tests are disabled!") - return() -endif() - -include( ecbuild_system NO_POLICY_SCOPE ) -ecbuild_declare_project() list( APPEND CMAKE_MODULE_PATH ${CMAKE_CURRENT_SOURCE_DIR}/cmake ) set( CMAKE_DIRECTORY_LABELS ${PROJECT_NAME} ) @@ -41,11 +31,6 @@ function(CREATE_SYMLINK_FILENAME src dst) endforeach(FILENAME) endfunction(CREATE_SYMLINK_FILENAME) -# Create Data directory for test input config and symlink all files -list( APPEND crtm_test_input - testinput/single_profile.yaml -) - file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/testinput) file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/results) file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/results/adjoint) @@ -53,7 +38,7 @@ file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/results/tangent_linear) file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/results/k_matrix) file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/results/forward) file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/results/unit) -CREATE_SYMLINK( ${CMAKE_CURRENT_SOURCE_DIR} ${CMAKE_CURRENT_BINARY_DIR} ${crtm_test_input} ) +#CREATE_SYMLINK( ${CMAKE_CURRENT_SOURCE_DIR} ${CMAKE_CURRENT_BINARY_DIR} ${crtm_test_input} ) if( DEFINED ENV{LOCAL_PATH_JEDI_TESTFILES}) @@ -66,24 +51,28 @@ else() set(CRTM_TEST_ROOT ${CMAKE_CURRENT_SOURCE_DIR}) endif() -set( REPO_VERSION crtm/2.4.1 ) +set( REPO_VERSION crtm/2.4.0 ) # If local path to testfiles is defined don't download -#if( DEFINED LOCAL_PATH_JEDI_TESTFILES ) IF(EXISTS ${CMAKE_SOURCE_DIR}/fix) set( CRTM_COEFFS_PATH ${CMAKE_SOURCE_DIR}/fix ) - message(STATUS "use LOCAL_PATH_JEDI_TESTFILES: ${CRTM_COEFFS_PATH}") - message("Using existing local fix directory instead of downloading.") -# Download CRTM coefficients + message(STATUS "Use CRTM_COEFFS_PATH: ${CRTM_COEFFS_PATH}") + message(STATUS "Using existing local fix/ directory instead of downloading.") + add_custom_target(get_crtm_coeffs) #empty target so tests don't complain about dependency + set(FIX_PREFIX "") else() + # Download CRTM coefficients set( CRTM_COEFFS_PATH ${CMAKE_BINARY_DIR}/test_data/${REPO_VERSION}) file(MAKE_DIRECTORY ${CRTM_COEFFS_PATH}) - set( ECBUILD_DOWNLOAD_BASE_URL https://dashrepo.ucar.edu/api/v1/dataset/147_miesch/version/1.1.0/file ) - set( test_files_dirname crtm_coefficients.tar.gz ) - set( checksum "0") - message(STATUS "download CRTM coeffs files from: ${ECBUILD_DOWNLOAD_BASE_URL} to ${CRTM_COEFFS_PATH}") + set( DOWNLOAD_BASE_URL https://bin.ssec.wisc.edu/pub/s4/CRTM/ ) + + set( test_files_dirname fix_REL-2.4.0_emc_07112023.tgz ) #UPDATE TARBALL FILENAME HERE + set( checksum "ef2cb9d6ac900017e6a0c1c10464a1c6") #MD5SUM, update this if the file above is updated / changed + + message(STATUS "if fix/ does not exist, download CRTM coeffs files from: ${DOWNLOAD_BASE_URL} to ${CRTM_COEFFS_PATH}") + message(STATUS "otherwise, use fix/ for ctests.") list( APPEND CRTM_DATA_DOWNLOADER_ARGS - ${ECBUILD_DOWNLOAD_BASE_URL} + ${DOWNLOAD_BASE_URL} ${CRTM_COEFFS_PATH} ${test_files_dirname} ${checksum} ) @@ -99,45 +88,47 @@ else() configure_file( ${SOURCE_FILE} ${DEST_FILE} @ONLY ) endif() - # add test for downloading data - ecbuild_add_test( TARGET get_crtm_coeffs - TYPE SCRIPT - COMMAND ${CMAKE_BINARY_DIR}/bin/crtm_data_downloader.py - ARGS ${CRTM_DATA_DOWNLOADER_ARGS} ) + # add command to download coefficient data during build step, rather than as a test + add_custom_target(get_crtm_coeffs + COMMAND ${CMAKE_BINARY_DIR}/bin/crtm_data_downloader.py ${CRTM_DATA_DOWNLOADER_ARGS}) + + set(FIX_PREFIX "fix/") + endif() -# Add files to cmake resources -ecbuild_add_resources( TARGET crtm_test_scripts - SOURCES_PACK - ${crtm_test_input} - ) +# create lists of sensor IDs for each type of test. The testing harness will iterate over each item in the list +# verify that the ids added here are present in the long crtm_test_input list toward the end of this file so that +# they will be properly softlinked. -# Create list of sensor ids for testing list( APPEND Simple_Sensor_Ids - atms_npp - cris399_npp - v.abi_gr + atms_n21 + cris-fsr_n21 + v.abi_g17 + abi_g18 modis_aqua ) list( APPEND ScatteringSwitch_Sensor_Ids - atms_npp - cris399_npp - v.abi_gr + atms_n21 + cris-fsr_n21 + v.abi_g17 + abi_g18 modis_aqua ) list( APPEND SOI_Sensor_Ids - atms_npp - cris399_npp - v.abi_gr + atms_n21 + cris-fsr_n21 + v.abi_g17 + abi_g18 modis_aqua ) list( APPEND VerticalCoordinates_Sensor_Ids - atms_npp - cris399_npp - v.abi_gr + atms_n21 + cris-fsr_n21 + v.abi_g17 + abi_g18 modis_aqua ) @@ -147,16 +138,18 @@ list( APPEND SSU_Sensor_Ids ) list( APPEND ClearSky_Sensor_Ids - atms_npp - cris399_npp - v.abi_gr + atms_n21 + cris-fsr_n21 + v.abi_g17 + abi_g18 modis_aqua ) # Create list of sensor ids for testing list( APPEND AOD_Sensor_Ids - cris399_npp - v.abi_gr + cris-fsr_n21 + v.abi_g17 + abi_g18 airs_aqua ) @@ -175,9 +168,10 @@ list( APPEND ChannelSubset_Sensor_Ids ) list( APPEND Aircraft_Sensor_Ids - crisB1_npp + cris-fsr_n21 ) +#add new test types here, should have a corresponding test code in test/mains/* list (APPEND common_tests Simple AOD @@ -191,11 +185,13 @@ list (APPEND common_tests VerticalCoordinates ) +#these will permute with the above common tests list (APPEND regression_types forward k_matrix ) +#these will permute with the below TLAD_tests list (APPEND TLAD_types adjoint tangent_linear @@ -209,39 +205,30 @@ list (APPEND TLAD_tests ##################################################################### -ecbuild_add_test( TARGET test_check_crtm - SOURCES mains/application/check_crtm.F90 - ARGS "testinput/single_profile.yaml" - OMP $ENV{OMP_NUM_THREADS} - LIBS crtm - TEST_DEPENDS get_crtm_coeffs) +add_executable(test_check_crtm mains/application/check_crtm.F90) +target_link_libraries(test_check_crtm PRIVATE crtm) +add_test(NAME test_check_crtm + COMMAND test_check_crtm) +set_tests_properties(test_check_crtm PROPERTIES ENVIRONMENT "OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS}") +add_dependencies(test_check_crtm get_crtm_coeffs) -# ecbuild_add_test( TARGET test_check_crtm_random -# SOURCES mains/application/check_crtm_random_profiles.F90 -# ARGS "testinput/single_profile.yaml" -# OMP $ENV{OMP_NUM_THREADS} -# LIBS crtm -# TEST_DEPENDS get_crtm_coeffs) #--------------------------------------------------------------------------------- -#unit tests -#first upper level Unit_Test +add_executable(Unit_TL_TEST mains/unit/Unit_Test/test_TL.f90) +target_link_libraries(Unit_TL_TEST PRIVATE crtm) +add_test(NAME test_Unit_TL_TEST + COMMAND $) +set_tests_properties(test_Unit_TL_TEST PROPERTIES ENVIRONMENT "OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS}") +add_dependencies(Unit_TL_TEST get_crtm_coeffs) -#implementation of Patrick's modified TL convergence test. -ecbuild_add_executable ( - TARGET "TL_TEST" - SOURCES mains/unit/Unit_Test/test_TL.f90 - LIBS crtm - NOINSTALL - ) -ecbuild_add_test ( - TARGET "Unit_TL_TEST" - COMMAND "TL_TEST" - OMP $ENV{OMP_NUM_THREADS} - TEST_DEPENDS get_crtm_coeffs - ) +add_executable(SpcCoeff_Inspect mains/application/SpcCoeff_Inspect.f90) +target_link_libraries(SpcCoeff_Inspect PRIVATE crtm) +add_test(NAME run_SpcCoeff_Inspect + COMMAND $ "testinput/atms_n21.SpcCoeff.bin") +set_tests_properties(run_SpcCoeff_Inspect PROPERTIES ENVIRONMENT "OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS}") +add_dependencies(SpcCoeff_Inspect get_crtm_coeffs) #================================================================================= #forward and k_matrix regression tests @@ -252,20 +239,17 @@ foreach(regtype IN LISTS regression_types) if (isregtype AND istesttype) continue() #skip Aircraft type for k_Matrix endif() - ecbuild_add_executable( TARGET "test_${regtype}_test_${testtype}" - SOURCES "mains/regression/${regtype}/test_${testtype}/test_${testtype}.f90" - LIBS crtm - NOINSTALL) - + + add_executable(test_${regtype}_test_${testtype} mains/regression/${regtype}/test_${testtype}/test_${testtype}.f90) + target_link_libraries(test_${regtype}_test_${testtype} PRIVATE crtm) + foreach(sensor_id IN LISTS ${testtype}_Sensor_Ids) - - ecbuild_add_test( TARGET "test_${regtype}_${testtype}_${sensor_id}" - OMP $ENV{OMP_NUM_THREADS} - COMMAND "test_${regtype}_test_${testtype}" - ARGS "${sensor_id}" - TEST_DEPENDS get_crtm_coeffs) + add_test(NAME test_${regtype}_${testtype}_${sensor_id} + COMMAND $ "${sensor_id}") + set_tests_properties(test_${regtype}_${testtype}_${sensor_id} PROPERTIES ENVIRONMENT "OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS}") + add_dependencies(test_${regtype}_test_${testtype} get_crtm_coeffs) endforeach() - endforeach() + endforeach() endforeach() @@ -273,22 +257,16 @@ endforeach() #TLAD Regression tests foreach(regtype IN LISTS TLAD_types) foreach(testtype IN LISTS TLAD_tests) - if (isregtype AND istesttype) - continue() #skip Aircraft type for k_Matrix - endif() - ecbuild_add_executable( TARGET "test_${regtype}_test_${testtype}" - SOURCES "mains/regression/${regtype}/test_${testtype}/test_${testtype}.f90" - LIBS crtm - NOINSTALL) - + add_executable(test_${regtype}_test_${testtype} mains/regression/${regtype}/test_${testtype}/test_${testtype}.f90) + target_link_libraries(test_${regtype}_test_${testtype} PRIVATE crtm) + foreach(sensor_id IN LISTS ${testtype}_Sensor_Ids) - ecbuild_add_test( TARGET "test_${regtype}_${testtype}_${sensor_id}" - OMP $ENV{OMP_NUM_THREADS} - COMMAND "test_${regtype}_test_${testtype}" - ARGS "${sensor_id}" - TEST_DEPENDS get_crtm_coeffs) + add_test(NAME test_${regtype}_${testtype}_${sensor_id} + COMMAND $ "${sensor_id}") + set_tests_properties(test_${regtype}_${testtype}_${sensor_id} PROPERTIES ENVIRONMENT "OMP_NUM_THREADS=$ENV{OMP_NUM_THREADS}") + add_dependencies(test_${regtype}_test_${testtype} get_crtm_coeffs) endforeach() - endforeach() + endforeach() endforeach() @@ -297,100 +275,108 @@ endforeach() ##################################################################### list( APPEND crtm_test_input -Test_Input/ECMWF_5K/Big_Endian/ecmwf_5k_atmosphereccol.bin -Test_Input/ECMWF_5K/Big_Endian/ecmwf_5k_surfaceccol.bin -Test_Input/ECMWF_5K/Big_Endian/ecmwf_5k_geometryccol.bin -AerosolCoeff/Big_Endian/AerosolCoeff.bin -AerosolCoeff/netCDF/AerosolCoeff.nc4 -CloudCoeff/Big_Endian/CloudCoeff.bin -EmisCoeff/MW_Water/Big_Endian/FASTEM6.MWwater.EmisCoeff.bin -EmisCoeff/IR_Ice/SEcategory/Big_Endian/NPOESS.IRice.EmisCoeff.bin -EmisCoeff/IR_Ice/SEcategory/netCDF/NPOESS.IRice.EmisCoeff.nc4 -EmisCoeff/IR_Land/SEcategory/Big_Endian/NPOESS.IRland.EmisCoeff.bin -EmisCoeff/IR_Land/SEcategory/netCDF/NPOESS.IRland.EmisCoeff.nc4 -EmisCoeff/IR_Snow/SEcategory/Big_Endian/NPOESS.IRsnow.EmisCoeff.bin -EmisCoeff/IR_Snow/SEcategory/netCDF/NPOESS.IRsnow.EmisCoeff.nc4 -EmisCoeff/VIS_Ice/SEcategory/Big_Endian/NPOESS.VISice.EmisCoeff.bin -EmisCoeff/VIS_Ice/SEcategory/netCDF/NPOESS.VISice.EmisCoeff.nc4 -EmisCoeff/VIS_Land/SEcategory/Big_Endian/NPOESS.VISland.EmisCoeff.bin -EmisCoeff/VIS_Land/SEcategory/netCDF/NPOESS.VISland.EmisCoeff.nc4 -EmisCoeff/VIS_Snow/SEcategory/Big_Endian/NPOESS.VISsnow.EmisCoeff.bin -EmisCoeff/VIS_Snow/SEcategory/netCDF/NPOESS.VISsnow.EmisCoeff.nc4 -EmisCoeff/VIS_Water/SEcategory/Big_Endian/NPOESS.VISwater.EmisCoeff.bin -EmisCoeff/VIS_Water/SEcategory/netCDF/NPOESS.VISwater.EmisCoeff.nc4 -EmisCoeff/IR_Water/Big_Endian/Nalli.IRwater.EmisCoeff.bin -EmisCoeff/IR_Water/netCDF/Nalli.IRwater.EmisCoeff.nc4 -EmisCoeff/IR_Land/SEcategory/Big_Endian/USGS.IRland.EmisCoeff.bin -EmisCoeff/VIS_Land/SEcategory/Big_Endian/USGS.VISland.EmisCoeff.bin -SpcCoeff/Big_Endian/hirs4_metop-a.SpcCoeff.bin -TauCoeff/ODPS/Big_Endian/hirs4_metop-a.TauCoeff.bin -SpcCoeff/Big_Endian/amsua_n19.SpcCoeff.bin -TauCoeff/ODPS/Big_Endian/amsua_n19.TauCoeff.bin -SpcCoeff/Big_Endian/amsua_metop-a.SpcCoeff.bin -TauCoeff/ODPS/Big_Endian/amsua_metop-a.TauCoeff.bin -SpcCoeff/netCDF/amsua_aqua.SpcCoeff.nc -TauCoeff/ODPS/netCDF/amsua_aqua.TauCoeff.nc -SpcCoeff/Big_Endian/gmi_gpm.SpcCoeff.bin -TauCoeff/ODPS/Big_Endian/gmi_gpm.TauCoeff.bin -SpcCoeff/Big_Endian/seviri_m08.SpcCoeff.bin -TauCoeff/ODAS/Big_Endian/seviri_m08.TauCoeff.bin -SpcCoeff/Big_Endian/cris-fsr_npp.SpcCoeff.bin -TauCoeff/ODPS/Big_Endian/cris-fsr_npp.TauCoeff.bin -SpcCoeff/Big_Endian/iasi_metop-a.SpcCoeff.bin -TauCoeff/ODPS/Big_Endian/iasi_metop-a.TauCoeff.bin -SpcCoeff/Big_Endian/iasi_metop-b.SpcCoeff.bin -TauCoeff/ODPS/Big_Endian/iasi_metop-b.TauCoeff.bin -SpcCoeff/Big_Endian/mhs_n19.SpcCoeff.bin -TauCoeff/ODPS/Big_Endian/mhs_n19.TauCoeff.bin -SpcCoeff/Big_Endian/sndrD1_g15.SpcCoeff.bin -TauCoeff/ODPS/Big_Endian/sndrD1_g15.TauCoeff.bin -SpcCoeff/Big_Endian/sndrD2_g15.SpcCoeff.bin -TauCoeff/ODPS/Big_Endian/sndrD2_g15.TauCoeff.bin -SpcCoeff/Big_Endian/sndrD3_g15.SpcCoeff.bin -TauCoeff/ODPS/Big_Endian/sndrD3_g15.TauCoeff.bin -SpcCoeff/Big_Endian/sndrD4_g15.SpcCoeff.bin -TauCoeff/ODPS/Big_Endian/sndrD4_g15.TauCoeff.bin -SpcCoeff/Big_Endian/airs_aqua.SpcCoeff.bin -TauCoeff/ODPS/Big_Endian/airs_aqua.TauCoeff.bin -SpcCoeff/Big_Endian/modis_aqua.SpcCoeff.bin -TauCoeff/ODPS/Big_Endian/modis_aqua.TauCoeff.bin -SpcCoeff/Big_Endian/cris399_npp.SpcCoeff.bin -TauCoeff/ODPS/Big_Endian/cris399_npp.TauCoeff.bin -SpcCoeff/Big_Endian/crisB1_npp.SpcCoeff.bin -TauCoeff/ODPS/Big_Endian/crisB1_npp.TauCoeff.bin -SpcCoeff/Big_Endian/atms_npp.SpcCoeff.bin -TauCoeff/ODPS/Big_Endian/atms_npp.TauCoeff.bin -SpcCoeff/Big_Endian/v.viirs-m_npp.SpcCoeff.bin -TauCoeff/ODAS/Big_Endian/v.viirs-m_npp.TauCoeff.bin -SpcCoeff/Big_Endian/v.abi_gr.SpcCoeff.bin -TauCoeff/ODAS/Big_Endian/v.abi_gr.TauCoeff.bin -TauCoeff/ODPS/Big_Endian/zssmis_f20.TauCoeff.bin -TauCoeff/ODPS/Big_Endian/zssmis_f19.TauCoeff.bin -TauCoeff/ODPS/Big_Endian/zssmis_f18.TauCoeff.bin -TauCoeff/ODPS/Big_Endian/zssmis_f17.TauCoeff.bin -TauCoeff/ODPS/Big_Endian/zssmis_f16.TauCoeff.bin -TauCoeff/ODPS/Big_Endian/ssmis_f20.TauCoeff.bin -TauCoeff/ODPS/Big_Endian/ssmis_f19.TauCoeff.bin -TauCoeff/ODPS/Big_Endian/ssmis_f18.TauCoeff.bin -TauCoeff/ODPS/Big_Endian/ssmis_f17.TauCoeff.bin -TauCoeff/ODPS/Big_Endian/ssmis_f16.TauCoeff.bin -SpcCoeff/Big_Endian/ssmis_f20.SpcCoeff.bin -SpcCoeff/Big_Endian/ssmis_f18.SpcCoeff.bin -SpcCoeff/Big_Endian/ssmis_f19.SpcCoeff.bin -SpcCoeff/Big_Endian/ssmis_f16.SpcCoeff.bin -SpcCoeff/Big_Endian/ssmis_f17.SpcCoeff.bin -TauCoeff/ODPS/Big_Endian/ssu_n06.TauCoeff.bin -TauCoeff/ODPS/Big_Endian/ssu_n07.TauCoeff.bin -TauCoeff/ODPS/Big_Endian/ssu_n08.TauCoeff.bin -TauCoeff/ODPS/Big_Endian/ssu_n09.TauCoeff.bin -TauCoeff/ODPS/Big_Endian/ssu_n11.TauCoeff.bin -TauCoeff/ODPS/Big_Endian/ssu_n14.TauCoeff.bin -SpcCoeff/Big_Endian/ssu_n06.SpcCoeff.bin -SpcCoeff/Big_Endian/ssu_n07.SpcCoeff.bin -SpcCoeff/Big_Endian/ssu_n08.SpcCoeff.bin -SpcCoeff/Big_Endian/ssu_n09.SpcCoeff.bin -SpcCoeff/Big_Endian/ssu_n11.SpcCoeff.bin -SpcCoeff/Big_Endian/ssu_n14.SpcCoeff.bin +${FIX_PREFIX}AerosolCoeff/Big_Endian/AerosolCoeff.bin +${FIX_PREFIX}AerosolCoeff/netCDF/AerosolCoeff.nc4 +${FIX_PREFIX}CloudCoeff/Big_Endian/CloudCoeff.bin +${FIX_PREFIX}EmisCoeff/MW_Water/Big_Endian/FASTEM6.MWwater.EmisCoeff.bin +${FIX_PREFIX}EmisCoeff/IR_Ice/SEcategory/Big_Endian/NPOESS.IRice.EmisCoeff.bin +${FIX_PREFIX}EmisCoeff/IR_Land/SEcategory/Big_Endian/NPOESS.IRland.EmisCoeff.bin +${FIX_PREFIX}EmisCoeff/IR_Snow/SEcategory/Big_Endian/NPOESS.IRsnow.EmisCoeff.bin +${FIX_PREFIX}EmisCoeff/VIS_Ice/SEcategory/Big_Endian/NPOESS.VISice.EmisCoeff.bin +${FIX_PREFIX}EmisCoeff/VIS_Land/SEcategory/Big_Endian/NPOESS.VISland.EmisCoeff.bin +${FIX_PREFIX}EmisCoeff/VIS_Snow/SEcategory/Big_Endian/NPOESS.VISsnow.EmisCoeff.bin +${FIX_PREFIX}EmisCoeff/VIS_Water/SEcategory/Big_Endian/NPOESS.VISwater.EmisCoeff.bin +${FIX_PREFIX}EmisCoeff/IR_Water/Big_Endian/Nalli.IRwater.EmisCoeff.bin +${FIX_PREFIX}EmisCoeff/IR_Land/SEcategory/Big_Endian/USGS.IRland.EmisCoeff.bin +${FIX_PREFIX}EmisCoeff/VIS_Land/SEcategory/Big_Endian/USGS.VISland.EmisCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/hirs4_metop-a.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/hirs4_metop-a.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/amsua_n19.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/amsua_n19.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/amsua_metop-a.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/amsua_metop-a.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/gmi_gpm.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/gmi_gpm.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/seviri_m08.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODAS/Big_Endian/seviri_m08.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/cris-fsr_npp.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/cris-fsr_npp.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/cris_n20.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/cris_n20.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/cris-fsr_n21.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/cris-fsr_n21.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/iasi_metop-a.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/iasi_metop-a.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/iasi_metop-b.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/iasi_metop-b.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/mhs_n19.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/mhs_n19.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/sndrD1_g15.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/sndrD1_g15.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/sndrD2_g15.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/sndrD2_g15.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/sndrD3_g15.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/sndrD3_g15.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/sndrD4_g15.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/sndrD4_g15.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/airs_aqua.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/airs_aqua.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/modis_aqua.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/modis_aqua.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/cris399_npp.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/cris399_npp.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/crisB1_npp.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/crisB1_npp.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/atms_npp.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/atms_npp.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/v.viirs-m_npp.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODAS/Big_Endian/v.viirs-m_npp.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/atms_n20.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/atms_n20.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/atms_n21.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/atms_n21.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/abi_g18.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/abi_g18.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/v.abi_g17.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODAS/Big_Endian/v.abi_g17.TauCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/zssmis_f20.TauCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/zssmis_f19.TauCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/zssmis_f18.TauCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/zssmis_f17.TauCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/zssmis_f16.TauCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/ssmis_f20.TauCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/ssmis_f19.TauCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/ssmis_f18.TauCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/ssmis_f17.TauCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/ssmis_f16.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/ssmis_f20.SpcCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/ssmis_f18.SpcCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/ssmis_f19.SpcCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/ssmis_f16.SpcCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/ssmis_f17.SpcCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/ssu_n06.TauCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/ssu_n07.TauCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/ssu_n08.TauCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/ssu_n09.TauCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/ssu_n11.TauCoeff.bin +${FIX_PREFIX}TauCoeff/ODPS/Big_Endian/ssu_n14.TauCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/ssu_n06.SpcCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/ssu_n07.SpcCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/ssu_n08.SpcCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/ssu_n09.SpcCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/ssu_n11.SpcCoeff.bin +${FIX_PREFIX}SpcCoeff/Big_Endian/ssu_n14.SpcCoeff.bin +${FIX_PREFIX}SpcCoeff/netcdf/atms_n21.SpcCoeff.nc +${FIX_PREFIX}SpcCoeff/netcdf/viirs-i_n21.SpcCoeff.nc +${FIX_PREFIX}SpcCoeff/netcdf/atms_n21-srf.SpcCoeff.nc +${FIX_PREFIX}SpcCoeff/netcdf/mhs_metop-c.SpcCoeff.nc +${FIX_PREFIX}SpcCoeff/netcdf/v.viirs-m_j2.SpcCoeff.nc +${FIX_PREFIX}SpcCoeff/netcdf/cris-fsr_n21.SpcCoeff.nc +${FIX_PREFIX}SpcCoeff/netcdf/v.viirs-i_n21.SpcCoeff.nc +${FIX_PREFIX}SpcCoeff/netcdf/viirs-m_n21.SpcCoeff.nc +${FIX_PREFIX}SpcCoeff/netcdf/v.viirs-m_n21.SpcCoeff.nc +${FIX_PREFIX}SpcCoeff/netcdf/amsua_metop-c_v2.SpcCoeff.nc +${FIX_PREFIX}SpcCoeff/netcdf/v.viirs-i_j2.SpcCoeff.nc ) # Symlink all CRTM files diff --git a/test/cmake/Modules/FindNetCDF.cmake b/test/cmake/Modules/FindNetCDF.cmake deleted file mode 100644 index f2fc6ac51..000000000 --- a/test/cmake/Modules/FindNetCDF.cmake +++ /dev/null @@ -1,343 +0,0 @@ -# (C) Copyright 2017-2020 UCAR -# -# This software is licensed under the terms of the Apache Licence Version 2.0 -# which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -# -# (C) Copyright 2011- ECMWF. -# -# This software is licensed under the terms of the Apache Licence Version 2.0 -# which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -# In applying this licence, ECMWF does not waive the privileges and immunities -# granted to it by virtue of its status as an intergovernmental organisation nor -# does it submit to any jurisdiction. -# -# Try to find NetCDF includes and library. -# Supports static and shared libaries and allows each component to be found in sepearte prefixes. -# -# This module defines -# -# - NetCDF_FOUND - System has NetCDF -# - NetCDF_INCLUDE_DIRS - the NetCDF include directories -# - NetCDF_VERSION - the version of NetCDF -# - NetCDF_CONFIG_EXECUTABLE - the netcdf-config executable if found -# - NetCDF_PARALLEL - Boolean True if NetCDF4 has parallel IO support via hdf5 and/or pnetcdf -# - NetCDF_HAS_PNETCDF - Boolean True if NetCDF4 has pnetcdf support -# -# Deprecated Defines -# - NetCDF_LIBRARIES - [Deprecated] Use NetCDF::NetCDF_ targets instead. -# -# -# Following components are available: -# -# - C - C interface to NetCDF (netcdf) -# - CXX - CXX4 interface to NetCDF (netcdf_c++4) -# - Fortran - Fortran interface to NetCDF (netcdff) -# -# For each component the following are defined: -# -# - NetCDF__FOUND - whether the component is found -# - NetCDF__LIBRARIES - the libraries for the component -# - NetCDF__LIBRARY_SHARED - Boolean is true if libraries for component are shared -# - NetCDF__INCLUDE_DIRS - the include directories for specified component -# - NetCDF::NetCDF_ - target of component to be used with target_link_libraries() -# -# The following paths will be searched in order if set in CMake (first priority) or environment (second priority) -# -# - NetCDF_ROOT - root of NetCDF installation -# - NetCDF_PATH - root of NetCDF installation -# -# The search process begins with locating NetCDF Include headers. If these are in a non-standard location, -# set one of the following CMake or environment variables to point to the location: -# -# - NetCDF_INCLUDE_DIR or NetCDF_${comp}_INCLUDE_DIR -# - NetCDF_INCLUDE_DIRS or NetCDF_${comp}_INCLUDE_DIR -# -# Notes: -# -# - Use "NetCDF::NetCDF_" targets only. NetCDF_LIBRARIES exists for backwards compatibility and should not be used. -# - These targets have all the knowledge of include directories and library search directories, and a single -# call to target_link_libraries will provide all these transitive properties to your target. Normally all that is -# needed to build and link against NetCDF is, e.g.: -# target_link_libraries(my_c_tgt PUBLIC NetCDF::NetCDF_C) -# - "NetCDF" is always the preferred naming for this package, its targets, variables, and environment variables -# - For compatibility, some variables are also set/checked using alternate names NetCDF4, NETCDF, or NETCDF4 -# - Environments relying on these older environment variable names should move to using a "NetCDF_ROOT" environment variable -# - Preferred component capitalization follows the CMake LANGUAGES variables: i.e., C, Fortran, CXX -# - For compatibility, alternate capitalizations are supported but should not be used. -# - If no components are defined, all components will be searched -# - -list( APPEND _possible_components C CXX Fortran ) - -## Include names for each component -set( NetCDF_C_INCLUDE_NAME netcdf.h ) -set( NetCDF_CXX_INCLUDE_NAME netcdf ) -set( NetCDF_Fortran_INCLUDE_NAME netcdf.mod ) - -## Library names for each component -set( NetCDF_C_LIBRARY_NAME netcdf ) -set( NetCDF_CXX_LIBRARY_NAME netcdf_c++4 ) -set( NetCDF_Fortran_LIBRARY_NAME netcdff ) - -## Enumerate search components -foreach( _comp ${_possible_components} ) - string( TOUPPER "${_comp}" _COMP ) - set( _arg_${_COMP} ${_comp} ) - set( _name_${_COMP} ${_comp} ) -endforeach() - -set( _search_components C) -foreach( _comp ${${CMAKE_FIND_PACKAGE_NAME}_FIND_COMPONENTS} ) - string( TOUPPER "${_comp}" _COMP ) - set( _arg_${_COMP} ${_comp} ) - list( APPEND _search_components ${_name_${_COMP}} ) - if( NOT _name_${_COMP} ) - message(SEND_ERROR "Find${CMAKE_FIND_PACKAGE_NAME}: COMPONENT ${_comp} is not a valid component. Valid components: ${_possible_components}" ) - endif() -endforeach() -list( REMOVE_DUPLICATES _search_components ) - -## Search hints for finding include directories and libraries -foreach( _comp IN ITEMS "_" "_C_" "_Fortran_" "_CXX_" ) - foreach( _name IN ITEMS NetCDF4 NetCDF NETCDF4 NETCDF ) - foreach( _var IN ITEMS ROOT PATH ) - list(APPEND _search_hints ${${_name}${_comp}${_var}} $ENV{${_name}${_comp}${_var}} ) - list(APPEND _include_search_hints - ${${_name}${_comp}INCLUDE_DIR} $ENV{${_name}${_comp}INCLUDE_DIR} - ${${_name}${_comp}INCLUDE_DIRS} $ENV{${_name}${_comp}INCLUDE_DIRS} ) - endforeach() - endforeach() -endforeach() -#Old-school HPC module env variable names -foreach( _name IN ITEMS NetCDF4 NetCDF NETCDF4 NETCDF ) - foreach( _comp IN ITEMS "_C" "_Fortran" "_CXX" ) - list(APPEND _search_hints ${${_name}} $ENV{${_name}}) - list(APPEND _search_hints ${${_name}${_comp}} $ENV{${_name}${_comp}}) - endforeach() -endforeach() - -## Find headers for each component -set(NetCDF_INCLUDE_DIRS) -set(_new_search_components) -foreach( _comp IN LISTS _search_components ) - if(NOT ${PROJECT_NAME}_NetCDF_${_comp}_FOUND) - list(APPEND _new_search_components ${_comp}) - endif() - find_file(NetCDF_${_comp}_INCLUDE_FILE - NAMES ${NetCDF_${_comp}_INCLUDE_NAME} - DOC "NetCDF ${_comp} include directory" - HINTS ${_include_search_hints} ${_search_hints} - PATH_SUFFIXES include include/netcdf - ) - mark_as_advanced(NetCDF_${_comp}_INCLUDE_FILE) - message(DEBUG "NetCDF_${_comp}_INCLUDE_FILE: ${NetCDF_${_comp}_INCLUDE_FILE}") - if( NetCDF_${_comp}_INCLUDE_FILE ) - get_filename_component(NetCDF_${_comp}_INCLUDE_FILE ${NetCDF_${_comp}_INCLUDE_FILE} ABSOLUTE) - get_filename_component(NetCDF_${_comp}_INCLUDE_DIR ${NetCDF_${_comp}_INCLUDE_FILE} DIRECTORY) - list(APPEND NetCDF_INCLUDE_DIRS ${NetCDF_${_comp}_INCLUDE_DIR}) - endif() -endforeach() -if(NetCDF_INCLUDE_DIRS) - list(REMOVE_DUPLICATES NetCDF_INCLUDE_DIRS) -endif() -set(NetCDF_INCLUDE_DIRS "${NetCDF_INCLUDE_DIRS}" CACHE STRING "NetCDF Include directory paths" FORCE) - -## Find n*-config executables for search components -foreach( _comp IN LISTS _search_components ) - if( _comp MATCHES "^(C)$" ) - set(_conf "c") - elseif( _comp MATCHES "^(Fortran)$" ) - set(_conf "f") - elseif( _comp MATCHES "^(CXX)$" ) - set(_conf "cxx4") - endif() - find_program( NetCDF_${_comp}_CONFIG_EXECUTABLE - NAMES n${_conf}-config - HINTS ${NetCDF_INCLUDE_DIRS} ${_include_search_hints} ${_search_hints} - PATH_SUFFIXES bin Bin ../bin ../../bin - DOC "NetCDF n${_conf}-config helper" ) - message(DEBUG "NetCDF_${_comp}_CONFIG_EXECUTABLE: ${NetCDF_${_comp}_CONFIG_EXECUTABLE}") -endforeach() - -set(_C_libs_flag --libs) -set(_Fortran_libs_flag --flibs) -set(_CXX_libs_flag --libs) -set(_C_includes_flag --includedir) -set(_Fortran_includes_flag --includedir) -set(_CXX_includes_flag --includedir) -function(netcdf_config exec flag output_var) - set(${output_var} False PARENT_SCOPE) - if( exec ) - execute_process( COMMAND ${exec} ${flag} RESULT_VARIABLE _ret OUTPUT_VARIABLE _val) - if( _ret EQUAL 0 ) - string( STRIP ${_val} _val ) - set( ${output_var} ${_val} PARENT_SCOPE ) - endif() - endif() -endfunction() - -## Find libraries for each component -set( NetCDF_LIBRARIES ) -foreach( _comp IN LISTS _search_components ) - string( TOUPPER "${_comp}" _COMP ) - - find_library( NetCDF_${_comp}_LIBRARY - NAMES ${NetCDF_${_comp}_LIBRARY_NAME} - DOC "NetCDF ${_comp} library" - HINTS ${NetCDF_${_comp}_INCLUDE_DIRS} ${_search_hints} - PATH_SUFFIXES lib64 lib ../lib64 ../lib ../../lib64 ../../lib ) - mark_as_advanced( NetCDF_${_comp}_LIBRARY ) - get_filename_component(NetCDF_${_comp}_LIBRARY ${NetCDF_${_comp}_LIBRARY} ABSOLUTE) - set(NetCDF_${_comp}_LIBRARY ${NetCDF_${_comp}_LIBRARY} CACHE STRING "NetCDF ${_comp} library" FORCE) - message(DEBUG "NetCDF_${_comp}_LIBRARY: ${NetCDF_${_comp}_LIBRARY}") - - - if( NetCDF_${_comp}_LIBRARY ) - if( NetCDF_${_comp}_LIBRARY MATCHES ".a$" ) - set( NetCDF_${_comp}_LIBRARY_SHARED FALSE ) - set( _library_type STATIC) - else() - if( NOT ${NetCDF_${_comp}_LIBRARY} IN_LIST NetCDF_LIBRARIES ) - list( APPEND NetCDF_LIBRARIES ${NetCDF_${_comp}_LIBRARY} ) - message(DEBUG "Adding new netcdf library [${_comp}]: ${NetCDF_${_comp}_LIBRARY}") - endif() - set( NetCDF_${_comp}_LIBRARY_SHARED TRUE ) - set( _library_type SHARED) - endif() - endif() - - #Use nc-config to set per-component LIBRARIES variable if possible - netcdf_config( ${NetCDF_${_comp}_CONFIG_EXECUTABLE} ${_${_comp}_libs_flag} _val ) - if( _val ) - set( NetCDF_${_comp}_LIBRARIES ${_val} ) - if(NOT NetCDF_${_comp}_LIBRARY_SHARED AND NOT NetCDF_${_comp}_FOUND) #Static targets should use nc_config to get a proper link line with all necessary static targets. - list( APPEND NetCDF_LIBRARIES ${NetCDF_${_comp}_LIBRARIES} ) - endif() - else() - set( NetCDF_${_comp}_LIBRARIES ${NetCDF_${_comp}_LIBRARY} ) - if(NOT NetCDF_${_comp}_LIBRARY_SHARED) - message(SEND_ERROR "Unable to properly find NetCDF. Found static libraries at: ${NetCDF_${_comp}_LIBRARY} but could not run nc-config: ${NetCDF_CONFIG_EXECUTABLE}") - endif() - endif() - - #Use nc-config to set per-component INCLUDE_DIRS variable if possible - netcdf_config( ${NetCDF_${_comp}_CONFIG_EXECUTABLE} ${_${_comp}_includes_flag} _val ) - if( _val ) - string( REPLACE " " ";" _val ${_val} ) - set( NetCDF_${_comp}_INCLUDE_DIRS ${_val} ) - else() - set( NetCDF_${_comp}_INCLUDE_DIRS ${NetCDF_${_comp}_INCLUDE_DIR} ) - endif() - - if( NetCDF_${_comp}_LIBRARIES AND NetCDF_${_comp}_INCLUDE_DIRS ) - set( ${CMAKE_FIND_PACKAGE_NAME}_${_arg_${_COMP}}_FOUND TRUE ) - if (NOT TARGET NetCDF::NetCDF_${_comp}) - add_library(NetCDF::NetCDF_${_comp} ${_library_type} IMPORTED) - set_target_properties(NetCDF::NetCDF_${_comp} PROPERTIES - IMPORTED_LOCATION ${NetCDF_${_comp}_LIBRARY} - INTERFACE_INCLUDE_DIRECTORIES "${NetCDF_${_comp}_INCLUDE_DIRS}" - INTERFACE_LINK_LIBRARIES ${NetCDF_${_comp}_LIBRARIES} ) - endif() - endif() -endforeach() -set(NetCDF_LIBRARIES "${NetCDF_LIBRARIES}" CACHE STRING "NetCDF library targets" FORCE) - -## Find version via netcdf-config if possible -if (NetCDF_INCLUDE_DIRS) - if( NetCDF_C_CONFIG_EXECUTABLE ) - netcdf_config( ${NetCDF_C_CONFIG_EXECUTABLE} --version _vers ) - if( _vers ) - string(REGEX REPLACE ".* ((([0-9]+)\\.)+([0-9]+)).*" "\\1" NetCDF_VERSION "${_vers}" ) - endif() - else() - foreach( _dir IN LISTS NetCDF_INCLUDE_DIRS) - if( EXISTS "${_dir}/netcdf_meta.h" ) - file(STRINGS "${_dir}/netcdf_meta.h" _netcdf_version_lines - REGEX "#define[ \t]+NC_VERSION_(MAJOR|MINOR|PATCH|NOTE)") - string(REGEX REPLACE ".*NC_VERSION_MAJOR *\([0-9]*\).*" "\\1" _netcdf_version_major "${_netcdf_version_lines}") - string(REGEX REPLACE ".*NC_VERSION_MINOR *\([0-9]*\).*" "\\1" _netcdf_version_minor "${_netcdf_version_lines}") - string(REGEX REPLACE ".*NC_VERSION_PATCH *\([0-9]*\).*" "\\1" _netcdf_version_patch "${_netcdf_version_lines}") - string(REGEX REPLACE ".*NC_VERSION_NOTE *\"\([^\"]*\)\".*" "\\1" _netcdf_version_note "${_netcdf_version_lines}") - set(NetCDF_VERSION "${_netcdf_version_major}.${_netcdf_version_minor}.${_netcdf_version_patch}${_netcdf_version_note}") - unset(_netcdf_version_major) - unset(_netcdf_version_minor) - unset(_netcdf_version_patch) - unset(_netcdf_version_note) - unset(_netcdf_version_lines) - endif() - endforeach() - endif() -endif () - -## Detect additional package properties -netcdf_config(${NetCDF_C_CONFIG_EXECUTABLE} --has-parallel4 _val) -if( NOT _val MATCHES "^(yes|no)$" ) - netcdf_config(${NetCDF_C_CONFIG_EXECUTABLE} --has-parallel _val) -endif() -if( _val MATCHES "^(yes)$" ) - set(NetCDF_PARALLEL TRUE CACHE STRING "NetCDF has parallel IO capability via pnetcdf or hdf5." FORCE) -else() - set(NetCDF_PARALLEL FALSE CACHE STRING "NetCDF has no parallel IO capability." FORCE) -endif() - -## Finalize find_package -include(FindPackageHandleStandardArgs) - -if(NOT NetCDF_FOUND OR _new_search_components) - find_package_handle_standard_args( ${CMAKE_FIND_PACKAGE_NAME} - REQUIRED_VARS NetCDF_INCLUDE_DIRS NetCDF_LIBRARIES - VERSION_VAR NetCDF_VERSION - HANDLE_COMPONENTS ) -endif() - -foreach( _comp IN LISTS _search_components ) - if( NetCDF_${_comp}_FOUND ) - #Record found components to avoid duplication in NetCDF_LIBRARIES for static libraries - set(NetCDF_${_comp}_FOUND ${NetCDF_${_comp}_FOUND} CACHE BOOL "NetCDF ${_comp} Found" FORCE) - #Set a per-package, per-component found variable to communicate between multiple calls to find_package() - set(${PROJECT_NAME}_NetCDF_${_comp}_FOUND True) - endif() -endforeach() - -if( ${CMAKE_FIND_PACKAGE_NAME}_FOUND AND NOT ${CMAKE_FIND_PACKAGE_NAME}_FIND_QUIETLY AND _new_search_components) - message( STATUS "Find${CMAKE_FIND_PACKAGE_NAME} [${CMAKE_CURRENT_LIST_DIR}/FindNetCDF.cmake]:" ) - message( STATUS " - NetCDF_VERSION [${NetCDF_VERSION}]") - message( STATUS " - NetCDF_PARALLEL [${NetCDF_PARALLEL}]") - foreach( _comp IN LISTS _new_search_components ) - string( TOUPPER "${_comp}" _COMP ) - message( STATUS " - NetCDF_${_comp}_CONFIG_EXECUTABLE [${NetCDF_${_comp}_CONFIG_EXECUTABLE}]") - if( ${CMAKE_FIND_PACKAGE_NAME}_${_arg_${_COMP}}_FOUND ) - get_filename_component(_root ${NetCDF_${_comp}_INCLUDE_DIR}/.. ABSOLUTE) - if( NetCDF_${_comp}_LIBRARY_SHARED ) - message( STATUS " - NetCDF::NetCDF_${_comp} [SHARED] [Root: ${_root}] Lib: ${NetCDF_${_comp}_LIBRARY} ") - else() - message( STATUS " - NetCDF::NetCDF_${_comp} [STATIC] [Root: ${_root}] Lib: ${NetCDF_${_comp}_LIBRARY} ") - endif() - endif() - endforeach() -endif() - -foreach( _prefix NetCDF NetCDF4 NETCDF NETCDF4 ${CMAKE_FIND_PACKAGE_NAME} ) - set( ${_prefix}_INCLUDE_DIRS ${NetCDF_INCLUDE_DIRS} ) - set( ${_prefix}_LIBRARIES ${NetCDF_LIBRARIES}) - set( ${_prefix}_VERSION ${NetCDF_VERSION} ) - set( ${_prefix}_FOUND ${${CMAKE_FIND_PACKAGE_NAME}_FOUND} ) - set( ${_prefix}_CONFIG_EXECUTABLE ${NetCDF_CONFIG_EXECUTABLE} ) - set( ${_prefix}_PARALLEL ${NetCDF_PARALLEL} ) - - foreach( _comp ${_search_components} ) - string( TOUPPER "${_comp}" _COMP ) - set( _arg_comp ${_arg_${_COMP}} ) - set( ${_prefix}_${_comp}_FOUND ${${CMAKE_FIND_PACKAGE_NAME}_${_arg_comp}_FOUND} ) - set( ${_prefix}_${_COMP}_FOUND ${${CMAKE_FIND_PACKAGE_NAME}_${_arg_comp}_FOUND} ) - set( ${_prefix}_${_arg_comp}_FOUND ${${CMAKE_FIND_PACKAGE_NAME}_${_arg_comp}_FOUND} ) - - set( ${_prefix}_${_comp}_LIBRARIES ${NetCDF_${_comp}_LIBRARIES} ) - set( ${_prefix}_${_COMP}_LIBRARIES ${NetCDF_${_comp}_LIBRARIES} ) - set( ${_prefix}_${_arg_comp}_LIBRARIES ${NetCDF_${_comp}_LIBRARIES} ) - - set( ${_prefix}_${_comp}_INCLUDE_DIRS ${NetCDF_${_comp}_INCLUDE_DIRS} ) - set( ${_prefix}_${_COMP}_INCLUDE_DIRS ${NetCDF_${_comp}_INCLUDE_DIRS} ) - set( ${_prefix}_${_arg_comp}_INCLUDE_DIRS ${NetCDF_${_comp}_INCLUDE_DIRS} ) - endforeach() -endforeach() diff --git a/test/cmake/Modules/FindOpenMP_Fortran.cmake b/test/cmake/Modules/FindOpenMP_Fortran.cmake deleted file mode 100644 index bc440ae10..000000000 --- a/test/cmake/Modules/FindOpenMP_Fortran.cmake +++ /dev/null @@ -1,104 +0,0 @@ -# - Finds OpenMP support -# This module can be used to detect OpenMP support in a compiler. -# If the compiler supports OpenMP, the flags required to compile with -# openmp support are set. -# -# This module was modified from the standard FindOpenMP module to find Fortran -# flags. -# -# The following variables are set: -# OpenMP_Fortran_FLAGS - flags to add to the Fortran compiler for OpenMP -# support. In general, you must use these at both -# compile- and link-time. -# OMP_NUM_PROCS - the max number of processors available to OpenMP - -#============================================================================= -# Copyright 2009 Kitware, Inc. -# Copyright 2008-2009 AndrĂ© Rigland Brodtkorb -# -# Distributed under the OSI-approved BSD License (the "License"); -# see accompanying file Copyright.txt for details. -# -# This software is distributed WITHOUT ANY WARRANTY; without even the -# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -# See the License for more information. -#============================================================================= -# (To distribute this file outside of CMake, substitute the full -# License text for the above reference.) - -INCLUDE (${CMAKE_ROOT}/Modules/FindPackageHandleStandardArgs.cmake) - -SET (OpenMP_Fortran_FLAG_CANDIDATES - #Microsoft Visual Studio - "/openmp" - #Intel windows - "/Qopenmp" - #Intel - "-qopenmp" - #Gnu - "-fopenmp" - #Empty, if compiler automatically accepts openmp - " " - #Sun - "-xopenmp" - #HP - "+Oopenmp" - #IBM XL C/c++ - "-qsmp" - #Portland Group - "-mp" -) - -IF (DEFINED OpenMP_Fortran_FLAGS) - SET (OpenMP_Fortran_FLAG_CANDIDATES) -ENDIF (DEFINED OpenMP_Fortran_FLAGS) - -# check fortran compiler. also determine number of processors -FOREACH (FLAG ${OpenMP_Fortran_FLAG_CANDIDATES}) - SET (SAFE_CMAKE_REQUIRED_FLAGS "${CMAKE_REQUIRED_FLAGS}") - SET (CMAKE_REQUIRED_FLAGS "${FLAG}") - UNSET (OpenMP_FLAG_DETECTED CACHE) - MESSAGE (STATUS "Try OpenMP Fortran flag = [${FLAG}]") - FILE (WRITE "${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/testFortranOpenMP.f90" -" -program TestOpenMP - use omp_lib - write(*,'(I2)',ADVANCE='NO') omp_get_num_procs() -end program TestOpenMP -") - SET (MACRO_CHECK_FUNCTION_DEFINITIONS - "-DOpenMP_FLAG_DETECTED ${CMAKE_REQUIRED_FLAGS}") - TRY_RUN (OpenMP_RUN_FAILED OpenMP_FLAG_DETECTED ${CMAKE_BINARY_DIR} - ${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/testFortranOpenMP.f90 - COMPILE_DEFINITIONS ${CMAKE_REQUIRED_DEFINITIONS} - CMAKE_FLAGS -DCOMPILE_DEFINITIONS:STRING=${MACRO_CHECK_FUNCTION_DEFINITIONS} - COMPILE_OUTPUT_VARIABLE OUTPUT - RUN_OUTPUT_VARIABLE OMP_NUM_PROCS_INTERNAL) - IF (OpenMP_FLAG_DETECTED) - FILE (APPEND ${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeOutput.log - "Determining if the Fortran compiler supports OpenMP passed with " - "the following output:\n${OUTPUT}\n\n") - SET (OpenMP_FLAG_DETECTED 1) - IF (OpenMP_RUN_FAILED) - MESSAGE (FATAL_ERROR "OpenMP found, but test code did not run") - ENDIF (OpenMP_RUN_FAILED) - SET (OMP_NUM_PROCS ${OMP_NUM_PROCS_INTERNAL} CACHE - STRING "Number of processors OpenMP may use" FORCE) - SET (OpenMP_Fortran_FLAGS_INTERNAL "${FLAG}") - BREAK () - ELSE () - FILE (APPEND ${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeError.log - "Determining if the Fortran compiler supports OpenMP failed with " - "the following output:\n${OUTPUT}\n\n") - SET (OpenMP_FLAG_DETECTED 0) - ENDIF (OpenMP_FLAG_DETECTED) -ENDFOREACH (FLAG ${OpenMP_Fortran_FLAG_CANDIDATES}) - -SET (OpenMP_Fortran_FLAGS "${OpenMP_Fortran_FLAGS_INTERNAL}" - CACHE STRING "Fortran compiler flags for OpenMP parallization") - -# handle the standard arguments for FIND_PACKAGE -FIND_PACKAGE_HANDLE_STANDARD_ARGS (OpenMP_Fortran DEFAULT_MSG - OpenMP_Fortran_FLAGS) - -MARK_AS_ADVANCED(OpenMP_Fortran_FLAGS) diff --git a/test/cmake/Modules/SetCompileFlag.cmake b/test/cmake/Modules/SetCompileFlag.cmake deleted file mode 100644 index 04ff3ffbd..000000000 --- a/test/cmake/Modules/SetCompileFlag.cmake +++ /dev/null @@ -1,112 +0,0 @@ -############################################################################# -# Given a list of flags, this function will try each, one at a time, -# and choose the first flag that works. If no flags work, then nothing -# will be set, unless the REQUIRED key is given, in which case an error -# will be given. -# -# Call is: -# SET_COMPILE_FLAG(FLAGVAR FLAGVAL (Fortran|C|CXX) flag1 flag2...) -# -# For example, if you have the flag CMAKE_C_FLAGS and you want to add -# warnings and want to fail if this is not possible, you might call this -# function in this manner: -# SET_COMPILE_FLAGS(CMAKE_C_FLAGS "${CMAKE_C_FLAGS}" C REQUIRED -# "-Wall" # GNU -# "-warn all" # Intel -# ) -# The optin "-Wall" will be checked first, and if it works, will be -# appended to the CMAKE_C_FLAGS variable. If it doesn't work, then -# "-warn all" will be tried. If this doesn't work then checking will -# terminate because REQUIRED was given. -# -# The reasong that the variable must be given twice (first as the name then -# as the value in quotes) is because of the way CMAKE handles the passing -# of variables in functions; it is difficult to extract a variable's -# contents and assign new values to it from within a function. -############################################################################# - -INCLUDE(${CMAKE_ROOT}/Modules/CheckCCompilerFlag.cmake) -INCLUDE(${CMAKE_ROOT}/Modules/CheckCXXCompilerFlag.cmake) - -FUNCTION(SET_COMPILE_FLAG FLAGVAR FLAGVAL LANG) - - # Do some up front setup if Fortran - IF(LANG STREQUAL "Fortran") - # Create a list of error messages from compilers - SET(FAIL_REGEX - "ignoring unknown option" # Intel - "invalid argument" # Intel - "unrecognized .*option" # GNU - "[Uu]nknown switch" # Portland Group - "ignoring unknown option" # MSVC - "warning D9002" # MSVC, any lang - "[Uu]nknown option" # HP - "[Ww]arning: [Oo]ption" # SunPro - "command option .* is not recognized" # XL - ) - ENDIF(LANG STREQUAL "Fortran") - - # Make a variable holding the flags. Filter out REQUIRED if it is there - SET(FLAG_REQUIRED FALSE) - SET(FLAG_FOUND FALSE) - UNSET(FLAGLIST) - FOREACH (var ${ARGN}) - STRING(TOUPPER "${var}" UP) - IF(UP STREQUAL "REQUIRED") - SET(FLAG_REQUIRED TRUE) - ELSE() - SET(FLAGLIST ${FLAGLIST} "${var}") - ENDIF(UP STREQUAL "REQUIRED") - ENDFOREACH (var ${ARGN}) - - # Now, loop over each flag - FOREACH(flag ${FLAGLIST}) - - UNSET(FLAG_WORKS) - # Check the flag for the given language - IF(LANG STREQUAL "C") - CHECK_C_COMPILER_FLAG("${flag}" FLAG_WORKS) - ELSEIF(LANG STREQUAL "CXX") - CHECK_CXX_COMPILER_FLAG("${flag}" FLAG_WORKS) - ELSEIF(LANG STREQUAL "Fortran") - # There is no nice function to do this for FORTRAN, so we must manually - # create a test program and check if it compiles with a given flag. - SET(TESTFILE "${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}") - SET(TESTFILE "${TESTFILE}/CMakeTmp/testFortranFlags.f90") - FILE(WRITE "${TESTFILE}" -" -program dummyprog - i = 5 -end program dummyprog -") - TRY_COMPILE(FLAG_WORKS ${CMAKE_BINARY_DIR} ${TESTFILE} - COMPILE_DEFINITIONS "${flag}" OUTPUT_VARIABLE OUTPUT) - - # Check that the output message doesn't match any errors - FOREACH(rx ${FAIL_REGEX}) - IF("${OUTPUT}" MATCHES "${rx}") - SET(FLAG_WORKS FALSE) - ENDIF("${OUTPUT}" MATCHES "${rx}") - ENDFOREACH(rx ${FAIL_REGEX}) - - ELSE() - MESSAGE(FATAL_ERROR "Unknown language in SET_COMPILE_FLAGS: ${LANG}") - ENDIF(LANG STREQUAL "C") - - # If this worked, use these flags, otherwise use other flags - IF(FLAG_WORKS) - # Append this flag to the end of the list that already exists - SET(${FLAGVAR} "${FLAGVAL} ${flag}" CACHE STRING - "Set the ${FLAGVAR} flags" FORCE) - SET(FLAG_FOUND TRUE) - BREAK() # We found something that works, so exit - ENDIF(FLAG_WORKS) - - ENDFOREACH(flag ${FLAGLIST}) - - # Raise an error if no flag was found - IF(FLAG_REQUIRED AND NOT FLAG_FOUND) - MESSAGE(FATAL_ERROR "No compile flags were found") - ENDIF(FLAG_REQUIRED AND NOT FLAG_FOUND) - -ENDFUNCTION() diff --git a/test/cmake/Modules/SetFortranFlags.cmake b/test/cmake/Modules/SetFortranFlags.cmake deleted file mode 100644 index 84a2f4ffc..000000000 --- a/test/cmake/Modules/SetFortranFlags.cmake +++ /dev/null @@ -1,160 +0,0 @@ -###################################################### -# Determine and set the Fortran compiler flags we want -###################################################### - -#################################################################### -# Make sure that the default build type is RELEASE if not specified. -#################################################################### -INCLUDE(${CMAKE_MODULE_PATH}/SetCompileFlag.cmake) - -# Make sure the build type is uppercase -STRING(TOUPPER "${CMAKE_BUILD_TYPE}" BT) - -IF(BT STREQUAL "RELEASE") - SET(CMAKE_BUILD_TYPE RELEASE CACHE STRING - "Choose the type of build, options are DEBUG, RELEASE, or TESTING." - FORCE) -ELSEIF(BT STREQUAL "DEBUG") - SET (CMAKE_BUILD_TYPE DEBUG CACHE STRING - "Choose the type of build, options are DEBUG, RELEASE, or TESTING." - FORCE) -ELSEIF(BT STREQUAL "TESTING") - SET (CMAKE_BUILD_TYPE TESTING CACHE STRING - "Choose the type of build, options are DEBUG, RELEASE, or TESTING." - FORCE) -ELSEIF(NOT BT) - SET(CMAKE_BUILD_TYPE RELEASE CACHE STRING - "Choose the type of build, options are DEBUG, RELEASE, or TESTING." - FORCE) - MESSAGE(STATUS "CMAKE_BUILD_TYPE not given, defaulting to RELEASE") -ELSE() - MESSAGE(FATAL_ERROR "CMAKE_BUILD_TYPE not valid, choices are DEBUG, RELEASE, or TESTING") -ENDIF(BT STREQUAL "RELEASE") - -######################################################### -# If the compiler flags have already been set, return now -######################################################### - -IF(CMAKE_Fortran_FLAGS_RELEASE AND CMAKE_Fortran_FLAGS_TESTING AND CMAKE_Fortran_FLAGS_DEBUG) - RETURN () -ENDIF(CMAKE_Fortran_FLAGS_RELEASE AND CMAKE_Fortran_FLAGS_TESTING AND CMAKE_Fortran_FLAGS_DEBUG) - -######################################################################## -# Determine the appropriate flags for this compiler for each build type. -# For each option type, a list of possible flags is given that work -# for various compilers. The first flag that works is chosen. -# If none of the flags work, nothing is added (unless the REQUIRED -# flag is given in the call). This way unknown compiles are supported. -####################################################################### - -##################### -### GENERAL FLAGS ### -##################### - -# Don't add underscores in symbols for C-compatability -SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}" - Fortran "-fno-underscoring -fopenmp") - -# There is some bug where -march=native doesn't work on Mac -IF(APPLE) - SET(GNUNATIVE "-mtune=native") -ELSE() - SET(GNUNATIVE "-march=native") -ENDIF() -# Optimize for the host's architecture -SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}" - Fortran "-xHost" # Intel - "/QxHost" # Intel Windows - ${GNUNATIVE} # GNU - "-ta=host" # Portland Group - ) - -################### -### DEBUG FLAGS ### -################### - -# NOTE: debugging symbols (-g or /debug:full) are already on by default - -# Disable optimizations -SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG}" - Fortran REQUIRED "-O0" # All compilers not on Windows - "/Od" # Intel Windows - ) - -# Turn on all warnings -SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG}" - Fortran "-warn all" # Intel - "/warn:all" # Intel Windows - "-Wall" # GNU - # Portland Group (on by default) - ) - -# Traceback -SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG}" - Fortran "-traceback" # Intel/Portland Group - "/traceback" # Intel Windows - "-fbacktrace" # GNU (gfortran) - "-ftrace=full" # GNU (g95) - ) - -# Check array bounds -SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG}" - Fortran "-check bounds" # Intel - "/check:bounds" # Intel Windows - "-fcheck=bounds" # GNU (New style) - "-fbounds-check" # GNU (Old style) - "-Mbounds" # Portland Group - ) - -##################### -### TESTING FLAGS ### -##################### - -# Optimizations -SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_TESTING "${CMAKE_Fortran_FLAGS_TESTING}" - Fortran REQUIRED "-O2" # All compilers not on Windows - "/O2" # Intel Windows - ) - -##################### -### RELEASE FLAGS ### -##################### - -# NOTE: agressive optimizations (-O3) are already turned on by default - -# Unroll loops -SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" - Fortran "-funroll-loops" # GNU - "-unroll" # Intel - "/unroll" # Intel Windows - "-Munroll" # Portland Group - ) - -# Inline functions -SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" - Fortran "-inline" # Intel - "/Qinline" # Intel Windows - "-finline-functions" # GNU - "-Minline" # Portland Group - ) - -# Interprocedural (link-time) optimizations -SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" - Fortran "-ipo" # Intel - "/Qipo" # Intel Windows - "-flto" # GNU - "-Mipa" # Portland Group - ) - -# Single-file optimizations -SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" - Fortran "-ip" # Intel - "/Qip" # Intel Windows - ) - -# Vectorize code -SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" - Fortran "-vec-report0" # Intel - "/Qvec-report0" # Intel Windows - "-Mvect" # Portland Group - ) diff --git a/test/cmake/Modules/SetParallelizationLibrary.cmake b/test/cmake/Modules/SetParallelizationLibrary.cmake deleted file mode 100644 index 603d4299c..000000000 --- a/test/cmake/Modules/SetParallelizationLibrary.cmake +++ /dev/null @@ -1,39 +0,0 @@ -# Turns on either OpenMP or MPI -# If both are requested, the other is disabled -# When one is turned on, the other is turned off -# If both are off, we explicitly disable them just in case - -IF (USE_OPENMP AND USE_MPI) - MESSAGE (FATAL_ERROR "Cannot use both OpenMP and MPI") -ELSEIF (USE_OPENMP) - # Find OpenMP - IF (NOT OpenMP_Fortran_FLAGS) - FIND_PACKAGE (OpenMP_Fortran) - IF (NOT OpenMP_Fortran_FLAGS) - MESSAGE (FATAL_ERROR "Fortran compiler does not support OpenMP") - ENDIF (NOT OpenMP_Fortran_FLAGS) - ENDIF (NOT OpenMP_Fortran_FLAGS) - # Turn of MPI - UNSET (MPI_FOUND CACHE) - UNSET (MPI_COMPILER CACHE) - UNSET (MPI_LIBRARY CACHE) -ELSEIF (USE_MPI) - # Find MPI - IF (NOT MPI_Fortran_FOUND) - FIND_PACKAGE (MPI REQUIRED) - ENDIF (NOT MPI_Fortran_FOUND) - # Turn off OpenMP - SET (OMP_NUM_PROCS 0 CACHE - STRING "Number of processors OpenMP may use" FORCE) - UNSET (OpenMP_C_FLAGS CACHE) - UNSET (GOMP_Fortran_LINK_FLAGS CACHE) -ELSE () - # Turn off both OpenMP and MPI - SET (OMP_NUM_PROCS 0 CACHE - STRING "Number of processors OpenMP may use" FORCE) - UNSET (OpenMP_Fortran_FLAGS CACHE) - UNSET (GOMP_Fortran_LINK_FLAGS CACHE) - UNSET (MPI_FOUND CACHE) - UNSET (MPI_COMPILER CACHE) - UNSET (MPI_LIBRARY CACHE) -ENDIF (USE_OPENMP AND USE_MPI) diff --git a/test/cmake/Modules/SetUpLAPACK.cmake b/test/cmake/Modules/SetUpLAPACK.cmake deleted file mode 100644 index ae5bdea52..000000000 --- a/test/cmake/Modules/SetUpLAPACK.cmake +++ /dev/null @@ -1,11 +0,0 @@ -# Find LAPACK (finds BLAS also) if not already found -IF(NOT LAPACK_FOUND) - ENABLE_LANGUAGE(C) # Some libraries need a C compiler to find - FIND_PACKAGE(LAPACK REQUIRED) - # Remember that LAPACK (and BLAS) was found. For some reason the - # FindLAPACK routine doesn't place these into the CACHE. - SET(BLAS_FOUND TRUE CACHE INTERNAL "BLAS was found" FORCE) - SET(LAPACK_FOUND TRUE CACHE INTERNAL "LAPACK was found" FORCE) - SET(BLAS_LIBRARIES ${BLAS_LIBRARIES} CACHE INTERNAL "BLAS LIBS" FORCE) - SET(LAPACK_LIBRARIES ${LAPACK_LIBRARIES} CACHE INTERNAL "LAPACK LIBS" FORCE) -ENDIF(NOT LAPACK_FOUND) diff --git a/test/mains/application/SpcCoeff_Inspect.f90 b/test/mains/application/SpcCoeff_Inspect.f90 new file mode 100644 index 000000000..eaf10813c --- /dev/null +++ b/test/mains/application/SpcCoeff_Inspect.f90 @@ -0,0 +1,78 @@ +! +! SpcCoeff_Inspect +! +! Program to inspect the contents of a CRTM Binary format SpcCoeff file. +! +! +! CREATION HISTORY: +! Written by: Paul van Delst, 03-Feb-2011 +! paul.vandelst@noaa.gov +! + +PROGRAM SpcCoeff_Inspect + + ! ------------------ + ! Environment set up + ! ------------------ + ! Module usage + USE File_Utility , ONLY: File_Exists + USE Message_Handler , ONLY: SUCCESS, FAILURE, Program_Message, Display_Message + USE SpcCoeff_Define , ONLY: SpcCoeff_type, SpcCoeff_Destroy, & + Inspect => SpcCoeff_Inspect + USE SpcCoeff_Binary_IO, ONLY: SpcCoeff_Binary_ReadFile + ! Disable implicit typing + IMPLICIT NONE + + ! ---------- + ! Parameters + ! ---------- + CHARACTER(*), PARAMETER :: PROGRAM_NAME = 'SpcCoeff_Inspect' + CHARACTER(*), PARAMETER :: PROGRAM_VERSION_ID = '' + + ! --------- + ! Variables + ! --------- + INTEGER :: err_stat + CHARACTER(256) :: filename, msg + INTEGER :: n_args + TYPE(SpcCoeff_type) :: sc + + ! Generate a string containing the SpcCoeff release for info + WRITE(msg,'(i10)') sc%Release + + + ! Output program header + CALL Program_Message( PROGRAM_NAME, & + 'Program to display the contents of a CRTM '//& + 'Binary format R'//TRIM(ADJUSTL(msg))//' SpcCoeff '//& + 'file to stdout.', & + '$Revision$' ) + + ! Get the filename + n_args = COMMAND_ARGUMENT_COUNT() + IF ( n_args > 0 ) THEN + CALL GET_COMMAND_ARGUMENT(1, filename) + ELSE + WRITE( *,FMT='(/5x,"Enter the Binary SpcCoeff filename: ")',ADVANCE='NO' ) + READ( *,'(a)' ) filename + END IF + filename = ADJUSTL(filename) + IF ( .NOT. File_Exists( TRIM(filename) ) ) THEN + msg = 'File '//TRIM(filename)//' not found.' + CALL Display_Message( PROGRAM_NAME, msg, FAILURE ); STOP + END IF + + ! Read the binary data file + err_stat = SpcCoeff_Binary_ReadFile( filename, sc ) + IF ( err_stat /= SUCCESS ) THEN + msg = 'Error reading Binary SpcCoeff file '//TRIM(filename) + CALL Display_Message( PROGRAM_NAME, msg, FAILURE ); STOP + END IF + + ! Display the contents + CALL Inspect( sc ) + + ! Clean up + CALL SpcCoeff_Destroy( sc ) + +END PROGRAM SpcCoeff_Inspect