Add files via upload
This commit is contained in:
Xuesong (Steve)
966
code/obs_operators/HdfVdModule.f90
Normal file
966
code/obs_operators/HdfVdModule.f90
Normal file
@ -0,0 +1,966 @@
|
||||
! $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
|
||||
Reference in New Issue
Block a user