!-------------------------------------------------------------------------------- !M+ ! NAME: ! netcdf_utility ! ! PURPOSE: ! Module containing some utility routines for netCDF file access. ! ! CATEGORY: ! NETCDF ! ! LANGUAGE: ! Fortran 90 ! ! CALLING SEQUENCE: ! USE netcdf_utility ! ! LANGUAGE: ! Fortran-90 ! ! MODULES: ! type_kinds: Module containing data type kind definitions. ! ! error_handler: Module to define error codes and handle error ! conditions ! ! netcdf: Module supplied with the Fortran 90 version of the ! netCDF libraries (at least v3.5.0). ! See http://www.unidata.ucar.edu/packages/netcdf ! ! CONTAINS: ! get_ncdf_dimension: PUBLIC Function to retrieve a netCDF file dimension ! by name. ! ! put_ncdf_def_atts: PUBLIC Function to write a standard set of default ! variable attributes to a netCDF file. ! ! EXTERNALS: ! None ! ! COMMON BLOCKS: ! None. ! ! SIDE EFFECTS: ! None known. ! ! RESTRICTIONS: ! None. ! ! CREATION HISTORY: ! Written by: Paul van Delst, CIMSS/SSEC, 20-Nov-2000 ! paul.vandelst@ssec.wisc.edu ! ! Copyright (C) 2000 Paul van Delst ! ! This program is free software; you can redistribute it and/or ! modify it under the terms of the GNU General Public License ! as published by the Free Software Foundation; either version 2 ! of the License, or (at your option) any later version. ! ! This program is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! along with this program; if not, write to the Free Software ! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. !M- !-------------------------------------------------------------------------------- MODULE netcdf_utility ! -------------------- ! Declare modules used ! -------------------- USE type_kinds USE error_handler USE netcdf ! ----------------------- ! Disable implicit typing ! ----------------------- IMPLICIT NONE ! ---------- ! Visibility ! ---------- PRIVATE PUBLIC :: get_ncdf_dimension PUBLIC :: put_ncdf_def_atts ! --------------------- ! Procedure overloading ! --------------------- ! -- Functions to write the conventional, default set of attributes INTERFACE put_ncdf_def_atts MODULE PROCEDURE put_byte_int_def_atts, & put_short_int_def_atts, & put_long_int_def_atts, & put_single_float_def_atts, & put_double_float_def_atts END INTERFACE ! put_ncdf_def_atts ! ----------------- ! Module parameters ! ----------------- INTEGER, PARAMETER :: N_CHAR_DEF_ATTS = 3 CHARACTER( 14 ), PARAMETER, DIMENSION( N_CHAR_DEF_ATTS ) :: CHAR_DEF_ATT_NAME = (/ 'long_name ', & 'units ', & 'FORTRAN_format' /) INTEGER, PARAMETER :: N_TYPE_DEF_ATTS = 6 CHARACTER( 13 ), DIMENSION( N_TYPE_DEF_ATTS ) :: TYPE_DEF_ATT_NAME = (/ 'scale_factor ', & 'add_offset ', & 'valid_min ', & 'valid_max ', & '_FillValue ', & 'missing_value' /) ! ---------------- ! Module variables ! ---------------- INTEGER :: i CONTAINS !-------------------------------------------------------------------------------- !S+ ! NAME: ! get_ncdf_dimension ! ! PURPOSE: ! Function to retrieve a netCDF file dimension by name. This function is ! a wrapper for some of the NETCDF library functions to simplify the ! retrieval of a dimension value with error checking. ! ! CATEGORY: ! NETCDF ! ! LANGUAGE: ! Fortran 90 ! ! CALLING SEQUENCE: ! result = get_ncdf_dimension ( ncdf_id, & ! Input ! dimension_name, & ! Input ! dimension_value, & ! Output ! dimension_id = dimension_id, & ! Optional Output ! ! message_log = message_log ) ! Optional Input ! ! INPUT ARGUMENTS: ! ncdf_id: Id of a netCDF format file returned from an ! netCDF library OPEN call. ! UNITS: None ! TYPE: Integer ! DIMENSION: Scalar ! ATTRIBUTES: INTENT( IN ) ! ! dimension_name: Name of the netCDF dimension to retrieve. ! UNITS: None ! 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 the screen. ! UNITS: None ! TYPE: Character ! DIMENSION: Scalar ! ATTRIBUTES: OPTIONAL, INTENT( IN ) ! ! OUTPUT ARGUMENTS: ! dimension_value: Value of the requested dimension. ! UNITS: Variable ! TYPE: Integer ! DIMENSION: Scalar ! ATTRIBUTES: INTENT( IN ) ! ! OPTIONAL OUTPUT ARGUMENTS: ! dimension_id NetCDF Id of the requested dimension. ! UNITS: None ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: OPTIONAL, INTENT( OUT ) ! ! FUNCTION RESULT ! Function returns an error flag ! If result = SUCCESS, everything is o.k. ! = FAILURE, an error occurred ! ! CALLS: ! NF90_INQ_DIMID: Function to get a dimension id. ! SOURCE: netCDF module and library. ! ! NF90_INQUIRE_DIMENSION: Function to get a dimension value. ! SOURCE: netCDF module and library. ! ! display_message: Subroutine to output messages ! SOURCE: error_handler module ! ! EXTERNALS: ! None ! ! COMMON BLOCKS: ! None. ! ! SIDE EFFECTS: ! None known. ! ! RESTRICTIONS: ! None. !S- !-------------------------------------------------------------------------------- FUNCTION get_ncdf_dimension ( ncdf_id, & dimension_name, & dimension_value, & dimension_id, & message_log ) & RESULT ( error_status ) !#--------------------------------------------------------------------------# !# -- TYPE DECLARATIONS -- # !#--------------------------------------------------------------------------# ! --------- ! Arguments ! --------- INTEGER, INTENT( IN ) :: ncdf_id CHARACTER( * ), INTENT( IN ) :: dimension_name INTEGER, INTENT( OUT ) :: dimension_value INTEGER, OPTIONAL, INTENT( OUT ) :: dimension_id CHARACTER( * ), OPTIONAL, INTENT( IN ) :: message_log ! ------ ! Result ! ------ INTEGER :: error_status ! ---------- ! Parameters ! ---------- CHARACTER( LEN = 18 ), PARAMETER :: ROUTINE_NAME = 'GET_NCDF_DIMENSION' ! --------------- ! Local variables ! --------------- INTEGER :: nf90_status INTEGER :: dim_id ! ---------- ! Intrinsics ! ---------- INTRINSIC PRESENT !#--------------------------------------------------------------------------# !# -- GET THE DIMENSION ID -- # !#--------------------------------------------------------------------------# nf90_status = NF90_INQ_DIMID( ncdf_id, & dimension_name, & dim_id ) IF ( nf90_status /= NF90_NOERR ) THEN error_status = FAILURE CALL display_message( ROUTINE_NAME, & 'Error inquiring dimension ID for '// & TRIM( dimension_name )// & ' - '// & TRIM( NF90_STRERROR( nf90_status ) ), & error_status, & message_log = message_log ) RETURN END IF IF ( PRESENT( dimension_id ) ) dimension_id = dim_id !#--------------------------------------------------------------------------# !# -- GET THE DIMENSION VALUE -- # !#--------------------------------------------------------------------------# nf90_status = NF90_INQUIRE_DIMENSION( ncdf_id, & dim_id, & len = dimension_value ) IF ( nf90_status /= NF90_NOERR ) THEN error_status = FAILURE CALL display_message( ROUTINE_NAME, & 'Error reading dimension value for '// & TRIM( dimension_name )// & ' - '// & TRIM( NF90_STRERROR( nf90_status ) ), & error_status, & message_log = message_log ) RETURN END IF !#--------------------------------------------------------------------------# !# -- DONE -- # !#--------------------------------------------------------------------------# error_status = SUCCESS RETURN END FUNCTION get_ncdf_dimension !-------------------------------------------------------------------------------- !S+ ! NAME: ! put_ncdf_def_atts ! ! PURPOSE: ! Function to write a default set of variable attributes to a NETCDF ! format file. This function is a wrapper for some of the NETCDF library ! functions to simplify the process and have relatively robust error ! checking. ! ! CATEGORY: ! NETCDF ! ! LANGUAGE: ! Fortran 90 ! ! CALLING SEQUENCE: ! result = put_ncdf_def_atts( ncdf_id, & ! Input ! variable_name, & ! Input ! long_name, & ! Input ! units, & ! Input ! scale_factor, & ! Input ! add_offset, & ! Input ! valid_min, & ! Input ! valid_max, & ! Input ! fill_value, & ! Input ! missing_value, & ! Input ! fortran_format, & ! Input ! ! message_log = message_log ) ! Optional Input ! ! INPUT ARGUMENTS: ! ncdf_id: Id of a netCDF format file returned from an ! netCDF library OPEN call. ! UNITS: None ! TYPE: Integer ! DIMENSION: Scalar ! ATTRIBUTES: INTENT( IN ) ! ! variable_name: Name of the netCDF variable for which the attributes ! are to be added. ! UNITS: None ! TYPE: Character ! DIMENSION: Scalar ! ATTRIBUTES: INTENT( IN ) ! ! long_name: A long descriptive name for the variable. ! UNITS: None ! TYPE: Character ! DIMENSION: Scalar ! ATTRIBUTES: INTENT( IN ) ! ! units: A character string that specifies the units used for ! the variable's data. ! UNITS: None ! TYPE: Character ! DIMENSION: Scalar ! ATTRIBUTES: INTENT( IN ) ! ! scale_factor: A factor by which the data are to be multiplied after ! the data are read by an application. ! UNITS: Variable ! TYPE: Variable: ! 1, 2, 4-byte integer; 4, 8-byte real ! DIMENSION: Scalar ! ATTRIBUTES: INTENT( IN ) ! ! add_offset: A number that is to be added to the data after it is ! read by an application. Note that if both scale_factor ! and add_offset attributes are present, the data should ! be first scaled before the offset is added. ! UNITS: Variable ! TYPE: Variable: ! 1, 2, 4-byte integer; 4, 8-byte real ! DIMENSION: Scalar ! ATTRIBUTES: INTENT( IN ) ! ! valid_min: A number specifying the minimum valid value for ! this variable. ! UNITS: Variable ! TYPE: Variable: ! 1, 2, 4-byte integer; 4, 8-byte real ! DIMENSION: Scalar ! ATTRIBUTES: INTENT( IN ) ! ! valid_max: A number specifying the maximum valid value for ! this variable. ! UNITS: Variable ! TYPE: Variable: ! 1, 2, 4-byte integer; 4, 8-byte real ! DIMENSION: Scalar ! ATTRIBUTES: INTENT( IN ) ! ! fill_value: This number specifies the fill value used to pre-fill ! disk space allocated to the variable. Such pre-fill ! occurs unless nofill mode is set using NF_SET_FILL. ! Generic applications often need to write a value to ! represent undefined or missing values. The fill value ! provides an appropriate value for this purpose because ! it is normally outside the valid range and therefore ! treated as missing when read by generic applications. ! It is legal (but not recommended) for the fill value ! to be within the valid range. ! UNITS: Variable ! TYPE: Variable: ! 1, 2, 4-byte integer; 4, 8-byte real ! DIMENSION: Scalar ! ATTRIBUTES: INTENT( IN ) ! ! missing_value: This number specifies a value indicating missing data. ! This values should all be outside the valid range so that ! generic applications will treat them as missing. ! UNITS: Variable ! TYPE: Variable: ! 1, 2, 4-byte integer; 4, 8-byte real ! DIMENSION: Scalar ! ATTRIBUTES: INTENT( IN ) ! ! fortran_format: A character string that specifies the format that should ! be used by Fortran applications to print values for this ! variable ! UNITS: None ! 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 the screen. ! UNITS: None ! TYPE: Character ! DIMENSION: Scalar ! ATTRIBUTES: OPTIONAL, INTENT( IN ) ! ! OUTPUT ARGUMENTS: ! None. ! ! OPTIONAL OUTPUT ARGUMENTS: ! None. ! ! FUNCTION RESULT ! Function returns an error flag ! If result = SUCCESS, everything is o.k. ! = FAILURE, an error occurred ! ! CALLS: ! NF90_INQ_VARID: Function to get a variable id. ! SOURCE: netCDF module and library. ! ! NF90_PUT_ATT: Function to add an attribute to a variable. ! SOURCE: netCDF module and library. ! ! display_message: Subroutine to output messages ! SOURCE: error_handler module ! ! EXTERNALS: ! None ! ! COMMON BLOCKS: ! None. ! ! SIDE EFFECTS: ! None known. ! ! RESTRICTIONS: ! None. !S- !-------------------------------------------------------------------------------- FUNCTION put_byte_int_def_atts( ncdf_id, & ! Input variable_name, & ! Input long_name, & ! Input units, & ! Input scale_factor, & ! Input add_offset, & ! Input valid_min, & ! Input valid_max, & ! Input fill_value, & ! Input missing_value, & ! Input fortran_format, & ! Input message_log ) & ! Optional input RESULT ( error_status ) !#--------------------------------------------------------------------------# !# -- TYPE DECLARATIONS -- # !#--------------------------------------------------------------------------# ! --------- ! Arguments ! --------- INTEGER, INTENT( IN ) :: ncdf_id CHARACTER( * ), INTENT( IN ) :: variable_name CHARACTER( * ), INTENT( IN ) :: long_name CHARACTER( * ), INTENT( IN ) :: units CHARACTER( * ), INTENT( IN ) :: fortran_format ! -- Type specific arguments INTEGER( Byte ), INTENT( IN ) :: scale_factor INTEGER( Byte ), INTENT( IN ) :: add_offset INTEGER( Byte ), INTENT( IN ) :: valid_min INTEGER( Byte ), INTENT( IN ) :: valid_max INTEGER( Byte ), INTENT( IN ) :: fill_value INTEGER( Byte ), INTENT( IN ) :: missing_value ! -- Error handling message log CHARACTER( * ), INTENT( IN ), OPTIONAL :: message_log ! -- Result INTEGER :: error_status ! -- Parameters CHARACTER( * ), PARAMETER :: ROUTINE_NAME = 'PUT_BYTE_INT_DEF_ATTS' ! -- Local variables INTEGER :: nf90_status INTEGER :: variable_id CHARACTER( LEN = MAX( LEN_TRIM( long_name ), & LEN_TRIM( units ), & LEN_TRIM( fortran_format ) ) ), & DIMENSION( n_char_def_atts ) :: char_def_att_value INTEGER( Byte ), DIMENSION( n_type_def_atts ) :: type_def_att_value ! --------------------------------- ! Get the variable ID from its name ! --------------------------------- nf90_status = NF90_INQ_VARID( ncdf_id, & variable_name, & variable_id ) IF ( nf90_status /= NF90_NOERR ) THEN error_status = FAILURE CALL display_message( ROUTINE_NAME, & 'Error inquiring variable ID for '// & TRIM( variable_name )// & ' - '// & TRIM( NF90_STRERROR( nf90_status ) ), & error_status, & message_log = message_log ) RETURN END IF ! --------------------------- ! Assemble all the attributes ! --------------------------- ! -- Character attributes char_def_att_value = (/ long_name , & units , & fortran_format /) ! -- Type specific attributes type_def_att_value = (/ scale_factor, & add_offset, & valid_min, & valid_max, & fill_value, & missing_value /) ! ------------------ ! Add the attributes ! ------------------ ! -- Character attributes DO i = 1, n_char_def_atts nf90_status = NF90_PUT_ATT( ncdf_id, & variable_id, & TRIM( CHAR_DEF_ATT_NAME( i ) ), & TRIM( char_def_att_value( i ) ) ) IF ( nf90_status /= NF90_NOERR ) THEN error_status = FAILURE CALL display_message( ROUTINE_NAME, & 'Error writing '// & TRIM( variable_name )// & ' attribute '// & TRIM( CHAR_DEF_ATT_NAME( i ) )// & ' - '// & TRIM( NF90_STRERROR( nf90_status ) ), & error_status, & message_log = message_log ) RETURN END IF END DO ! -- Type specific attributes DO i = 1, n_type_def_atts nf90_status = NF90_PUT_ATT( ncdf_id, & variable_id, & TRIM( TYPE_DEF_ATT_NAME( i ) ), & type_def_att_value( i ) ) IF ( nf90_status /= NF90_NOERR ) THEN error_status = FAILURE CALL display_message( ROUTINE_NAME, & 'Error writing '// & TRIM( variable_name )// & ' attribute '// & TRIM( TYPE_DEF_ATT_NAME( i ) )// & ' - '// & TRIM( NF90_STRERROR( nf90_status ) ), & error_status, & message_log = message_log ) RETURN END IF END DO ! ------------------------ ! Done. Everything worked. ! ------------------------ error_status = SUCCESS END FUNCTION put_byte_int_def_atts FUNCTION put_short_int_def_atts( ncdf_id, & ! Input variable_name, & ! Input long_name, & ! Input units, & ! Input scale_factor, & ! Input add_offset, & ! Input valid_min, & ! Input valid_max, & ! Input fill_value, & ! Input missing_value, & ! Input fortran_format, & ! Input message_log ) & ! Optional input RESULT ( error_status ) !#--------------------------------------------------------------------------# !# -- TYPE DECLARATIONS -- # !#--------------------------------------------------------------------------# ! --------- ! Arguments ! --------- INTEGER, INTENT( IN ) :: ncdf_id CHARACTER( * ), INTENT( IN ) :: variable_name CHARACTER( * ), INTENT( IN ) :: long_name CHARACTER( * ), INTENT( IN ) :: units CHARACTER( * ), INTENT( IN ) :: fortran_format ! -- Type specific arguments INTEGER( Short ), INTENT( IN ) :: scale_factor INTEGER( Short ), INTENT( IN ) :: add_offset INTEGER( Short ), INTENT( IN ) :: valid_min INTEGER( Short ), INTENT( IN ) :: valid_max INTEGER( Short ), INTENT( IN ) :: fill_value INTEGER( Short ), INTENT( IN ) :: missing_value ! -- Error handling message log CHARACTER( * ), INTENT( IN ), OPTIONAL :: message_log ! -- Result INTEGER :: error_status ! -- Parameters CHARACTER( * ), PARAMETER :: ROUTINE_NAME = 'PUT_SHORT_INT_DEF_ATTS' ! -- Local variables INTEGER :: nf90_status INTEGER :: variable_id CHARACTER( LEN = MAX( LEN_TRIM( long_name ), & LEN_TRIM( units ), & LEN_TRIM( fortran_format ) ) ), & DIMENSION( n_char_def_atts ) :: char_def_att_value INTEGER( Short ), DIMENSION( n_type_def_atts ) :: type_def_att_value ! --------------------------------- ! Get the variable ID from its name ! --------------------------------- nf90_status = NF90_INQ_VARID( ncdf_id, & variable_name, & variable_id ) IF ( nf90_status /= NF90_NOERR ) THEN error_status = FAILURE CALL display_message( ROUTINE_NAME, & 'Error inquiring variable ID for '// & TRIM( variable_name )// & ' - '// & TRIM( NF90_STRERROR( nf90_status ) ), & error_status, & message_log = message_log ) RETURN END IF ! --------------------------- ! Assemble all the attributes ! --------------------------- ! -- Character attributes char_def_att_value = (/ long_name , & units , & fortran_format /) ! -- Type specific attributes type_def_att_value = (/ scale_factor, & add_offset, & valid_min, & valid_max, & fill_value, & missing_value /) ! ------------------ ! Add the attributes ! ------------------ ! -- Character attributes DO i = 1, n_char_def_atts nf90_status = NF90_PUT_ATT( ncdf_id, & variable_id, & TRIM( CHAR_DEF_ATT_NAME( i ) ), & TRIM( char_def_att_value( i ) ) ) IF ( nf90_status /= NF90_NOERR ) THEN error_status = FAILURE CALL display_message( ROUTINE_NAME, & 'Error writing '// & TRIM( variable_name )// & ' attribute '// & TRIM( CHAR_DEF_ATT_NAME( i ) )// & ' - '// & TRIM( NF90_STRERROR( nf90_status ) ), & error_status, & message_log = message_log ) RETURN END IF END DO ! -- Type specific attributes DO i = 1, n_type_def_atts nf90_status = NF90_PUT_ATT( ncdf_id, & variable_id, & TRIM( TYPE_DEF_ATT_NAME( i ) ), & type_def_att_value( i ) ) IF ( nf90_status /= NF90_NOERR ) THEN error_status = FAILURE CALL display_message( ROUTINE_NAME, & 'Error writing '// & TRIM( variable_name )// & ' attribute '// & TRIM( TYPE_DEF_ATT_NAME( i ) )// & ' - '// & TRIM( NF90_STRERROR( nf90_status ) ), & error_status, & message_log = message_log ) RETURN END IF END DO ! ------------------------ ! Done. Everything worked. ! ------------------------ error_status = SUCCESS END FUNCTION put_short_int_def_atts FUNCTION put_long_int_def_atts( ncdf_id, & ! Input variable_name, & ! Input long_name, & ! Input units, & ! Input scale_factor, & ! Input add_offset, & ! Input valid_min, & ! Input valid_max, & ! Input fill_value, & ! Input missing_value, & ! Input fortran_format, & ! Input message_log ) & ! Optional input RESULT ( error_status ) !#--------------------------------------------------------------------------# !# -- TYPE DECLARATIONS -- # !#--------------------------------------------------------------------------# ! --------- ! Arguments ! --------- INTEGER, INTENT( IN ) :: ncdf_id CHARACTER( * ), INTENT( IN ) :: variable_name CHARACTER( * ), INTENT( IN ) :: long_name CHARACTER( * ), INTENT( IN ) :: units CHARACTER( * ), INTENT( IN ) :: fortran_format ! -- Type specific arguments INTEGER( Long ), INTENT( IN ) :: scale_factor INTEGER( Long ), INTENT( IN ) :: add_offset INTEGER( Long ), INTENT( IN ) :: valid_min INTEGER( Long ), INTENT( IN ) :: valid_max INTEGER( Long ), INTENT( IN ) :: fill_value INTEGER( Long ), INTENT( IN ) :: missing_value ! -- Error handling message log CHARACTER( * ), INTENT( IN ), OPTIONAL :: message_log ! -- Result INTEGER :: error_status ! -- Parameters CHARACTER( * ), PARAMETER :: ROUTINE_NAME = 'PUT_LONG_INT_DEF_ATTS' ! -- Local variables INTEGER :: nf90_status INTEGER :: variable_id CHARACTER( LEN = MAX( LEN_TRIM( long_name ), & LEN_TRIM( units ), & LEN_TRIM( fortran_format ) ) ), & DIMENSION( n_char_def_atts ) :: char_def_att_value INTEGER( Long ), DIMENSION( n_type_def_atts ) :: type_def_att_value ! --------------------------------- ! Get the variable ID from its name ! --------------------------------- nf90_status = NF90_INQ_VARID( ncdf_id, & variable_name, & variable_id ) IF ( nf90_status /= NF90_NOERR ) THEN error_status = FAILURE CALL display_message( ROUTINE_NAME, & 'Error inquiring variable ID for '// & TRIM( variable_name )// & ' - '// & TRIM( NF90_STRERROR( nf90_status ) ), & error_status, & message_log = message_log ) RETURN END IF ! --------------------------- ! Assemble all the attributes ! --------------------------- ! -- Character attributes char_def_att_value = (/ long_name , & units , & fortran_format /) ! -- Type specific attributes type_def_att_value = (/ scale_factor, & add_offset, & valid_min, & valid_max, & fill_value, & missing_value /) ! ------------------ ! Add the attributes ! ------------------ ! -- Character attributes DO i = 1, n_char_def_atts nf90_status = NF90_PUT_ATT( ncdf_id, & variable_id, & TRIM( CHAR_DEF_ATT_NAME( i ) ), & TRIM( char_def_att_value( i ) ) ) IF ( nf90_status /= NF90_NOERR ) THEN error_status = FAILURE CALL display_message( ROUTINE_NAME, & 'Error writing '// & TRIM( variable_name )// & ' attribute '// & TRIM( CHAR_DEF_ATT_NAME( i ) )// & ' - '// & TRIM( NF90_STRERROR( nf90_status ) ), & error_status, & message_log = message_log ) RETURN END IF END DO ! -- Type specific attributes DO i = 1, n_type_def_atts nf90_status = NF90_PUT_ATT( ncdf_id, & variable_id, & TRIM( TYPE_DEF_ATT_NAME( i ) ), & type_def_att_value( i ) ) IF ( nf90_status /= NF90_NOERR ) THEN error_status = FAILURE CALL display_message( ROUTINE_NAME, & 'Error writing '// & TRIM( variable_name )// & ' attribute '// & TRIM( TYPE_DEF_ATT_NAME( i ) )// & ' - '// & TRIM( NF90_STRERROR( nf90_status ) ), & error_status, & message_log = message_log ) RETURN END IF END DO ! ------------------------ ! Done. Everything worked. ! ------------------------ error_status = SUCCESS END FUNCTION put_long_int_def_atts FUNCTION put_single_float_def_atts( ncdf_id, & ! Input variable_name, & ! Input long_name, & ! Input units, & ! Input scale_factor, & ! Input add_offset, & ! Input valid_min, & ! Input valid_max, & ! Input fill_value, & ! Input missing_value, & ! Input fortran_format, & ! Input message_log ) & ! Optional input RESULT ( error_status ) !#--------------------------------------------------------------------------# !# -- TYPE DECLARATIONS -- # !#--------------------------------------------------------------------------# ! --------- ! Arguments ! --------- INTEGER, INTENT( IN ) :: ncdf_id CHARACTER( * ), INTENT( IN ) :: variable_name CHARACTER( * ), INTENT( IN ) :: long_name CHARACTER( * ), INTENT( IN ) :: units CHARACTER( * ), INTENT( IN ) :: fortran_format ! -- Type specific arguments REAL( Single ), INTENT( IN ) :: scale_factor REAL( Single ), INTENT( IN ) :: add_offset REAL( Single ), INTENT( IN ) :: valid_min REAL( Single ), INTENT( IN ) :: valid_max REAL( Single ), INTENT( IN ) :: fill_value REAL( Single ), INTENT( IN ) :: missing_value ! -- Error handling message log CHARACTER( * ), INTENT( IN ), OPTIONAL :: message_log ! -- Result INTEGER :: error_status ! -- Parameters CHARACTER( * ), PARAMETER :: ROUTINE_NAME = 'PUT_SINGLE_FLOAT_DEF_ATTS' ! -- Local variables INTEGER :: nf90_status INTEGER :: variable_id CHARACTER( LEN = MAX( LEN_TRIM( long_name ), & LEN_TRIM( units ), & LEN_TRIM( fortran_format ) ) ), & DIMENSION( n_char_def_atts ) :: char_def_att_value REAL( Single ), DIMENSION( n_type_def_atts ) :: type_def_att_value ! --------------------------------- ! Get the variable ID from its name ! --------------------------------- nf90_status = NF90_INQ_VARID( ncdf_id, & variable_name, & variable_id ) IF ( nf90_status /= NF90_NOERR ) THEN error_status = FAILURE CALL display_message( ROUTINE_NAME, & 'Error inquiring variable ID for '// & TRIM( variable_name )// & ' - '// & TRIM( NF90_STRERROR( nf90_status ) ), & error_status, & message_log = message_log ) RETURN END IF ! --------------------------- ! Assemble all the attributes ! --------------------------- ! -- Character attributes char_def_att_value = (/ long_name , & units , & fortran_format /) ! -- Type specific attributes type_def_att_value = (/ scale_factor, & add_offset, & valid_min, & valid_max, & fill_value, & missing_value /) ! ------------------ ! Add the attributes ! ------------------ ! -- Character attributes DO i = 1, n_char_def_atts nf90_status = NF90_PUT_ATT( ncdf_id, & variable_id, & TRIM( CHAR_DEF_ATT_NAME( i ) ), & TRIM( char_def_att_value( i ) ) ) IF ( nf90_status /= NF90_NOERR ) THEN error_status = FAILURE CALL display_message( ROUTINE_NAME, & 'Error writing '// & TRIM( variable_name )// & ' attribute '// & TRIM( CHAR_DEF_ATT_NAME( i ) )// & ' - '// & TRIM( NF90_STRERROR( nf90_status ) ), & error_status, & message_log = message_log ) RETURN END IF END DO ! -- Type specific attributes DO i = 1, n_type_def_atts nf90_status = NF90_PUT_ATT( ncdf_id, & variable_id, & TRIM( TYPE_DEF_ATT_NAME( i ) ), & type_def_att_value( i ) ) IF ( nf90_status /= NF90_NOERR ) THEN error_status = FAILURE CALL display_message( ROUTINE_NAME, & 'Error writing '// & TRIM( variable_name )// & ' attribute '// & TRIM( TYPE_DEF_ATT_NAME( i ) )// & ' - '// & TRIM( NF90_STRERROR( nf90_status ) ), & error_status, & message_log = message_log ) RETURN END IF END DO ! ------------------------ ! Done. Everything worked. ! ------------------------ error_status = SUCCESS END FUNCTION put_single_float_def_atts FUNCTION put_double_float_def_atts( ncdf_id, & ! Input variable_name, & ! Input long_name, & ! Input units, & ! Input scale_factor, & ! Input add_offset, & ! Input valid_min, & ! Input valid_max, & ! Input fill_value, & ! Input missing_value, & ! Input fortran_format, & ! Input message_log ) & ! Optional input RESULT ( error_status ) !#--------------------------------------------------------------------------# !# -- TYPE DECLARATIONS -- # !#--------------------------------------------------------------------------# ! --------- ! Arguments ! --------- INTEGER, INTENT( IN ) :: ncdf_id CHARACTER( * ), INTENT( IN ) :: variable_name CHARACTER( * ), INTENT( IN ) :: long_name CHARACTER( * ), INTENT( IN ) :: units CHARACTER( * ), INTENT( IN ) :: fortran_format ! -- Type specific arguments REAL( Double ), INTENT( IN ) :: scale_factor REAL( Double ), INTENT( IN ) :: add_offset REAL( Double ), INTENT( IN ) :: valid_min REAL( Double ), INTENT( IN ) :: valid_max REAL( Double ), INTENT( IN ) :: fill_value REAL( Double ), INTENT( IN ) :: missing_value ! -- Error handling message log CHARACTER( * ), INTENT( IN ), OPTIONAL :: message_log ! -- Result INTEGER :: error_status ! -- Parameters CHARACTER( * ), PARAMETER :: ROUTINE_NAME = 'PUT_DOUBLE_FLOAT_DEF_ATTS' ! -- Local variables INTEGER :: nf90_status INTEGER :: variable_id CHARACTER( LEN = 128 ), DIMENSION( n_char_def_atts ) :: char_def_att_value REAL( Double ), DIMENSION( n_type_def_atts ) :: type_def_att_value ! --------------------------------- ! Get the variable ID from its name ! --------------------------------- nf90_status = NF90_INQ_VARID( ncdf_id, & variable_name, & variable_id ) IF ( nf90_status /= NF90_NOERR ) THEN error_status = FAILURE CALL display_message( ROUTINE_NAME, & 'Error inquiring variable ID for '// & TRIM( variable_name )// & ' - '// & TRIM( NF90_STRERROR( nf90_status ) ), & error_status, & message_log = message_log ) RETURN END IF ! --------------------------- ! Assemble all the attributes ! --------------------------- ! -- Character attributes char_def_att_value = (/ long_name , & units , & fortran_format /) ! -- Type specific attributes type_def_att_value = (/ scale_factor, & add_offset, & valid_min, & valid_max, & fill_value, & missing_value /) ! ------------------ ! Add the attributes ! ------------------ ! -- Character attributes DO i = 1, n_char_def_atts nf90_status = NF90_PUT_ATT( ncdf_id, & variable_id, & TRIM( CHAR_DEF_ATT_NAME( i ) ), & TRIM( char_def_att_value( i ) ) ) IF ( nf90_status /= NF90_NOERR ) THEN error_status = FAILURE CALL display_message( ROUTINE_NAME, & 'Error writing '// & TRIM( variable_name )// & ' attribute '// & TRIM( CHAR_DEF_ATT_NAME( i ) )// & ' - '// & TRIM( NF90_STRERROR( nf90_status ) ), & error_status, & message_log = message_log ) RETURN END IF END DO ! -- Type specific attributes DO i = 1, n_type_def_atts nf90_status = NF90_PUT_ATT( ncdf_id, & variable_id, & TRIM( TYPE_DEF_ATT_NAME( i ) ), & type_def_att_value( i ) ) IF ( nf90_status /= NF90_NOERR ) THEN error_status = FAILURE CALL display_message( ROUTINE_NAME, & 'Error writing '// & TRIM( variable_name )// & ' attribute '// & TRIM( TYPE_DEF_ATT_NAME( i ) )// & ' - '// & TRIM( NF90_STRERROR( nf90_status ) ), & error_status, & message_log = message_log ) RETURN END IF END DO ! ------------------------ ! Done. Everything worked. ! ------------------------ error_status = SUCCESS END FUNCTION put_double_float_def_atts END MODULE netcdf_utility !------------------------------------------------------------------------------- ! -- MODIFICATION HISTORY -- !------------------------------------------------------------------------------- ! ! $Id: netcdf_utility.f90,v 1.2 2001/09/27 18:03:11 paulv Exp $ ! ! $Date: 2001/09/27 18:03:11 $ ! ! $Revision: 1.2 $ ! ! $Name: Ozone_Match_1-1 $ ! ! $State: Exp $ ! ! $Log: netcdf_utility.f90,v $ ! Revision 1.2 2001/09/27 18:03:11 paulv ! - Added module and subprogram header documentation. ! - Renamed function NF90_PUT_DEF_ATTS to PUT_NCDF_DEF_ATTS. ! - Removed all LONG integer typing except where the type definition defines ! the specific function for overloads. ! - Updated all error status checks from using old definitions in a previous ! ERROR_HANDLER module version. ! - Add RCS keyword list. ! ! !