1278 lines
46 KiB
Fortran
1278 lines
46 KiB
Fortran
! $Id: HdfSdModule.f90,v 1.1 2009/06/18 19:53:07 daven Exp $
|
|
MODULE HdfSdModule
|
|
|
|
!===========================================================================
|
|
! Module "HdfSdModule" contains variables and methods that are used to
|
|
! read data fields stored in HDF-SD format. (bmy, 4/26/02, 4/27/05)
|
|
!
|
|
! In order to use HdfSdModule, you must first install the HDF-4 library
|
|
! on your system. You may download the library source code from:
|
|
!
|
|
! http://hdf.ncsa.uiuc.edu/hdf4.html
|
|
!
|
|
! There is also a good online tutorial about the HDF-SD interface at:
|
|
!
|
|
! http://hdf.ncsa.uiuc.edu/training/HDFtraining/tutorial/sd/sds.html
|
|
!
|
|
! Module Variables:
|
|
! --------------------------------------------------------------------------
|
|
! (1 ) fileId : ID number for the HDF file
|
|
! (2 ) nDataSets : # of data fields contained w/in a HDF file
|
|
! (3 ) nAttributes : # of global atttributes contained w/in a HDF file
|
|
! (4 ) saveFileName : Shadow variable used to store HDF file name
|
|
!
|
|
! Module Methods:
|
|
! --------------------------------------------------------------------------
|
|
! (1 ) sdOpen : Opens the HDF file
|
|
! (2 ) sdClose : Closes the HDF file
|
|
! (3 ) sdName2Index : Locates position of field w/in a HDF file by name
|
|
! (4 ) sdOpenField : Opens a data field w/in a HDF file by index
|
|
! (5 ) sdOpenFieldByName : Opens a data field w/in a HDF file by name
|
|
! (6 ) sdCloseField : Closes access to a data field w/in a HDF file
|
|
! (7 ) sdPrintInfo : Prints information about fields w/in a HDF file
|
|
! (8 ) sdGetFieldDims : Gets dimensions of a given field w/in a HDF file
|
|
! (9 ) sdGetData1dI4 : Reads a 1-D INTEGER data field from the HDF file
|
|
! (10) sdGetData1d : Reads a 1-D REAL*4 data field from the HDF file
|
|
! (11) sdGetData2d : Reads a 2-D REAL*4 data field from the HDF file
|
|
! (12) sdGetData3d : Reads a 3-D REAL*4 data field from the HDF file
|
|
! (13) sdGetData4d : Reads a 4-D REAL*4 data field from the HDF file
|
|
! (14) sdGetData1d1Time : Reads one time value of a 2-D REAL*4 data field
|
|
! (15) sdGetData2d1Time : Reads one time value of a 2-D REAL*4 data field
|
|
! (16) sdGetData2d1TimeR8: Reads one time value of a 2-D REAL*8 data fiedl
|
|
! (17) sdGetData3d1Time : Reads one time value of a 3-D REAL*4 data field
|
|
! (18) sdGetData3d1TimeR8: Reads one time value of a 3-D REAL*8 data fiedl
|
|
! (19) sdShift1d : Shifts a 1-D REAL*4 data field by 180 degrees
|
|
! (20) sdShift2d : Shifts a 2-D REAL*4 data field by 180 degrees
|
|
! (21) sdShift3d : Shifts a 3-D REAL*4 data field by 180 degrees
|
|
! (22) sdShift4d : Shifts a 4-D REAL*4 data field by 180 degrees
|
|
! (23) sdGetMaxDims : Returns the value of MAX_DIMS to outside routines
|
|
!
|
|
! Module Interfaces:
|
|
! --------------------------------------------------------------------------
|
|
! (1 ) sdGetData : sdGetData1d, sdGetData1d_i4, sdGetData2d,
|
|
! sdGetData3d, sdGetData4d
|
|
! (2 ) sdGetData1 : sdGetData1d1Time, sdGetData2d1Time,
|
|
! sdGetData2d1TimeR8, sdGetData3d1Time,
|
|
! sdGetData3d1TimeR8
|
|
! (3 ) sdShift : sdShift1d, sdShift2d, sdShift3d, sdShift4d
|
|
!
|
|
! NOTES:
|
|
! (1 ) HdfSdModule is designed to only have one HDF file open at a time.
|
|
! Once you have opened a file, you may attach/detach from as many
|
|
! individual data fields as you want. (bmy, 4/9/02)
|
|
! (2 ) Added routines sdGetData1d1Time, sdGetData2d1Time, and
|
|
! sdGetData3d1Time to read an array for only one time value
|
|
! from the HDF file, instead of reading the whole array (bmy, 4/25/02)
|
|
! (3 ) Declared internal routines and variables PRIVATE (bmy, 7/19/02)
|
|
! (4 ) Added routines sdGetData2d1TimeR8 and sdGetData3d1TimeR8 in order
|
|
! to read REAL*8 data from the HDF file. Also changed the name of
|
|
! sdGetData1d_i4 to sdGetData1dI4. (bmy, 7/19/02)
|
|
! (5 ) Minor updates. Improved documentation and error/warning messages.
|
|
! (bmy, 7/3/03)
|
|
! (6 ) Modified for inclusion into GEOS-CHEM (bmy, 4/27/05)
|
|
!===========================================================================
|
|
USE HdfIncludeModule
|
|
|
|
IMPLICIT NONE
|
|
|
|
!=====================================================================
|
|
! MODULE PRIVATE DECLARATIONS
|
|
!=====================================================================
|
|
|
|
! Make everything PRIVATE ...
|
|
PRIVATE
|
|
|
|
! ... except these routines
|
|
PUBLIC :: sdClose
|
|
PUBLIC :: sdCloseField
|
|
PUBLIC :: sdGetMaxDims
|
|
PUBLIC :: sdGetData
|
|
PUBLIC :: sdGetData1
|
|
PUBLIC :: sdGetFieldDims
|
|
PUBLIC :: sdName2Index
|
|
PUBLIC :: sdOpen
|
|
PUBLIC :: sdOpenField
|
|
PUBLIC :: sdOpenFieldByName
|
|
PUBLIC :: sdPrintInfo
|
|
PUBLIC :: sdShift
|
|
|
|
!=====================================================================
|
|
! MODULE VARIABLES
|
|
!=====================================================================
|
|
INTEGER :: fileId, nDataSets, nAttributes
|
|
INTEGER, PARAMETER :: MAX_DIMS = 4
|
|
|
|
! Shadow variable for file name
|
|
CHARACTER(LEN=255), PRIVATE :: saveFileName
|
|
|
|
!=======================================================================
|
|
! Module interfaces: allow you to associate a name w/ several routines
|
|
! with different numbers of arguments or different argument types
|
|
!=======================================================================
|
|
INTERFACE sdGetData
|
|
MODULE PROCEDURE sdGetData1dI4
|
|
MODULE PROCEDURE sdGetData1d
|
|
MODULE PROCEDURE sdGetData2d
|
|
MODULE PROCEDURE sdGetData3d
|
|
MODULE PROCEDURE sdGetData4d
|
|
END INTERFACE
|
|
|
|
INTERFACE sdGetData1
|
|
MODULE PROCEDURE sdGetData1d1Time
|
|
MODULE PROCEDURE sdGetData2d1Time
|
|
MODULE PROCEDURE sdGetData3d1Time
|
|
MODULE PROCEDURE sdGetData2d1TimeR8
|
|
MODULE PROCEDURE sdGetData3d1TimeR8
|
|
END INTERFACE
|
|
|
|
INTERFACE sdShift
|
|
MODULE PROCEDURE sdShift1d
|
|
MODULE PROCEDURE sdShift2d
|
|
MODULE PROCEDURE sdShift3d
|
|
MODULE PROCEDURE sdShift4d
|
|
END INTERFACE
|
|
|
|
CONTAINS
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdOpen( fileName )
|
|
|
|
!=====================================================================
|
|
! Subroutine "sdOpenFile" opens an HDF file and initializes the
|
|
! scientific datasaet (HDF-SD) interface. (bmy, 4/3/02)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1) fileName : CHARACTER name of the HDF-EOS file to be opened
|
|
!
|
|
! HDF-EOS library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1) sfStart : returns INTEGER value ( fileId )
|
|
!
|
|
! NOTES:
|
|
!=====================================================================
|
|
|
|
! References to F90 Modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
CHARACTER(LEN=*) :: fileName
|
|
|
|
! Local Variables
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: sfStart
|
|
|
|
!=====================================================================
|
|
! sdOpen begins here!
|
|
!=====================================================================
|
|
|
|
! Save file name to a private shadow variable
|
|
saveFileName = TRIM( fileName )
|
|
|
|
! Open the HDF file
|
|
fileId = sfStart( TRIM( fileName ), DFACC_RDONLY )
|
|
|
|
! Error check fileId
|
|
IF ( fileId == FAIL ) THEN
|
|
message = 'ERROR: Could not open the HDF file ' // TRIM( fileName )
|
|
CALL ERROR_STOP( message, 'sdOpen' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE sdOpen
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdClose( fileName )
|
|
|
|
!=====================================================================
|
|
! Subroutine "sdClose" terminates the HDF Scientific Dataset
|
|
! (HDF-SD) interface and closes the HDF file. (bmy, 4/3/02, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1) fileName : CHARACTER name of the HDF-EOS file to be opened
|
|
!
|
|
! HDF-EOS library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1) sfEnd : takes INTEGER value ( fileId )
|
|
!=====================================================================
|
|
|
|
! References to F90 Modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
CHARACTER(LEN=*), INTENT(IN) :: fileName
|
|
|
|
! Local variables
|
|
INTEGER :: status
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: sfEnd
|
|
|
|
!=====================================================================
|
|
! sdClose begins here!
|
|
!=====================================================================
|
|
|
|
! Close the HDF file
|
|
status = sfEnd( fileId )
|
|
|
|
! Error check status
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: could not close the HDF file: ' // TRIM( fileName )
|
|
CALL ERROR_STOP( message, 'sdClose' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE sdClose
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdName2Index( name, n )
|
|
|
|
!===================================================================
|
|
! Subroutine sdName2Index finds out the number of a given data set
|
|
! within an HDF file given its name. (bmy, 4/3/02)
|
|
!
|
|
! Arguments as Input:
|
|
! ------------------------------------------------------------------
|
|
! (1 ) name (CHARACTER) : Name of the field to search for
|
|
!
|
|
! Arguments as Output:
|
|
! ------------------------------------------------------------------
|
|
! (2 ) n (INTEGER) : Number of the field in the HDF file
|
|
!
|
|
! External Functions:
|
|
! ------------------------------------------------------------------
|
|
! (1 ) sfN2Index (INTEGER) : Returns index based on the name
|
|
!===================================================================
|
|
|
|
! References to F90 Modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
CHARACTER(LEN=*), INTENT(IN) :: name
|
|
INTEGER, INTENT(OUT) :: n
|
|
|
|
! Local variables
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: sfN2Index
|
|
|
|
!=====================================================================
|
|
! sdName2Index begins here!
|
|
!=====================================================================
|
|
|
|
! Translate NAME to the HDF-EOS index number
|
|
n = sfN2Index( fileId, TRIM( name ) )
|
|
|
|
! Make sure INDEX is valid
|
|
IF ( n == FAIL ) THEN
|
|
message = 'ERROR: ' // TRIM( name ) // &
|
|
' is not found in ' // TRIM( saveFileName )
|
|
CALL ERROR_STOP( message, 'sdName2Index' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE sdName2Index
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdOpenField( n, sdId )
|
|
|
|
!===================================================================
|
|
! Function sdOpenField initializes the HDF-SD interface for the Nth
|
|
! field in the HDF file. The SD ID # is returned to the calling
|
|
! program. (bmy, 4/3/02, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! ------------------------------------------------------------------
|
|
! (1 ) n (INTEGER) : # of the scientific dataset in the HDF file
|
|
!
|
|
! Arguments as Output:
|
|
! ------------------------------------------------------------------
|
|
! (2 ) sdId (INTEGER) : ID # for the corresponding SD
|
|
!
|
|
! External Functions:
|
|
! ------------------------------------------------------------------
|
|
! (1 ) sfSelect (INTEGER) : Returns ID # for scientific dataset
|
|
!===================================================================
|
|
|
|
! References to F90 Modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: n
|
|
INTEGER, INTENT(OUT) :: sdId
|
|
|
|
! Local variables
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
! External functions
|
|
INTEGER :: sfSelect
|
|
|
|
!===================================================================
|
|
! sdOpenField begins here!
|
|
!===================================================================
|
|
|
|
! Get the SD Index for the Nth dataset in the file
|
|
sdId = sfSelect( fileId, n )
|
|
|
|
! Make sure data set ID is valid
|
|
IF ( sdId == FAIL ) then
|
|
message = 'ERROR: Invalid ID # for HDF-SDATA field!'
|
|
CALL ERROR_STOP( message, 'sdGetFieldId' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE sdOpenField
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdOpenFieldByName( name, sdId )
|
|
|
|
!===================================================================
|
|
! Function sdOpenFieldbyName initializes the HDF-SD interface for
|
|
! given the field name. The SD ID # is returned to the calling
|
|
! program. (bmy, 4/3/02, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! ------------------------------------------------------------------
|
|
! (1 ) name (CHARACTER) : name of the SD field in the HDF file
|
|
!
|
|
! Arguments as Output:
|
|
! ------------------------------------------------------------------
|
|
! (2 ) sdId (INTEGER) : ID # for the corresponding SD
|
|
!
|
|
! External Functions:
|
|
! ------------------------------------------------------------------
|
|
! (1 ) sfSelect (INTEGER) : Returns ID # for scientific dataset
|
|
!===================================================================
|
|
|
|
! Arguments
|
|
!CHARACTER(LEN=255) :: name
|
|
CHARACTER(LEN=*) :: name
|
|
INTEGER, INTENT(OUT) :: sdId
|
|
|
|
! Local variables
|
|
INTEGER :: n
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
!===================================================================
|
|
! sdOpenFieldByName begins here!
|
|
!===================================================================
|
|
|
|
! Convert name to index
|
|
CALL sdName2Index( name, n )
|
|
|
|
! Open field w/ via the index
|
|
CALL sdOpenField( n, sdId )
|
|
|
|
END SUBROUTINE sdOpenFieldByName
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdCloseField( sdId )
|
|
|
|
!=====================================================================
|
|
! Subroutine sdCloseField terminates the HDF-SD interface for a
|
|
! given field. (bmy, 4/3/02, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) N (INTEGER) : Number of the scientific dataset in the HDF file
|
|
!
|
|
! External Functions:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) sfSelect (INTEGER) : Returns ID # if successful or FAIL if not
|
|
!=====================================================================
|
|
|
|
! References to F90 Modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: sdId
|
|
|
|
! Local variables
|
|
INTEGER :: status
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
! External functions
|
|
INTEGER :: sfEndAcc
|
|
|
|
!=====================================================================
|
|
! sdCloseField begins here!
|
|
!=====================================================================
|
|
|
|
! Terminate the ID # for this field
|
|
status = sfEndAcc( sdId )
|
|
|
|
! Make sure data set ID is valid
|
|
IF ( status == FAIL ) then
|
|
message = 'ERROR: Could not terminate HDF-SDATA interface!'
|
|
CALL ERROR_STOP( message, 'sdCloseField' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE sdCloseField
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdPrintInfo
|
|
|
|
!=====================================================================
|
|
! Subroutine sdPrintInfo obtains and prints information about each
|
|
! data field stored in the HDF file. (bmy, 4/3/02, 7/3/03)
|
|
!
|
|
! HDF-EOS library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1) sdFInfo : returns nAttributes, nDataSets
|
|
! (2) sdGInfo : returns name, rank, dims, numType, nAttrs for fields
|
|
!=====================================================================
|
|
|
|
! References to F90 Modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Local variables
|
|
INTEGER :: sdId, rank, dims(MAX_DIMS), numType
|
|
INTEGER :: n, i, nAttrs, status
|
|
CHARACTER(LEN=9) :: numStr
|
|
CHARACTER(LEN=255) :: message, name
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: sfFInfo, sfGInfo
|
|
|
|
!=====================================================================
|
|
! sdPrintInfo begins here!
|
|
!
|
|
! Get global file information: # of data sets and attributes
|
|
!=====================================================================
|
|
status = sfFInfo( fileId, nDataSets, nAttributes )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'Could not get info for ' // TRIM( saveFileName )
|
|
CALL ERROR_STOP( message, 'sdGetInfo' )
|
|
ENDIF
|
|
|
|
!=====================================================================
|
|
! Get information about each field in the file
|
|
!=====================================================================
|
|
DO n = 0, nDataSets-1
|
|
|
|
! Initialize the HDF-SD interface for field # N
|
|
CALL sdOpenField( n, sdId )
|
|
|
|
! Get information about field #N from the HDF File
|
|
status = sfGInfo( sdId, name, rank, dims, numType, nAttrs )
|
|
|
|
! Print info if successful
|
|
IF ( status == SUCCEED ) THEN
|
|
|
|
! Define string for number type
|
|
SELECT CASE ( numType )
|
|
CASE( 5 )
|
|
numStr = 'REAL*4 '
|
|
CASE( 6 )
|
|
numStr = 'REAL*8 '
|
|
CASE( 24 )
|
|
numStr = 'INTEGER*4'
|
|
CASE DEFAULT
|
|
numStr = 'N/A '
|
|
END SELECT
|
|
|
|
! Print information
|
|
PRINT*, '--------------------------------------'
|
|
PRINT*, 'HDF-SDATA # : ', n
|
|
PRINT*, 'Name : ', TRIM( name )
|
|
PRINT*, 'Rank : ', rank
|
|
PRINT*, 'Dimensions : ', (dims(i), i=1,rank)
|
|
PRINT*, 'Number Type : ', numStr
|
|
PRINT*, 'Attributes : ', nAttrs
|
|
ENDIF
|
|
|
|
! Terminate the HDF-SD interface for field # N
|
|
CALL sdCloseField( sdId )
|
|
|
|
ENDDO
|
|
|
|
END SUBROUTINE sdPrintInfo
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdGetFieldDims( sdId, nDims, dims )
|
|
|
|
!===================================================================
|
|
! Subroutine sdGetFieldDims returns dimension information for
|
|
! the given field stored in the HDF file. (bmy, 4/3/02, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! ------------------------------------------------------------------
|
|
! (1) sdId (INTEGER) : HDF-SD ID # for the given field
|
|
!
|
|
! Arguments as Output:
|
|
! ------------------------------------------------------------------
|
|
! (2) nDims (INTEGER) : Number of dimensions
|
|
! (3) dims (INTEGER) : Array containing dimension information
|
|
!
|
|
! HDF-EOS library routines referenced:
|
|
! ------------------------------------------------------------------
|
|
! (1) sdGInfo : returns name, rank, dims, numType, nAttrs for fields
|
|
!===================================================================
|
|
|
|
! References to F90 Modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: sdId
|
|
INTEGER, INTENT(OUT) :: nDims, dims(MAX_DIMS)
|
|
|
|
! Local variables
|
|
INTEGER :: numType, nAttrs, status
|
|
CHARACTER(LEN=255) :: message, name
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: sfFInfo, sfGInfo
|
|
|
|
!===================================================================
|
|
! sdGetFieldDims begins here!
|
|
!===================================================================
|
|
|
|
! Zero out dimension array
|
|
dims(:) = 0
|
|
|
|
! Get information about field #N from the HDF File
|
|
status = sfGInfo( sdId, name, nDims, dims, numType, nAttrs )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not locate HDF-SDATA field ' // &
|
|
TRIM( name ) // ' in ' // TRIM( saveFileName )
|
|
CALL ERROR_STOP( message, 'sdPrintInfo' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE sdGetFieldDims
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdGetData1dI4( sdId, nX, tData )
|
|
|
|
!=====================================================================
|
|
! Subroutine sdGetData1dI4 reads a 1-D data array (INTEGER)
|
|
! from the HDF file. The entire array will be returned.
|
|
! (bmy, 7/19/02, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) sdId (INTEGER) : HDF-SD # of the data field in the HDF file
|
|
! (2 ) nX (INTEGER) : Number of elements in the X-dimension
|
|
!
|
|
! Arguments as Output:
|
|
! --------------------------------------------------------------------
|
|
! (3 ) tData (INTEGER) : Data array
|
|
!
|
|
! HDF library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) sfRData : Reads numeric data from the HDF file
|
|
!=====================================================================
|
|
|
|
! References to F90 Modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: sdId, nX, tData(nX)
|
|
|
|
! Local variables
|
|
INTEGER :: status
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: sfRData
|
|
|
|
!===================================================================
|
|
! sdGetData1d_i4 begins here!
|
|
!===================================================================
|
|
|
|
! Read the data for the given field
|
|
status = sfRData( sdId, (/0/), (/1/), (/nX/), tData )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not read HDF-SDATA field from ' // &
|
|
TRIM( saveFileName )
|
|
CALL ERROR_STOP( message, 'sdGetData1d' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE sdGetData1dI4
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdGetData1d( sdId, nX, tData )
|
|
|
|
!=====================================================================
|
|
! Subroutine sdGetData1d reads a 1-D data array from the HDF file.
|
|
! The entire array will be returned. (bmy, 4/3/02, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) sdId (INTEGER) : HDF-SD # of the data field in the HDF file
|
|
! (2 ) nX (INTEGER) : Number of elements in the X-dimension
|
|
!
|
|
! Arguments as Output:
|
|
! --------------------------------------------------------------------
|
|
! (3 ) tData (REAL*4 ) : Data array
|
|
!
|
|
! HDF library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) sfRData : Reads numeric data from the HDF file
|
|
!=====================================================================
|
|
|
|
! References to F90 Modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: sdId, nX
|
|
REAL*4, INTENT(OUT) :: tData(nX)
|
|
|
|
! Local variables
|
|
INTEGER :: status
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: sfRData
|
|
|
|
!===================================================================
|
|
! sdGetData1d begins here!
|
|
!===================================================================
|
|
|
|
! Read the data for the given field
|
|
status = sfRData( sdId, (/0/), (/1/), (/nX/), tData )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not read HDF-SDATA field from ' // &
|
|
TRIM( saveFileName )
|
|
CALL ERROR_STOP( message, 'sdGetData1d' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE sdGetData1d
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdGetData2d( sdId, nX, nY, tData )
|
|
|
|
!=====================================================================
|
|
! Subroutine sdGetData2d reads a 2-D data array from the HDF file.
|
|
! The entire array will be returned. (bmy, 4/3/02, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) sdId (INTEGER) : HDF-SD # of the data field in the HDF file
|
|
! (2 ) nX (INTEGER) : Number of elements in the X-dimension
|
|
! (3 ) nY (INTEGER) : Number of elements in the Y-dimension
|
|
!
|
|
! Arguments as Output:
|
|
! --------------------------------------------------------------------
|
|
! (4 ) tData (REAL*4 ) : Data array
|
|
!
|
|
! HDF library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) sfRData : Reads numeric data from the HDF file
|
|
!=====================================================================
|
|
|
|
! References to F90 Modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: sdId, nX, nY
|
|
REAL*4, INTENT(OUT) :: tData(nX,nY)
|
|
|
|
! Local variables
|
|
INTEGER :: status
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: sfRData
|
|
|
|
!===================================================================
|
|
! sdGetData2d begins here!
|
|
!===================================================================
|
|
|
|
! Read the data for the given field
|
|
status = sfRData( sdId, (/0,0/), (/1,1/), (/nX,nY/), tData )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not read HDF-SDATA field from ' // &
|
|
TRIM( saveFileName )
|
|
CALL ERROR_STOP( message, 'sdGetData2d' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE sdGetData2d
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdGetData3d( sdId, nX, nY, nZ, tData )
|
|
|
|
!=====================================================================
|
|
! Subroutine sdGetData3d reads a 3-D data array from the HDF file.
|
|
! The entire array will be returned. (bmy, 4/3/02, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) sdId (INTEGER) : HDF-SD # of the data field in the HDF file
|
|
! (2 ) nX (INTEGER) : Number of elements in the X-dimension
|
|
! (3 ) nY (INTEGER) : Number of elements in the Y-dimension
|
|
! (4 ) nZ (INTEGER) : Number of elements in the Z-dimension
|
|
!
|
|
! Arguments as Output:
|
|
! --------------------------------------------------------------------
|
|
! (5 ) tData (REAL*4 ) : Data array
|
|
!
|
|
! HDF library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) sfRData : Reads numeric data from the HDF file
|
|
!=====================================================================
|
|
|
|
! References to F90 Modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: sdId, nX, nY, nZ
|
|
REAL*4, INTENT(OUT) :: tData(nX,nY,nZ)
|
|
|
|
! Local variables
|
|
INTEGER :: status
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: sfRData
|
|
|
|
!===================================================================
|
|
! sdGetData3d begins here!
|
|
!===================================================================
|
|
|
|
! Read the data for the given field
|
|
status = sfRData( sdId, (/0,0,0/), (/1,1,1/), (/nX,nY,nZ/), tData )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not read HDF-SDATA field from ' // &
|
|
TRIM( saveFileName )
|
|
CALL ERROR_STOP( message, 'sdGetData3d' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE sdGetData3d
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdGetData4d( sdId, nX, nY, nZ, nW, tData )
|
|
|
|
!=====================================================================
|
|
! Subroutine sdGetData4d reads a 3-D data array from the HDF file.
|
|
! The entire array will be returned. (bmy, 4/9/02, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) sdId (INTEGER) : HDF-SD # of the data field in the HDF file
|
|
! (2 ) nX (INTEGER) : Number of elements in the X-dimension
|
|
! (3 ) nY (INTEGER) : Number of elements in the Y-dimension
|
|
! (4 ) nZ (INTEGER) : Number of elements in the Z-dimension
|
|
! (5 ) nW (INTEGER) : Number of elements in the W-dimension
|
|
!
|
|
! Arguments as Output:
|
|
! --------------------------------------------------------------------
|
|
! (6 ) tData (REAL*4 ) : Data array
|
|
!
|
|
! HDF library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) sfRData : Reads numeric data from the HDF file
|
|
!
|
|
! NOTES:
|
|
!=====================================================================
|
|
|
|
! References to F90 Modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: sdId, nX, nY, nZ, nW
|
|
REAL*4, INTENT(OUT) :: tData(nX,nY,nZ,nW)
|
|
|
|
! Local variables
|
|
INTEGER :: status
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: sfRData
|
|
|
|
!===================================================================
|
|
! sdGetData4d begins here!
|
|
!===================================================================
|
|
|
|
! Read the data for the given field
|
|
status = sfRData( sdId, (/0,0,0,0/), (/1,1,1,1/), (/nX,nY,nZ,nW/), tData )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not read HDF-SDATA field from ' // &
|
|
TRIM( saveFileName )
|
|
CALL ERROR_STOP( message, 'sdGetData4d' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE sdGetData4d
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdGetData1d1Time( sdId, nTime, nX, tData )
|
|
|
|
!=====================================================================
|
|
! Subroutine sdGetData2d1Time reads a 1-D data array for a single
|
|
! time. We assume that the first dimension of the array in the
|
|
! HDF file is a spatial dimension, and the 2nd dimension is a time
|
|
! dimension. (bmy, 4/26/02, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) sdId (INTEGER) : HDF-SD # of the data field in the HDF file
|
|
! (2 ) nTime (INTEGER) : Time index (starting from 0)
|
|
! (3 ) nX (INTEGER) : Number of elements in the X-dimension
|
|
!
|
|
! Arguments as Output:
|
|
! --------------------------------------------------------------------
|
|
! (4 ) tData (REAL*4 ) : Data array
|
|
!
|
|
! HDF library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) sfRData : Reads numeric data from the HDF file
|
|
!
|
|
! NOTES:
|
|
!=====================================================================
|
|
|
|
! References to F90 Modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: sdId, nX, nTime
|
|
REAL*4, INTENT(OUT) :: tData(nX)
|
|
|
|
! Local variables
|
|
INTEGER :: status
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: sfRData
|
|
|
|
!===================================================================
|
|
! sdGetData1d1Time begins here!
|
|
!===================================================================
|
|
|
|
! Read the data for the given field
|
|
status = sfRData( sdId, (/0,nTime/), (/1,1/), (/nX,1/), tData )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not read HDF-SDATA field from ' // &
|
|
TRIM( saveFileName )
|
|
CALL ERROR_STOP( message, 'sdGetData2d1Time' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE sdGetData1d1Time
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdGetData2d1Time( sdId, nTime, nX, nY, tData )
|
|
|
|
!=====================================================================
|
|
! Subroutine sdGetData2d1Time reads a 2-D data array for a single
|
|
! time. We assume that the first 2 dimensions of the array in the
|
|
! HDF file are spatial dimensions, and the 3rd dimension is a time
|
|
! dimension. (bmy, 4/26/02, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) sdId (INTEGER) : HDF-SD # of the data field in the HDF file
|
|
! (2 ) nTime (INTEGER) : Time index (starting from 0)
|
|
! (3 ) nX (INTEGER) : Number of elements in the X-dimension
|
|
! (4 ) nY (INTEGER) : Number of elements in the Y-dimension
|
|
!
|
|
! Arguments as Output:
|
|
! --------------------------------------------------------------------
|
|
! (5 ) tData (REAL*4 ) : Data array
|
|
!
|
|
! HDF library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) sfRData : Reads numeric data from the HDF file
|
|
!
|
|
! NOTES:
|
|
!=====================================================================
|
|
|
|
! References to F90 Modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: sdId, nX, nY, nTime
|
|
REAL*4, INTENT(OUT) :: tData(nX,nY)
|
|
|
|
! Local variables
|
|
INTEGER :: status
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: sfRData
|
|
|
|
!===================================================================
|
|
! sdGetData2d1Time begins here!
|
|
!===================================================================
|
|
|
|
! Read the data for the given field
|
|
status = sfRData( sdId, (/0,0,nTime/), (/1,1,1/), (/nX,nY,1/), tData )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not read HDF-SDATA field from ' // &
|
|
TRIM( saveFileName )
|
|
CALL ERROR_STOP( message, 'sdGetData2d1Time' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE sdGetData2d1Time
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdGetData2d1TimeR8( sdId, nTime, nX, nY, tData )
|
|
|
|
!=====================================================================
|
|
! Subroutine sdGetData2d1TimeR8 reads a 2-D data array (REAL*8) for
|
|
! a single time. We assume that the first 2 dimensions of the array
|
|
! in the HDF file are spatial dimensions, and the 3rd dimension is
|
|
! a time dimension. (bmy, 7/19/02, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) sdId (INTEGER) : HDF-SD # of the data field in the HDF file
|
|
! (2 ) nTime (INTEGER) : Time index (starting from 0)
|
|
! (3 ) nX (INTEGER) : Number of elements in the X-dimension
|
|
! (4 ) nY (INTEGER) : Number of elements in the Y-dimension
|
|
!
|
|
! Arguments as Output:
|
|
! --------------------------------------------------------------------
|
|
! (5 ) tData (REAL*8 ) : Data array
|
|
!
|
|
! HDF library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) sfRData : Reads numeric data from the HDF file
|
|
!
|
|
! NOTES:
|
|
!=====================================================================
|
|
|
|
! References to F90 Modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: sdId, nX, nY, nTime
|
|
REAL*8, INTENT(OUT) :: tData(nX,nY)
|
|
|
|
! Local variables
|
|
INTEGER :: status
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: sfRData
|
|
|
|
!===================================================================
|
|
! sdGetData2d1Time begins here!
|
|
!===================================================================
|
|
|
|
! Read the data for the given field
|
|
status = sfRData( sdId, (/0,0,nTime/), (/1,1,1/), (/nX,nY,1/), tData )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not read HDF-SDATA field from ' // &
|
|
TRIM( saveFileName )
|
|
CALL ERROR_STOP( message, 'sdGetData2d1Time' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE sdGetData2d1TimeR8
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdGetData3d1Time( sdId, nTime, nX, nY, nZ, tData )
|
|
|
|
!=====================================================================
|
|
! Subroutine sdGetData3d1Time reads a 3-D data array for a single
|
|
! time. We assume that the first 3 dimensions of the array in the
|
|
! HDF file are spatial dimensions, and the 4th dimension is a time
|
|
! dimension. (bmy, 4/26/02, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1) sdId (INTEGER) : HDF-SD # of the data field in the HDF file
|
|
! (2) nX (INTEGER) : Number of elements in the X-dimension
|
|
! (3) nY (INTEGER) : Number of elements in the Y-dimension
|
|
! (4) nZ (INTEGER) : Number of elements in the Z-dimension
|
|
! (5) nW (INTEGER) : Number of elements in the W-dimension
|
|
!
|
|
! Arguments as Output:
|
|
! --------------------------------------------------------------------
|
|
! (6) tData (REAL*4 ) : Data array
|
|
!
|
|
! HDF library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1) sfRData : Reads numeric data from the HDF file
|
|
!
|
|
! NOTES:
|
|
!=====================================================================
|
|
|
|
! References to F90 Modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: sdId, nTime, nX, nY, nZ
|
|
REAL*4, INTENT(OUT) :: tData(nX,nY,nZ)
|
|
|
|
! Local variables
|
|
INTEGER :: status
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: sfRData
|
|
|
|
!===================================================================
|
|
! sdGetData3d1Time begins here!
|
|
!===================================================================
|
|
|
|
! Read the data for the given field
|
|
status = sfRData( sdId, (/0,0,0,nTime/), (/1,1,1,1/), &
|
|
(/nX,nY,nZ,1/), tData )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not read HDF-SDAT field from ' // &
|
|
TRIM( saveFileName )
|
|
CALL ERROR_STOP( message, 'sdGetData3d1Time' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE sdGetData3d1Time
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdGetData3d1TimeR8( sdId, nTime, nX, nY, nZ, tData )
|
|
|
|
!=====================================================================
|
|
! Subroutine sdGetData3d1TimeR8 reads a 3-D data array (REAL*8) for
|
|
! a single time. We assume that the first 3 dimensions of the array
|
|
! in the HDF file are spatial dimensions, and the 4th dimension is
|
|
! a time dimension. (bmy, 7/19/02, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1) sdId (INTEGER) : HDF-SD # of the data field in the HDF file
|
|
! (2) nX (INTEGER) : Number of elements in the X-dimension
|
|
! (3) nY (INTEGER) : Number of elements in the Y-dimension
|
|
! (4) nZ (INTEGER) : Number of elements in the Z-dimension
|
|
! (5) nW (INTEGER) : Number of elements in the W-dimension
|
|
!
|
|
! Arguments as Output:
|
|
! --------------------------------------------------------------------
|
|
! (6) tData (REAL*8 ) : Data array
|
|
!
|
|
! HDF library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1) sfRData : Reads numeric data from the HDF file
|
|
!
|
|
! NOTES:
|
|
!=====================================================================
|
|
|
|
! References to F90 Modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: sdId, nTime, nX, nY, nZ
|
|
REAL*8, INTENT(OUT) :: tData(nX,nY,nZ)
|
|
|
|
! Local variables
|
|
INTEGER :: status
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: sfRData
|
|
|
|
!===================================================================
|
|
! sdGetData3d1Time begins here!
|
|
!===================================================================
|
|
|
|
! Read the data for the given field
|
|
status = sfRData( sdId, (/0,0,0,nTime/), (/1,1,1,1/), &
|
|
(/nX,nY,nZ,1/), tData )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not read HDF-SDATA field from ' // &
|
|
TRIM( saveFileName )
|
|
CALL ERROR_STOP( message, 'sdGetData3d1Time' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE sdGetData3d1TimeR8
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdShift1d( nX, tData )
|
|
|
|
!=====================================================================
|
|
! Subroutine sdShift1d shifts a 1-D data array by 180 degrees.
|
|
! This is necessary since fvDAS data starts at 0 longitude, but
|
|
! GEOS-CHEM needs the first box to be at -180 longitude. (bmy, 4/3/02)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1) nX (INTEGER) : Number of elements in the X-dimension
|
|
! (2) tData (REAL*4 ) : Data array
|
|
!
|
|
! Arguments as Output:
|
|
! --------------------------------------------------------------------
|
|
! (2) tData (REAL*4 ) : Data array (shifted by 180 degrees)
|
|
!=====================================================================
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: nX
|
|
REAL*4, INTENT(INOUT) :: tData(nX)
|
|
|
|
!===================================================================
|
|
! sdShift1d begins here!
|
|
!===================================================================
|
|
|
|
! Shift the longitude dimension by nX/2 elements
|
|
tData = CSHIFT( tdata, nX/2, 1 )
|
|
|
|
END SUBROUTINE sdShift1d
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdShift2d( nX, nY, tData )
|
|
|
|
!=====================================================================
|
|
! Subroutine sdShift2d shifts a 2-D data array by 180 degrees.
|
|
! This is necessary since fvDAS data starts at 0 longitude, but
|
|
! GEOS-CHEM needs the first box to be at -180 longitude. (bmy, 4/3/02)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1) nX (INTEGER) : Number of elements in the X-dimension
|
|
! (2) nY (INTEGER) : Number of elements in the Y-dimension
|
|
! (3) tData (REAL*4 ) : Data array
|
|
!
|
|
! Arguments as Output:
|
|
! --------------------------------------------------------------------
|
|
! (3) tData (REAL*4 ) : Data array (shifted by 180 degrees)
|
|
!=====================================================================
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: nX, nY
|
|
REAL*4, INTENT(INOUT) :: tData(nX,nY)
|
|
|
|
!===================================================================
|
|
! sdShift2d begins here!
|
|
!===================================================================
|
|
|
|
! Shift the longitude dimension by nX/2 elements
|
|
tData = CSHIFT( tdata, nX/2, 1 )
|
|
|
|
END SUBROUTINE sdShift2d
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdShift3d( nX, nY, nZ, tData )
|
|
|
|
!=====================================================================
|
|
! Subroutine sdShift3d shifts a 3-D data array by 180 degrees.
|
|
! This is necessary since fvDAS data starts at 0 longitude, but
|
|
! GEOS-CHEM needs the first box to be at -180 longitude. (bmy, 4/3/02)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) nX (INTEGER) : Number of elements in the X-dimension
|
|
! (2 ) nY (INTEGER) : Number of elements in the Y-dimension
|
|
! (3 ) nZ (INTEGER) : Number of elements in the Z-dimension
|
|
! (4 ) tData (REAL*4 ) : Data array
|
|
!
|
|
! Arguments as Output:
|
|
! --------------------------------------------------------------------
|
|
! (5 ) tData (REAL*4 ) : Data array (shifted by 180 degrees)
|
|
!=====================================================================
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: nX, nY, nZ
|
|
REAL*4, INTENT(INOUT) :: tData(nX,nY,nZ)
|
|
|
|
!===================================================================
|
|
! sdShift3d begins here!
|
|
!===================================================================
|
|
|
|
! Shift the longitude dimension by nX/2 elements
|
|
tData = CSHIFT( tdata, nX/2, 1 )
|
|
|
|
END SUBROUTINE sdShift3d
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdShift4d( nX, nY, nZ, nW, tData )
|
|
|
|
!=====================================================================
|
|
! Subroutine sdShift4d shifts a 4-D data array by 180 degrees.
|
|
! This is necessary since fvDAS data starts at 0 longitude, but
|
|
! GEOS-CHEM needs the first box to be at -180 longitude. (bmy, 4/3/02)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) nX (INTEGER) : Number of elements in the X-dimension
|
|
! (2 ) nY (INTEGER) : Number of elements in the Y-dimension
|
|
! (3 ) nZ (INTEGER) : Number of elements in the Z-dimension
|
|
! (4 ) nW (INTEGER) : Number of elements in the W-dimension
|
|
! (5 ) tData (REAL*4 ) : Data array
|
|
!
|
|
! Arguments as Output:
|
|
! --------------------------------------------------------------------
|
|
! (5 ) tData (REAL*4 ) : Data array (shifted by 180 degrees)
|
|
!=====================================================================
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: nX, nY, nZ, nW
|
|
REAL*4, INTENT(INOUT) :: tData(nX,nY,nZ,nW)
|
|
|
|
!===================================================================
|
|
! sdShift4d begins here!
|
|
!===================================================================
|
|
|
|
! Shift the longitude dimension by nX/2 elements
|
|
tData = CSHIFT( tData, nX/2, 1 )
|
|
|
|
END SUBROUTINE sdShift4d
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE sdGetMaxDims( maxDims )
|
|
|
|
!===================================================================
|
|
! Subroutine sdGetMaxDims returns the value of MAX_DIMS to the
|
|
! calling program. This allows us to keep MAX_DIMS private.
|
|
! (bmy, 4/3/02)
|
|
!
|
|
! Arguments as Output:
|
|
! ------------------------------------------------------------------
|
|
! (1 ) maxDims : Maximum # of dimensions for arrays in the HDF file
|
|
!===================================================================
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(OUT) :: maxDims
|
|
|
|
!===================================================================
|
|
! sdGetMaxDims begins here!
|
|
!===================================================================
|
|
maxDims = MAX_DIMS
|
|
|
|
END SUBROUTINE sdGetMaxDims
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
END MODULE HdfSdModule
|