967 lines
32 KiB
Fortran
967 lines
32 KiB
Fortran
! $Id: HdfVdModule.f90,v 1.2 2012/03/01 22:00:27 daven Exp $
|
|
MODULE HdfVdModule
|
|
|
|
!===========================================================================
|
|
! Module "HdfVdModule" contains variables and methods that are used to
|
|
! read data fields stored in HDF-VDATA format. (bmy, 7/3/03, 12/12/05)
|
|
!
|
|
! In order to use HdfVdModule, 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-VD interface at:
|
|
!
|
|
! http://hdf.ncsa.uiuc.edu/training/HDFtraining/tutorial/vd/vds.html
|
|
!
|
|
! Module Variables:
|
|
! --------------------------------------------------------------------------
|
|
! (1 ) fileId : ID number for the HDF file
|
|
! (2 ) saveFileName : Shadow variable for filename
|
|
!
|
|
! Module Methods:
|
|
! --------------------------------------------------------------------------
|
|
! (1 ) vdOpen : Opens the HDF file
|
|
! (2 ) vdClose : Closes the HDF file
|
|
! (3 ) vdOpenField : Opens access to a HDF-VDATA field w/in the file
|
|
! (4 ) vdCloseField : Closes acess to a HDF-VDATA field w/in the file
|
|
! (5 ) vdPrintInfo : Prints information about all HDF-VDATA fields
|
|
! (6 ) vdGetFieldDim : Gets dimensions of a given HDF-VDATA field
|
|
! (7 ) vdGetDataR4 : Reads a 1-D REAL*4 HDF-VDATA field from the file
|
|
! (8 ) vdGetDataR8 : Reads a 1-D REAL*8 HDF-VDATA field from the file
|
|
! (9 ) vdShift : Shifts a 1-D REAL*4 data field by 180 degrees
|
|
! (10) getTauFromDate : Converts a date to a TAU value
|
|
! (11) calDate : Converts Julian day to NYMD, NHMS
|
|
! (12) julDay : Converts Year/month/day to Julian day
|
|
! (13) mint : Function required by routine julDay
|
|
!
|
|
! Module Interfaces:
|
|
! --------------------------------------------------------------------------
|
|
! (1 ) vdGetData : vdGetDataR4, vdGetDataR8
|
|
!
|
|
! NOTES:
|
|
! (1 ) Based on HdfSdModule.f90 (bmy, 7/3/03)
|
|
! (2 ) Added function getTauFromDate (bmy, 12/12/05)
|
|
!===========================================================================
|
|
USE HdfIncludeModule
|
|
|
|
IMPLICIT NONE
|
|
|
|
!=====================================================================
|
|
! MODULE PRIVATE DECLARATIONS
|
|
!=====================================================================
|
|
|
|
! Make everything PRIVATE ...
|
|
PRIVATE
|
|
|
|
! ... except these variables ...
|
|
PUBLIC :: fileId
|
|
PUBLIC :: saveFileName
|
|
|
|
! ... and these routines
|
|
PUBLIC :: vdOpen
|
|
PUBLIC :: vdClose
|
|
PUBLIC :: vdCloseField
|
|
PUBLIC :: vdGetData
|
|
PUBLIC :: vdGetFieldDim
|
|
PUBLIC :: vdOpenField
|
|
PUBLIC :: vdPrintInfo
|
|
PUBLIC :: vdShift
|
|
PUBLIC :: getTauFromDate
|
|
|
|
!=====================================================================
|
|
! Private module variables -- visible only within HdfModule
|
|
!=====================================================================
|
|
INTEGER :: fileId
|
|
CHARACTER(LEN=255) :: saveFileName
|
|
|
|
!=======================================================================
|
|
! Module interfaces: allow you to associate a name w/ several routines
|
|
! with different numbers of arguments or different argument types
|
|
!=======================================================================
|
|
INTERFACE vdGetData
|
|
MODULE PROCEDURE vdGetDataInt
|
|
MODULE PROCEDURE vdGetDataR4
|
|
MODULE PROCEDURE vdGetDataR8
|
|
END INTERFACE
|
|
|
|
INTERFACE vdShift
|
|
MODULE PROCEDURE vdShift1d
|
|
END INTERFACE
|
|
|
|
CONTAINS
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE vdOpen( fileName )
|
|
|
|
!=====================================================================
|
|
! Subroutine "vdOpen" opens an HDF file and initializes the
|
|
! HDF-VDATA interface. (bmy, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1) fileName : CHARACTER name of the HDF-EOS file to be opened
|
|
!
|
|
! HDF-EOS library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1) hOpen : returns INTEGER value ( fileId )
|
|
! (2) vfStart : returns INTEGER value ( vdId )
|
|
!
|
|
! NOTES:
|
|
!=====================================================================
|
|
|
|
! References to F90 modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
CHARACTER(LEN=*) :: fileName
|
|
|
|
! Local Variables
|
|
INTEGER :: status
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: hOpen, vfStart
|
|
|
|
!=====================================================================
|
|
! vdOpen begins here!
|
|
!=====================================================================
|
|
|
|
! Save file name to a private shadow variable for error msgs
|
|
saveFileName = TRIM( fileName )
|
|
|
|
! Open the HDF file
|
|
fileId = hopen( TRIM( fileName ), DFACC_READ, 16 )
|
|
|
|
! Error check fileId
|
|
IF ( fileId == FAIL ) THEN
|
|
message = 'ERROR: Could not open HDF file ' // TRIM( fileName )
|
|
CALL ERROR_STOP( message, 'vdOpen' )
|
|
ENDIF
|
|
|
|
! Start the VDATA interface for this file
|
|
status = vfstart( fileId )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not start HDF-VDATA interface for file ' // &
|
|
TRIM( fileName )
|
|
CALL ERROR_STOP( message, 'vdOpen' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE vdOpen
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE vdClose( fileName )
|
|
|
|
!=====================================================================
|
|
! Subroutine "vdClose" terminates the HDF Scientific Dataset
|
|
! (HDF-VD) interface and closes the HDF file. (bmy, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1) fileName : CHARACTER name of the HDF-EOS file to be opened
|
|
!
|
|
! HDF-EOS library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1) hClose : takes INTEGER value ( fileId )
|
|
! (2) vfEnd : takes INTEGER value ( fileId )
|
|
!
|
|
! NOTES:
|
|
!=====================================================================
|
|
|
|
! 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 :: hClose, vfEnd
|
|
|
|
!=====================================================================
|
|
! vdClose begins here!
|
|
!=====================================================================
|
|
|
|
! Close VDATA interface to the file
|
|
status = vfEnd( fileId )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not close HDF-VDATA interface for ' // &
|
|
TRIM( fileName )
|
|
CALL ERROR_STOP( message, 'vdClose' )
|
|
ENDIF
|
|
|
|
! Close the HDF file
|
|
status = hClose( fileId )
|
|
|
|
! Error check status
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not close the HDF file ' // TRIM( fileName )
|
|
CALL ERROR_STOP( message, 'vdClose' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE vdClose
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE vdOpenField( name, vdId )
|
|
|
|
!=====================================================================
|
|
! Subroutine "vdOpenField" initializes the HDF-VDATA interface
|
|
! for a given VDATA field w/in the HDF file. (bmy, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1) name : CHARACTER name of the VDATA field to be initialized
|
|
!
|
|
! Arguments as Output:
|
|
! --------------------------------------------------------------------
|
|
! (2) vdId : INTEGER VDATA ID# of the field
|
|
!
|
|
! HDF-EOS library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1) vsfAtch : returns INTEGER value ( vdId )
|
|
! (2) vsfDtch : returns INTEGER value ( status )
|
|
! (3) vsfGid : returns INTEGER value ( status )
|
|
! (4) vsfInq : returns INTEGER value ( status )
|
|
!
|
|
! NOTES:
|
|
!=====================================================================
|
|
|
|
! References to F90 modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
CHARACTER(LEN=*), INTENT(IN) :: name
|
|
INTEGER, INTENT(OUT) :: vdId
|
|
|
|
! Local Variables
|
|
LOGICAL :: found
|
|
INTEGER :: intMode, nRec
|
|
INTEGER :: numType, status, vDataRef
|
|
CHARACTER(LEN=255) :: list, message, vdName
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: vsfAtch, vsfDtch, vsfGid, vsfInq
|
|
|
|
!=====================================================================
|
|
! vdOpenField begins here!
|
|
!=====================================================================
|
|
|
|
! Initialize
|
|
found = .FALSE.
|
|
vDataRef = -1
|
|
|
|
! Loop thru file
|
|
DO
|
|
|
|
! Look for HDF-VDATA field
|
|
vDataRef = vsfGid( fileId, vDataRef )
|
|
|
|
! Exit if we are have come to EOF
|
|
if ( vDataRef == FAIL ) EXIT
|
|
|
|
! Attach to this HDF-VDATA field
|
|
vdId = vsfAtch( fileId, vDataRef, 'r' )
|
|
|
|
! Get the name of this HDF-VDATA field
|
|
status = vsfInq( vdId, nRec, intMode, list, numType, vdName )
|
|
|
|
! If the name of the field matches the name that we are
|
|
! looking for, exit and return vdID to the calling routine
|
|
IF ( TRIM( vdName ) == TRIM( name ) ) THEN
|
|
found = .TRUE.
|
|
EXIT
|
|
ENDIF
|
|
|
|
! Otherwise, detach from this HDF-VDATA and loop again
|
|
status = vsfDtch( vdId )
|
|
ENDDO
|
|
|
|
! Error check if no files were found
|
|
IF ( .not. found ) THEN
|
|
message = 'ERROR: Could not HDF-VDATA field ' // TRIM( name ) // &
|
|
' in file ' // TRIM( saveFileName )
|
|
CALL ERROR_STOP( message, 'vdOpenField' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE vdOpenField
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE vdCloseField( vdId )
|
|
|
|
!=====================================================================
|
|
! Subroutine "vdCloseField" terminates the HDF-VDATA interface
|
|
! for a given VDATA field w/in the HDF file. (bmy, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1) name : CHARACTER name of the VDATA field to be closed
|
|
!
|
|
! HDF-EOS library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1) vsfDtch : returns INTEGER value
|
|
!
|
|
! NOTES:
|
|
!=====================================================================
|
|
|
|
! References to F90 modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
INTEGER, INTENT(IN) :: vdId
|
|
|
|
! Local Variables
|
|
INTEGER :: status
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: vsfDtch
|
|
|
|
!=====================================================================
|
|
! vdCloseField begins here!
|
|
!=====================================================================
|
|
|
|
! Terminate VDATA interface
|
|
status = vsfDtch( vdId )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not terminate HDF-VDATA interface!'
|
|
CALL ERROR_STOP( message, 'vdCloseField' )
|
|
ENDIF
|
|
END SUBROUTINE vdCloseField
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE vdPrintInfo
|
|
|
|
!=====================================================================
|
|
! Subroutine "vdPrintInfo: obtains and prints information about
|
|
! each HDF-VDATA field stored in the HDF file. (bmy, 7/3/03)
|
|
!
|
|
! HDF-EOS library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1) vsfAtch : returns INTEGER value ( vdId )
|
|
! (2) vsfDtch : returns INTEGER value ( status )
|
|
! (3) vsfEx : returns INTEGER value ( status )
|
|
! (4) vsfGid : returns INTEGER value ( status )
|
|
! (5) vsfInq : returns INTEGER value ( status )
|
|
!=====================================================================
|
|
|
|
! Local variables
|
|
INTEGER :: vdId, vDataRef, numType
|
|
INTEGER :: nRec, intMode, status
|
|
CHARACTER(LEN=6) :: numStr
|
|
CHARACTER(LEN=255) :: message, name, list
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: vsfAtch, vsfDtch, vsfEx, vsfGid, vsfInq
|
|
|
|
!=====================================================================
|
|
! vdPrintInfo begins here!
|
|
!=====================================================================
|
|
|
|
! Start at beginning of file
|
|
vDataRef = -1
|
|
|
|
! Loop thru file
|
|
DO
|
|
|
|
! Look for VDATA Reference
|
|
vDataRef = vsfGid( fileId, vDataRef )
|
|
if ( VDataRef == FAIL ) EXIT
|
|
|
|
! Attach to this VDATA
|
|
vdId = vsfAtch( fileId, vDataRef, 'r' )
|
|
|
|
! If attach was successful, continue...
|
|
IF ( status == SUCCEED ) THEN
|
|
|
|
! Get information about field #N from the HDF File
|
|
status = vsfInq( vdId, nRec, intMode, list, numType, name )
|
|
|
|
! If status is successful, then print info
|
|
IF ( status == SUCCEED ) THEN
|
|
|
|
! Pick number string
|
|
SELECT CASE ( numType )
|
|
CASE( 4 )
|
|
numStr = 'REAL*4'
|
|
CASE( 8 )
|
|
numStr = 'REAL*8'
|
|
CASE DEFAULT
|
|
numStr = 'N/A '
|
|
END SELECT
|
|
|
|
! Print info
|
|
PRINT*, '--------------------------------------'
|
|
PRINT*, 'HDF-VDATA # : ', vdId
|
|
PRINT*, 'Name : ', TRIM( name )
|
|
PRINT*, '# records : ', nRec
|
|
PRINT*, 'Number Type : ', numStr
|
|
PRINT*, 'Interlace : ', intMode
|
|
|
|
ENDIF
|
|
ENDIF
|
|
|
|
! Detach from this VDATA and try again
|
|
status = vsfDtch( vdId )
|
|
ENDDO
|
|
|
|
END SUBROUTINE vdPrintInfo
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE vdGetFieldDim( vdId, vdDim )
|
|
|
|
!===================================================================
|
|
! Subroutine vdGetFieldDim returns dimension information for
|
|
! a given HDF-VDATA field stored in the HDF file. (bmy, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! ------------------------------------------------------------------
|
|
! (1) vdId (INTEGER) : HDF-VD ID # for the given field
|
|
!
|
|
! Arguments as Output:
|
|
! ------------------------------------------------------------------
|
|
! (2) vdDim (INTEGER) : Dimension (# of elements) of the VDATA
|
|
!
|
|
! HDF-EOS library routines referenced:
|
|
! ------------------------------------------------------------------
|
|
! (1) vsQfNelt : returns INTEGER ( status )
|
|
!===================================================================
|
|
|
|
! References to F90 modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: vdId
|
|
INTEGER, INTENT(OUT) :: vdDim
|
|
|
|
! Local variables
|
|
INTEGER :: status
|
|
CHARACTER(LEN=255) :: message
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: vsQfNelt
|
|
|
|
!===================================================================
|
|
! vdGetFieldSize begins here!
|
|
!===================================================================
|
|
|
|
! Get information about field #N from the HDF File
|
|
status = vsQfNelt( vdId, vdDim )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not get the dimensions of HDF-VDATA field!'
|
|
CALL ERROR_STOP( message, 'vdGetFieldDim' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE vdGetFieldDim
|
|
|
|
!-----------------------------------------------------------------------------
|
|
SUBROUTINE vdGetDataInt( vdId, nX, tData )
|
|
|
|
!=====================================================================
|
|
! Subroutine vdGetDataInt reads a 1-D data array (INTEGER) from the
|
|
! HDF file. The entire array will be returned. (zhe, 14/6/11)
|
|
! Added to standard code (zhej, dkh, 01/17/12, adj32_016)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) vdId (INTEGER) : HDF-VD # 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 ) vsfInq : Returns INTEGER ( status )
|
|
! (2 ) vsfRd : Returns INTEGER ( # of records read )
|
|
!=====================================================================
|
|
|
|
! References to F90 modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: vdId, nX
|
|
INTEGER, INTENT(OUT) :: tdata(nX)
|
|
|
|
! Local variables
|
|
INTEGER :: intMode, nRec, numType, status
|
|
CHARACTER(LEN=255) :: message, name, list
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: vsfInq, vsfRd
|
|
|
|
!===================================================================
|
|
! vdGetDataR8 begins here!
|
|
!===================================================================
|
|
|
|
! Get information about the HDF-VDATA field
|
|
status = vsfInq( vdId, nRec, intMode, list, numType, name )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not find HDF-VDATA field ' // &
|
|
TRIM( name ) // ' in file ' // TRIM( saveFileName )
|
|
CALL ERROR_STOP( message, 'vdGetDataR8' )
|
|
ENDIF
|
|
|
|
! Also make sure the dimensions are compatible
|
|
IF ( nX /= nRec ) THEN
|
|
message = 'ERROR: nX does not match number of records in file!'
|
|
CALL ERROR_STOP( message, 'vdGetDataR8' )
|
|
ENDIF
|
|
|
|
! Read the HDF-VDATA field from the file
|
|
! (status returns the # of records read)
|
|
status = vsfRd( vdId, tData, nRec, intMode )
|
|
|
|
! Error check
|
|
IF ( status <= 0 ) THEN
|
|
message = 'ERROR: Did not read any records for HDF-VDATA field ' // &
|
|
TRIM( name )
|
|
CALL ERROR_STOP( message, 'vdGetDataR8' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE vdGetDataInt
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE vdGetDataR4( vdId, nX, tData )
|
|
|
|
!=====================================================================
|
|
! Subroutine vdGetDataR4 reads a 1-D data array (REAL*4) from the
|
|
! HDF file. The entire array will be returned. (bmy, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) vdId (INTEGER) : HDF-VD # 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 ) vsfInq : Returns INTEGER ( status )
|
|
! (2 ) vsfRd : Returns INTEGER ( # of records read )
|
|
!=====================================================================
|
|
|
|
! References to F90 modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: vdId, nX
|
|
REAL*4, INTENT(OUT) :: tdata(nX)
|
|
|
|
! Local variables
|
|
INTEGER :: intMode, nRec, numType, status
|
|
CHARACTER(LEN=255) :: message, name, list
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: vsfInq, vsfRd
|
|
|
|
!===================================================================
|
|
! vdGetDataR8 begins here!
|
|
!===================================================================
|
|
|
|
! Get information about the HDF-VDATA field
|
|
status = vsfInq( vdId, nRec, intMode, list, numType, name )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not find HDF-VDATA field ' // &
|
|
TRIM( name ) // ' in file ' // TRIM( saveFileName )
|
|
CALL ERROR_STOP( message, 'vdGetDataR8' )
|
|
ENDIF
|
|
|
|
! Also make sure the dimensions are compatible
|
|
IF ( nX /= nRec ) THEN
|
|
message = 'ERROR: nX does not match number of records in file!'
|
|
CALL ERROR_STOP( message, 'vdGetDataR8' )
|
|
ENDIF
|
|
|
|
! Read the HDF-VDATA field from the file
|
|
! (status returns the # of records read)
|
|
status = vsfRd( vdId, tData, nRec, intMode )
|
|
|
|
! Error check
|
|
IF ( status <= 0 ) THEN
|
|
message = 'ERROR: Did not read any records for HDF-VDATA field ' // &
|
|
TRIM( name )
|
|
CALL ERROR_STOP( message, 'vdGetDataR8' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE vdGetDataR4
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE vdGetDataR8( vdId, nX, tData )
|
|
|
|
!=====================================================================
|
|
! Subroutine vdGetData reads a 1-D data array (REAL*8) from the
|
|
! HDF file. The entire array will be returned. (bmy, 7/3/03)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) vdId (INTEGER) : HDF-VD # of the data field in the HDF file
|
|
! (2 ) nX (INTEGER) : Number of elements in the X-dimension
|
|
!
|
|
! Arguments as Output:
|
|
! --------------------------------------------------------------------
|
|
! (3 ) tData (REAL*8 ) : Data array
|
|
!
|
|
! HDF library routines referenced:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) vsfInq : Returns INTEGER ( status )
|
|
! (2 ) vsfRd : Returns INTEGER ( # of records read )
|
|
!=====================================================================
|
|
|
|
! References to F90 modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: vdId, nX
|
|
REAL*8, INTENT(OUT) :: tdata(nX)
|
|
|
|
! Local variables
|
|
INTEGER :: intMode, nRec, numType, status
|
|
CHARACTER(LEN=255) :: message, name, list
|
|
|
|
! External functions
|
|
INTEGER, EXTERNAL :: vsfInq, vsfRd
|
|
|
|
!===================================================================
|
|
! vdGetDataR8 begins here!
|
|
!===================================================================
|
|
|
|
! Get information about this field
|
|
status = vsfInq( vdId, nRec, intMode, list, numType, name )
|
|
|
|
! Error check
|
|
IF ( status == FAIL ) THEN
|
|
message = 'ERROR: Could not find HDF-VDATA field ' // &
|
|
TRIM( name ) // ' in file ' // TRIM( saveFileName )
|
|
CALL ERROR_STOP( message, 'vdGetDataR8' )
|
|
ENDIF
|
|
|
|
! Also make sure the dimensions are compatible
|
|
IF ( nX /= nRec ) THEN
|
|
message = 'ERROR: nX does not match number of records in file!'
|
|
CALL ERROR_STOP( message, 'vdGetDataR4' )
|
|
ENDIF
|
|
|
|
! Read the HDF-VDATA field from the file
|
|
! (status returns the # of records read)
|
|
status = vsfRd( vdId, tData, nRec, intMode )
|
|
|
|
! Error check
|
|
IF ( status <= 0 ) THEN
|
|
message = 'ERROR: Did not read any records for HDF-VDATA field ' // &
|
|
TRIM( name )
|
|
CALL ERROR_STOP( message, 'vdGetDataR8' )
|
|
ENDIF
|
|
|
|
END SUBROUTINE vdGetDataR8
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE vdShift1d( nX, tData )
|
|
|
|
!=====================================================================
|
|
! Subroutine vdShift1d 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)
|
|
|
|
!===================================================================
|
|
! vdShift1d begins here!
|
|
!===================================================================
|
|
|
|
! Shift the longitude dimension by nX/2 elements
|
|
tData = CSHIFT( tdata, nX/2, 1 )
|
|
|
|
END SUBROUTINE vdShift1d
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
FUNCTION getTauFromDate( year, month, day ) RESULT( tau )
|
|
|
|
!=====================================================================
|
|
! Function getTauFromDate returns the TAU value (hours since 0 GMT
|
|
! on Jan 1, 1985) at the beginning of the given date. (bmy, 12/12/05)
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1 ) year (INTEGER) : Current YYYY year value
|
|
! (2 ) year (INTEGER) : Current MM month value
|
|
! (3 ) year (INTEGER) : Current DD day value
|
|
!
|
|
! NOTES:
|
|
!=====================================================================
|
|
|
|
! Arguments
|
|
INTEGER :: year, month, day
|
|
|
|
! Local variables
|
|
REAL*8 :: tau, jdToday
|
|
|
|
! Astronomical Julian Date at 0 GMT, 1 Jan 1985
|
|
REAL*8, PARAMETER :: JD85 = 2446066.5d0
|
|
|
|
!=====================================================================
|
|
! getTauFromDate begins here!
|
|
!=====================================================================
|
|
|
|
! Get today's astronomical Julian date
|
|
jdToday = julDay( year, month, DBLE( day ) )
|
|
|
|
! Get Tau0 value
|
|
tau = ( jdToday - jd85 ) * 24d0
|
|
|
|
END FUNCTION getTauFromDate
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE calDate( julDay, nymd, nhms )
|
|
|
|
!=====================================================================
|
|
! Subroutine "calDate" converts an astronomical Julian day to
|
|
! the NYMD (e.g. YYYYMMDD) and NHMS (i.e. HHMMSS) format.
|
|
!
|
|
! Algorithm taken from "Practical Astronomy With Your Calculator",
|
|
! Third Edition, by Peter Duffett-Smith, Cambridge UP, 1992.
|
|
!
|
|
! Arguments as Input:
|
|
! --------------------------------------------------------------------
|
|
! (1) julDay : REAL*8 : Astronomical julian day
|
|
!
|
|
! Arguments as output:
|
|
! --------------------------------------------------------------------
|
|
! (1) nymd : INTEGER : YYYYMMDD corresponding to JDAY
|
|
! (2) nhms : INTEGER : HHMMSS corresponding to JDAY
|
|
!=====================================================================
|
|
|
|
! Arguments
|
|
REAL*8, INTENT(IN) :: julDay
|
|
INTEGER, INTENT(OUT) :: nymd, nhms
|
|
|
|
! Local variables
|
|
REAL*8 :: a, b, c, d, day, e, f
|
|
REAL*8 :: fDay, g, i, j, jd, m, y
|
|
|
|
!=====================================================================
|
|
! "calDate begins here!
|
|
! See "Practical astronomy with your calculator", Peter Duffett-Smith
|
|
! 1992, for an explanation of the following algorithm.
|
|
!=====================================================================
|
|
jd = julDay + 0.5d0
|
|
i = INT( jd )
|
|
f = jd - INT( I )
|
|
|
|
IF ( i > 2299160d0 ) THEN
|
|
a = INT( ( I - 1867216.25d0 ) / 36524.25 )
|
|
b = i + 1 + a - INT( a / 4 )
|
|
ELSE
|
|
b = i
|
|
ENDIF
|
|
|
|
c = b + 1524d0
|
|
|
|
d = INT( ( c - 122.1d0 ) / 365.25d0 )
|
|
|
|
e = INT( 365.25d0 * d )
|
|
|
|
g = INT( ( c - e ) / 30.6001d0 )
|
|
|
|
! Day is the day number
|
|
day = c - e + f - INT( 30.6001d0 * g )
|
|
|
|
! fDay is the fractional day number
|
|
fDay = day - int( day )
|
|
|
|
! M is the month number
|
|
IF ( g < 13.5d0 ) THEN
|
|
m = g - 1d0
|
|
ELSE
|
|
m = g - 13d0
|
|
ENDIF
|
|
|
|
! Y is the year number
|
|
IF ( m > 2.5d0 ) THEN
|
|
y = d - 4716d0
|
|
ELSE
|
|
y = d - 4715d0
|
|
ENDIF
|
|
|
|
! NYMD is YYYYMMDD
|
|
nymd = ( INT( y ) * 10000 ) + ( INT( m ) * 100 ) + INT( day )
|
|
|
|
! NHMS is HHMMSS
|
|
nhms = INT( fday * 24 ) * 10000
|
|
|
|
END SUBROUTINE calDate
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
FUNCTION julDay( year, month, day ) RESULT( julianDay )
|
|
|
|
!===================================================================
|
|
! Function JULDAY returns the astronomical Julian day.
|
|
!
|
|
! Algorithm taken from "Practical Astronomy With Your Calculator",
|
|
! Third Edition, by Peter Duffett-Smith, Cambridge UP, 1992.
|
|
!
|
|
! Arguments as Input:
|
|
! ------------------------------------------------------------------
|
|
! (1) YEAR : (INTEGER) Current year
|
|
! (2) MONTH : (INTEGER) Current month
|
|
! (3) DAY : (REAL*8 ) Current day (can be fractional, e.g. 17.25)
|
|
!
|
|
! NOTES:
|
|
! (2) JULDAY requires the external function MINT.F.
|
|
!
|
|
! (3) JULDAY will compute the correct Julian day for any
|
|
! BC or AD date.
|
|
!
|
|
! (4) For BC dates, subtract 1 from the year and append a minus
|
|
! sign. For example, 1 BC is 0, 2 BC is -1, etc. This is
|
|
! necessary for the algorithm.
|
|
!===================================================================
|
|
|
|
! Arguments
|
|
INTEGER :: year, month
|
|
REAL*8 :: day, julianDay
|
|
|
|
! Local variables
|
|
INTEGER :: year1, month1
|
|
REAL*8 :: x1, a, b, c, d
|
|
LOGICAL :: isGregorian
|
|
|
|
!===================================================================
|
|
! JULDAY begins here!
|
|
!
|
|
! Follow algorithm from Peter Duffett-Smith (1992)
|
|
!===================================================================
|
|
|
|
! Compute YEAR and MONTH1
|
|
IF ( ( month == 1 ) .OR. ( month == 2 ) ) THEN
|
|
year1 = year - 1
|
|
month1 = month + 12
|
|
ELSE
|
|
year1 = year
|
|
month1 = month
|
|
ENDIF
|
|
|
|
! Compute the "A" term.
|
|
x1 = DBLE( year ) / 100.0d0
|
|
a = mint( x1 )
|
|
|
|
! The Gregorian calendar begins on 10 October 1582
|
|
! Any dates prior to this will be in the Julian calendar
|
|
IF ( year > 1582 ) THEN
|
|
isGregorian = .TRUE.
|
|
ELSE
|
|
IF ( ( year == 1582 ) .AND. &
|
|
( month1 >= 10 ) .AND. &
|
|
( day >= 15.0 ) ) THEN
|
|
isGregorian = .TRUE.
|
|
ELSE
|
|
isGregorian = .FALSE.
|
|
ENDIF
|
|
ENDIF
|
|
|
|
! Compute the "B" term according to Gregorian or Julian calendar
|
|
IF ( isGregorian ) THEN
|
|
b = 2.0d0 - a + mint( a / 4.0d0 )
|
|
ELSE
|
|
b = 0.0d0
|
|
ENDIF
|
|
|
|
! Compute the "C" term for BC dates (YEAR1 <= 0 )
|
|
! or AD dates (YEAR1 > 0)
|
|
IF ( year1 < 0 ) THEN
|
|
x1 = ( 365.25d0 * year1 ) - 0.75d0
|
|
c = mint( x1 )
|
|
ELSE
|
|
x1 = 365.25d0 * year1
|
|
c = mint( x1 )
|
|
ENDIF
|
|
|
|
! Compute the "D" term
|
|
x1 = 30.6001d0 * DBLE( month1 + 1 )
|
|
d = mint( x1 )
|
|
|
|
|
|
! Add the terms to get the Julian Day number
|
|
julianDay = b + c + d + day + 1720994.5d0
|
|
|
|
END FUNCTION julDay
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
FUNCTION mint( x ) RESULT ( value )
|
|
|
|
!===================================================================
|
|
! Function MINT is defined as follows:
|
|
!
|
|
! MINT = -INT( ABS( X ) ), X < 0
|
|
! MINT = INT( ABS( X ) ), X >= 0
|
|
!
|
|
! Arguments as Input:
|
|
! ------------------------------------------------------------------
|
|
! (1) X : (REAL*8) Argument for the function MINT
|
|
!
|
|
! NOTES:
|
|
! (1) MINT is primarily intended for use with routine JULDAY.
|
|
!===================================================================
|
|
|
|
! Arguments
|
|
REAL*8, INTENT(IN) :: x
|
|
|
|
! Return value
|
|
REAL*8 :: value
|
|
|
|
!===================================================================
|
|
! MINT begins here!
|
|
!===================================================================
|
|
IF ( x < 0d0 ) THEN
|
|
value = -INT( ABS( x ) )
|
|
ELSE
|
|
value = INT( ABS( x ) )
|
|
ENDIF
|
|
|
|
END FUNCTION MINT
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
END MODULE HdfVdModule
|