! $Id: He4GridModule.f90,v 1.1 2009/06/18 19:53:07 daven Exp $ MODULE He4GridModule !======================================================================== ! Module "He4GridModule" contains variable declarations and routines ! that are used for reading data from HDF-EOS4 "Grid" structures. ! (bmy, 1/17/06, 4/10/08) ! ! Module Variables: ! -------------------------------------------------------------------------- ! fId (INTEGER ) : ID number for the HDF_EOS file ! gId (INTEGER ) : ID number for the HDF_EOS grid ! start3D (INTEGER ) : Starting index for 3-D arrays ! stride3D (INTEGER ) : Stride for 3-D arrays ! edge3D (INTEGER ) : Ending index for 3-D arrays ! start4D (INTEGER ) : Starting index for 4-D arrays ! stride4D (INTEGER ) : Stride for 4-D arrays ! edge4D (INTEGER ) : Ending index for 4-D arrays ! xStart (INTEGER ) : Starting index for the XDIM array ! xStride (INTEGER ) : Stride for the XDIM array ! xEdge (INTEGER ) : Ending index for the XDIM array ! yStart (INTEGER ) : Starting index for the YDIM array ! yStride (INTEGER ) : Stride for the YDIM array ! yEdge (INTEGER ) : Ending index for the YDIM array ! zStart (INTEGER ) : Starting index for the ZDIM array ! zStride (INTEGER ) : Stride for the ZDIM array ! zEdge (INTEGER ) : Ending index for the ZDIM array ! tStart (INTEGER ) : Starting index for the TIME, TAU arrays ! tStride (INTEGER ) : Stride for the TIME, TAU arrays ! tEdge (INTEGER ) : Ending index for the TIME, TAU arrays ! nFields (INTEGER ) : Number of fields in the current file ! fieldRank (INTEGER ) : Array of Argument for "gdinqfld" routine ! fieldType (INTEGER ) : Array of data types for each field in the file ! fieldName (CHARACTER) : Array of names for each field in the file ! nAttrs (INTEGER ) : Number of attributes defined in the file ! attrName (CHARACTER) : Array of attribute names ! attrValue (REAL*4 ) : Array of attribute values ! time (REAL*8 ) : Array of times (# of seconds since 1/1/1993) ! saveFileName (CHARACTER) : Shadow variable for the file name ! timefrom1993 (LOGICAL ) : = T if TIME starts from 1/1/1993 ! VERBOSE (LOGICAL ) : = T if we are printing info to the std output ! xDimSize (INTEGER ) : # of grid boxes in the X (longitude) dimension ! yDimSize (INTEGER ) : # of grid boxes in the Y (latitude ) dimension ! zDimSize (INTEGER ) : # of grid boxes in the Z (altitude ) dimension ! tDimSize (INTEGER ) : # of time intervals contained within this file ! xDim (REAL*8 ) : Array of longitude centers ! yDim (REAL*8 ) : Array of latitude centers ! zdim (REAL*8 ) : Array of alitude centers ! nymd (INTEGER ) : Array of YYYYMMDD values -- date indices ! nhms (INTEGER ) : Array of HHMMSS values -- hour indices ! ! Module Methods: ! -------------------------------------------------------------------------- ! (1 ) He4SetVerbose : toggles information display on/off ! (2 ) He4GridOpen : opens file & attaches to HDF-EOS4 grid ! (3 ) He4GridClose : detaches from HDF-EOS4 grid & closes file ! (4 ) He4GridGetDimInfo : gets dimensions of data fields in file ! (5 ) He4GridGetFldInfo : gets info about each field ! (6 ) He4GridGetAttrInfo : gets global attributes for HDF-EOS4 grid ! (7 ) He4GridReadAttrChar : Reads CHARACTER attribute from grid ! (8 ) He4GridReadAttrI2 : Reads INTEGER*2 attribute from grid ! (9 ) He4GridReadAttrI4 : Reads INTEGER*4 attribute from grid ! (10) He4GridReadAttrR4 : Reads REAL*4 attribute from grid ! (11) He4GridReadAttrR8 : Reads REAL*8 attribute from grid ! (12) He4GridGetFillValue : gets missing data "fill" value for fields ! (13) He4GridReadData3D : reads a 3-D data block from the file ! (14) He4GridReadData4D : reads a 4-D data block from the file ! (15) He4GridReadX : gets the longitudes (X) for the grid ! (16) He4GridReadY : gets the latitudes (Y) for the grid ! (17) He4GridReadZ : gets the altitudes (Z) for the grid ! (18) He4GridReadT : gets the time values (T) for the grid ! (19) He4GetNymdNhms : converts T to NYMD, NHMS ! (20) He4CleanUpIndexFields : deallocates index arrays ! (21) makeCharArrayFromCharList : separates a string into a string array ! (22) calDate : converts Julian day to NYMD, NHMS ! (24) julDay : converts Year/month/day to Julian day ! (25) mint : function required by routine julDay ! ! Module Interfaces: ! -------------------------------------------------------------------------- ! (1 ) He4ReadGridAttr -- overloads these routines ! (a) He4GridReadAttrChar ! (b) He4GridReadAttrI2 ! (c) He4GridReadAttrI4 ! (d) He4GridReadAttrR4 ! (e) He4GridReadAttrR8 ! ! (2 ) He4GridReadData overloads the following routines ! (a) He4GridReadData3D ! (b) He4GridReadData4D ! ! NOTES: ! (1 ) Updated for more consistency ! (2 ) Now declare "makeCharArrayFromCharList" public. (bmy, 11/8/06) ! (3 ) Updated comments. TYPEARRAY is now a global variable. (bmy, 8/14/07) ! (4 ) Added interface to read attribute data (bmy, 4/10/08) !=========================================================================== ! References to F90 modules USE He4ErrorModule USE He4IncludeModule ! Force explicit data types IMPLICIT NONE !--------------------------------------------------------------------- ! PUBLIC / PRIVATE declarations !--------------------------------------------------------------------- ! Make everything PRIVATE ... PRIVATE ! ... and these routines PUBLIC :: xDimSize PUBLIC :: yDimSize PUBLIC :: zDimSize PUBLIC :: tDimSize PUBLIC :: nymd PUBLIC :: nhms PUBLIC :: xDim PUBLIC :: yDim PUBLIC :: zDim ! ... and these routines PUBLIC :: He4SetVerbose PUBLIC :: He4GridOpen PUBLIC :: He4GridClose PUBLIC :: He4GridGetDimInfo PUBLIC :: He4GridGetFldInfo PUBLIC :: He4GridGetAttrInfo PUBLIC :: He4GridReadAttr PUBLIC :: He4GridGetFillValue PUBLIC :: He4GridReadData PUBLIC :: He4GridReadX PUBLIC :: He4GridReadY PUBLIC :: He4GridReadZ PUBLIC :: He4GridReadT PUBLIC :: He4GetNymdNhms PUBLIC :: He4CleanUpIndexFields PUBLIC :: makeCharArrayFromCharList !------------------------------------------------------------------------ ! MODULE VARIABLES !------------------------------------------------------------------------ ! Switch for printing output to the screen LOGICAL :: VERBOSE ! ID's INTEGER :: fId, gId ! Data extent INTEGER :: start3D(3), stride3D(3), edge3D(3) INTEGER :: start4D(4), stride4D(4), edge4D(4) INTEGER :: xStart(1), xStride(1), xEdge(1) INTEGER :: yStart(1), yStride(1), yEdge(1) INTEGER :: zStart(1), zStride(1), zEdge(1) INTEGER :: tStart(1), tStride(1), tEdge(1) ! Fields INTEGER :: nFields INTEGER :: fieldRank(HE4_MAX_FLDS) INTEGER :: fieldType(HE4_MAX_FLDS) CHARACTER(LEN=HE4_MAX_CHAR) :: fieldName(HE4_MAX_FLDS) ! Attributes INTEGER :: nAttrs REAL*4 :: attrValue(HE4_MAX_ATRS) CHARACTER(LEN=HE4_MAX_CHAR) :: attrName(HE4_MAX_ATRS) ! Variables for timing LOGICAL :: timeFrom1993 = .TRUE. REAL*8, ALLOCATABLE :: time(:) ! Shadow variable for file name CHARACTER(LEN=HE4_MAX_CHAR) :: saveFileName ! Index arrays for grid INTEGER :: xDimSize, yDimSize, zDimSize, tDimSize INTEGER, ALLOCATABLE :: nymd(:), nhms(:) REAL*8, ALLOCATABLE :: xDim(:), yDim(:), zDim(:) ! Array for number types CHARACTER(LEN=10) :: typeArray(10) = & (/ ' ', ' ', ' ', ' ', 'REAL*4 ', & 'REAL*8 ', ' ', ' ', ' ', ' ' /) !------------------------------------------------------------------------ ! MODULE INTERFACES !------------------------------------------------------------------------ INTERFACE He4GridReadData MODULE PROCEDURE He4GridReadData3D MODULE PROCEDURE He4GridReadData4D END INTERFACE INTERFACE He4GridReadAttr MODULE PROCEDURE He4GridReadAttrChar MODULE PROCEDURE He4GridReadAttrI2 MODULE PROCEDURE He4GridReadAttrI4 MODULE PROCEDURE He4GridReadAttrR4 MODULE PROCEDURE He4GridReadAttrR8 END INTERFACE !------------------------------------------------------------------------ ! MODULE ROUTINES !------------------------------------------------------------------------ CONTAINS !------------------------------------------------------------------------------ SUBROUTINE He4SetVerbose( v ) !====================================================================== ! Subroutine setVerbose sets the value of module variable "verbose" ! which determines if information is echoed to the standard output ! ! Arguments as Input: ! --------------------------------------------------------------------- ! (1 ) v (LOGICAL) : TRUE or FALSE value ! ! NOTES: !====================================================================== ! Arguments LOGICAL, INTENT(IN) :: v ! Set the value of verbose VERBOSE = v END SUBROUTINE He4SetVerbose !------------------------------------------------------------------------------ SUBROUTINE He4GridOpen( fileName ) !====================================================================== ! Subroutine "gridOpen" opens the HDF_EOS file and attaches to the ! grid structure contained in the file. (bmy, 1/17/06) ! ! Arguments as Input: ! --------------------------------------------------------------------- ! (1) fileName (CHARACTER) : Name of the HDF-EOS file to be opened ! ! NOTES: ! (1) The DAO uses the generic name "EOSGRID" for the grid ! structure in all products. !====================================================================== ! Arguments CHARACTER(LEN=*) :: fileName ! Local Variables CHARACTER(LEN=HE4_MAX_CHAR) :: msg, loc ! HDF-EOS4 library routines INTEGER :: gdAttach, gdOpen !-------------------------- ! He4GridOpen begins here! !-------------------------- ! Save file name to a private shadow variable saveFileName = TRIM( fileName ) ! Call HDF library routine "gdopen" to open the HDF file fId = gdOpen( TRIM( fileName ), DFACC_RDONLY ) ! Error check fId IF ( fId == FAIL ) THEN msg = 'ERROR: Could not open file ' // TRIM( fileName ) loc = 'He4GridOpen ("He4GridModule.f90")' CALL He4ErrMsg( msg, loc ) ENDIF ! Call HDF library routine "gdAttach" to attach to the ! grid structure contained in the HDF-EOS file. gId = gdAttach( fId, 'EOSGRID' ) ! Error check gId IF ( gId == FAIL ) THEN msg = 'ERROR: Could not attach to grid structure!' loc = 'He4GridOpen ("He4GridModule.f90")' CALL He4ErrMsg( msg, loc ) ENDIF END SUBROUTINE He4GridOpen !------------------------------------------------------------------------------ SUBROUTINE He4GridClose( fileName ) !===================================================================== ! Subroutine He4GridClose detaches from the currently opened grid ! and closes the HDF-EOS file that contains the grid. (bmy, 1/17/06) ! ! Arguments as Input: ! -------------------------------------------------------------------- ! (1) fileName (CHARACTER) : Name of the HDF-EOS4 file to be closed ! ! NOTES: !===================================================================== ! Arguments CHARACTER(LEN=*), INTENT(IN) :: fileName ! Local variables INTEGER :: status CHARACTER(LEN=HE4_MAX_CHAR) :: msg, loc ! HDF-EOS4 library routines INTEGER :: gdDetach, gdClose !--------------------------- ! He4GridClose begins here! !--------------------------- ! Call HDF library routine "gdDetach" to detach from the ! grid structure in the HDF-EOS file. status = gdDetach( gId ) ! Error check status IF ( status == FAIL ) THEN msg = 'ERROR detaching from grid structure!' loc = 'He4GridClose ("He4GridModule.f90")' CALL He4ErrMsg( msg, loc ) ENDIF ! Call HDF library routine "gdClose" to close the HDF-EOS file. status = gdClose( fId ) ! Error check status IF ( status == FAIL ) THEN msg = 'ERROR closing the file: ' // TRIM( fileName ) loc = 'He4GridClose ("He4GridModule.f90")' CALL He4ErrMsg( msg, loc ) ENDIF END SUBROUTINE He4GridClose !----------------------------------------------------------------------------- SUBROUTINE He4GridGetDimInfo !===================================================================== ! Subroutine He4GridGetDimInfo obtains information about each ! dimension of the grid contained in the HDF-EOS4 file. (bmy, 1/17/06) ! ! He4GridGetDimInfo also creates the various START, STRIDE, and EDGE ! arrays needed to read data from the grid structure. ! ! NOTES: !===================================================================== ! Local variables INTEGER :: dims(4), status INTEGER :: xNumType, yNumType, zNumType, tNumType CHARACTER(LEN=HE4_MAX_CHAR) :: dimList ! HDF-EOS4 library routines INTEGER :: gdFldInfo !--------------------------------------------------------------------- ! He4GridGetDimInfo begins here ! ! Call HDF library routine "gdFldInfo" to get the grid dimensions. ! ! xDimSize < 0 denotes missing X-dimension ! yDimSize < 0 denotes missing Y-dimension ! zDimSize < 0 denotes missing Z-dimension ! tDimSize < 0 denotes missing Time-dimension !--------------------------------------------------------------------- status = gdFldInfo( gId, 'XDim', dims, xDimSize, xNumType, dimList ) status = gdFldInfo( gId, 'YDim', dims, yDimSize, yNumType, dimList ) status = gdFldInfo( gId, 'Height', dims, zDimSize, zNumType, dimList ) status = gdFldInfo( gId, 'Time', dims, tDimSize, tNumType, dimList ) ! Create START, STRIDE, EDGE arrays for 3-D data fields (X,Y,Time) IF ( xDimSize > 0 .and. yDimSize > 0 .and. tDimSize > 0 ) THEN start3D = 0 stride3D = 1 edge3D = (/ xDimSize, yDimSize, tDimSize /) ENDIF ! Create START, STRIDE, EDGE arrays for 4-D data fields (X,Y,Z,Time) IF ( xDimSize > 0 .and. yDimSize > 0 .and. & zDimSize > 0 .and. tDimSize > 0 ) THEN start4D = 0 stride4D = 1 edge4D = (/ xDimSize, yDimSize, zDimSize, tDimSize /) endif ! Create START, STRIDE, EDGE arrays for index field xDim IF ( xDimSize > 0 ) THEN xStart = 0 xStride = 1 xEdge = xDimSize ENDIF ! Create START, STRIDE, EDGE arrays for index field yDim IF ( yDimSize > 0 ) THEN yStart = 0 yStride = 1 yEdge = yDimSize ENDIF ! Create START, STRIDE, EDGE arrays for index field zDim IF ( zDimSize > 0 ) THEN zStart = 0 zStride = 1 zEdge = zDimSize ENDIF ! Create START, STRIDE, EDGE arrays for index field Time IF ( tDimSize > 0 ) THEN tStart = 0 tStride = 1 tEdge = tDimSize ENDIF ! Echo dimension information to the screen IF ( VERBOSE ) THEN WRITE( 6, '(a)' ) WRITE( 6, '(a)' ) ' Index Quantity (Units) Number of Number' WRITE( 6, '(a)' ) ' Field Elements Type' WRITE( 6, '(a)' ) REPEAT( '=', 79 ) IF ( xDimSize > 0 ) THEN WRITE( 6, '(6x, ''XDim Longitude (degrees) '', i8,7x,a10 )' ) & xDimSize, typeArray(xNumType) ENDIF IF ( yDimSize > 0 ) THEN WRITE( 6, '(6x, ''YDim Latitude (degrees) '', i8,7x,a10 )' ) & yDimSize, typeArray(yNumType) ENDIF IF ( zDimSize > 0 ) THEN WRITE( 6, '(6x, ''Height Altitude (mb ) '', i8,7x,a10 )' ) & zDimSize, typeArray(zNumType) ENDIF IF ( tDimSize > 0 ) THEN WRITE( 6, '(6x, ''Time Time Index (seconds) '', i8,7x,a10 )' ) & tDimSize, typeArray(tNumType) ENDIF ENDIF END SUBROUTINE He4GridGetDimInfo !----------------------------------------------------------------------------- SUBROUTINE He4GridGetFldInfo !====================================================================== ! Subroutine He4GridGetFldInfo obtains information about each of ! the fields stored in the HDF-EOS4 file. Some information ! is echoed to the standard output. ! ! NOTES: !====================================================================== ! Local variables INTEGER :: i, dims(4), rank, numType, status REAL*4 :: fillValue CHARACTER(LEN=HE4_MAX_CHAR) :: fieldList, dimList, msg, loc ! HDF-EOS4 library routines INTEGER :: gdInqFlds, gdFldInfo !-------------------------------- ! He4GridGetFldInfo begins here! !-------------------------------- ! Call HDF library routine gdInqFlds to get information about ! each of the fields contained in the HDF-EOS file. nFields = gdInqFlds( gId, fieldList, fieldRank, fieldType ) ! Call "makeCharArrayFromCharList" to create a character array ! using the comma-separated list of field names, FIELDLIST. CALL makeCharArrayFromCharList( fieldList, ',', fieldName ) ! Write some header lines to the standard output IF ( VERBOSE ) THEN WRITE( 6, '(a)' ) WRITE( 6, '(a)' )' Field Number Fill Dimensions' WRITE( 6, '(a)' )' Name Type Value of Field ' WRITE( 6, '(a)' ) REPEAT( '=', 79 ) ENDIF ! Loop over each field DO i = 1, nFields ! Call HDF-EOS library routine "gdFldInfo" to read ! information about each field's dimensions and type status = gdFldInfo( gId, TRIM( fieldName(i) ), & dims, rank, numType, dimList ) ! Get the "missing data" fill value for each field CALL He4GridGetFillValue( fieldName(i), fillValue ) ! Echo information to the standard output IF ( VERBOSE ) THEN WRITE( 6, '( i4,'') '', a10, 1x, a10, 1x, es9.2, 6x, a )' ) & i, fieldName(i), typeArray( fieldType(i) ), & fillValue, TRIM( dimList ) ENDIF ENDDO END SUBROUTINE He4GridGetFldInfo !----------------------------------------------------------------------------- SUBROUTINE He4GridGetAttrInfo !====================================================================== ! Subroutine He4GridGetAttrInfo obtains information about each of ! the global attributes for the HDF-EOS4 grid. Some information ! is echoed to the standard output. (bmy, 1/17/06) ! ! NOTES !====================================================================== ! Local variables INTEGER :: i, status, strBufSize REAL :: attrValue CHARACTER(LEN=HE4_MAX_CHAR) :: attrList, message ! HDF-EOS4 library routines INTEGER :: gdInqAttrs, gdRdAttr !--------------------------------- ! He4GridGetAttrInfo begins here! !--------------------------------- ! Call HDF library routine gdInqAttrs to get information about ! each of the global attributes for the HDF-EOS grid nAttrs = gdInqAttrs( gId, attrList, strBufSize ) ! Call "makeCharArrayFromCharList" to create a character array ! using the comma-separated list of attribute names, ATTRLIST. CALL makeCharArrayFromCharList( attrList, ',', attrName ) ! Write some header lines to the standard output IF ( VERBOSE ) then WRITE( 6, '(a)' ) WRITE( 6, '(a)' ) ' Attribute Attribute' WRITE( 6, '(a)' ) ' Name Value' WRITE( 6, '(a)' ) REPEAT( '=', 79 ) ENDIF ! Loop over all field names DO i = 1, nAttrs ! Read the value of each attribute status = gdRdAttr( gId, TRIM( attrName(i) ), attrValue ) ! Echo information to the standard output IF ( verbose ) then WRITE( 6, '( i4,'') '', a20, 1x, es13.6 )' ) & i, attrName(i), attrValue ENDIF ENDDO END SUBROUTINE He4GridGetAttrInfo !------------------------------------------------------------------------------ SUBROUTINE He4GridReadAttrChar( gId, attrName, attrValue ) !====================================================================== ! Subroutine He4GridAttrChar returns a global attributes of type ! CHARACTER associated with the grid data structure. (bmy, 4/10/08) ! ! Arguments as Input: ! --------------------------------------------------------------------- ! (1) gId (INTEGER ) : HDF-EOS4 Grid ID number ! (2) attrName (CHARACTER) : Name of attribute to read from file ! ! Arguments as Output: ! --------------------------------------------------------------------- ! (3) attrValue (CHARACTER) : Value of attribute ! ! NOTES: !====================================================================== ! Arguments INTEGER, INTENT(IN) :: gId CHARACTER(LEN=*), INTENT(IN) :: attrName CHARACTER(LEN=*), INTENT(OUT) :: attrValue ! Local variables INTEGER :: status ! HDF4-EOS library routines INTEGER :: GdRdAttr !----------------------------------- ! He4GridReadAttrChar begins here! !----------------------------------- ! Read attribute status = GdRdAttr( gId, TRIM( attrName ), attrValue ) END SUBROUTINE He4GridReadAttrChar !------------------------------------------------------------------------------ SUBROUTINE He4GridReadAttrI2( gId, attrName, attrValue ) !====================================================================== ! Subroutine He4GridAttrI2 returns a global attributes of type ! INTEGER*2 associated with the grid data structure. (bmy, 4/10/08) ! ! Arguments as Input: ! --------------------------------------------------------------------- ! (1) gId (INTEGER ) : HDF-EOS4 grid ID number ! (2) attrName (CHARACTER) : Name of attribute to read from file ! ! Arguments as Output: ! --------------------------------------------------------------------- ! (3) attrValue (INTEGER*2) : Value of attribute ! ! NOTES: !====================================================================== ! Arguments INTEGER, INTENT(IN) :: gId CHARACTER(LEN=*), INTENT(IN) :: attrName INTEGER*2, INTENT(OUT) :: attrValue ! Local variables INTEGER :: status ! HDF4-EOS library routines INTEGER :: GdRdAttr !----------------------------------- ! He4GridReadAttrI2 begins here! !----------------------------------- ! Read attribute status = GdRdAttr( gId, TRIM( attrName ), attrValue ) END SUBROUTINE He4GridReadAttrI2 !------------------------------------------------------------------------------ SUBROUTINE He4GridReadAttrI4( gId, attrName, attrValue ) !====================================================================== ! Subroutine He4GridAttrI4 returns a global attributes of type ! INTEGER*4 associated with the grid data structure. (bmy, 4/10/08) ! ! Arguments as Input: ! --------------------------------------------------------------------- ! (1) gId (INTEGER ) : HDF-EOS4 grid ID number ! (2) attrName (CHARACTER) : Name of attribute to read from file ! ! Arguments as Output: ! --------------------------------------------------------------------- ! (3) attrValue (INTEGER*2) : Value of attribute ! ! NOTES: !====================================================================== ! Arguments INTEGER, INTENT(IN) :: gId CHARACTER(LEN=*), INTENT(IN) :: attrName INTEGER, INTENT(OUT) :: attrValue ! Local variables INTEGER :: status ! HDF4-EOS library routines INTEGER :: GdRdAttr !----------------------------------- ! He4GridReadAttrI4 begins here! !----------------------------------- ! Read attribute status = GdRdAttr( gId, TRIM( attrName ), attrValue ) END SUBROUTINE He4GridReadAttrI4 !------------------------------------------------------------------------------ SUBROUTINE He4GridReadAttrR4( gId, attrName, attrValue ) !====================================================================== ! Subroutine He4GridAttrR4 returns a global attributes of type ! REAL*4 associated with the grid data structure. (bmy, 4/10/08) ! ! Arguments as Input: ! --------------------------------------------------------------------- ! (1) gId (INTEGER ) : HDF-EOS4 grid ID number ! (2) attrName (CHARACTER) : Name of attribute to read from file ! ! Arguments as Output: ! --------------------------------------------------------------------- ! (3) attrValue (REAL*4 ) : Value of attribute ! ! NOTES: !====================================================================== ! Arguments INTEGER, INTENT(IN) :: gId CHARACTER(LEN=*), INTENT(IN) :: attrName REAL*4, INTENT(OUT) :: attrValue ! Local variables INTEGER :: status ! HDF4-EOS library routines INTEGER :: GdRdAttr !----------------------------------- ! He4SwathReadAttrR4 begins here! !----------------------------------- ! Read attribute status = GdRdAttr( gId, TRIM( attrName ), attrValue ) END SUBROUTINE He4GridReadAttrR4 !------------------------------------------------------------------------------ SUBROUTINE He4GridReadAttrR8( gId, attrName, attrValue ) !====================================================================== ! Subroutine He4GridAttrR8 returns a global attributes of type ! REAL*8 associated with the grid data structure. (bmy, 4/10/08) ! ! Arguments as Input: ! --------------------------------------------------------------------- ! (1) sId (INTEGER ) : HDF-EOS4 swath ID number ! (2) attrName (CHARACTER) : Name of attribute to read from file ! ! Arguments as Output: ! --------------------------------------------------------------------- ! (3) attrValue (REAL*8 ) : Value of attribute ! ! NOTES: !====================================================================== ! Arguments INTEGER, INTENT(IN) :: gId CHARACTER(LEN=*), INTENT(IN) :: attrName REAL*8, INTENT(OUT) :: attrValue ! Local variables INTEGER :: status ! HDF4-EOS library routines INTEGER :: GdRdAttr !----------------------------------- ! He4GridReadAttrR8 begins here! !----------------------------------- ! Read attribute status = GdRdAttr( gId, TRIM( attrName ), attrValue ) END SUBROUTINE He4GridReadAttrR8 !------------------------------------------------------------------------------ SUBROUTINE He4GridGetFillValue( fieldName, fillValue ) !===================================================================== ! Subroutine He4GridGetFillValue reads the missing data "fill" value ! for a field contained in the HDF-EOS file. (bmy, 1/17/06) ! ! Arguments as Input: ! -------------------------------------------------------------------- ! (1) fieldName (CHARACTER) : Name of the field to read in ! ! Arguments as Output: ! -------------------------------------------------------------------- ! (2) fillValue (REAL*4 ) : Fill value for missing data ! ! NOTES: !===================================================================== ! Arguments CHARACTER(LEN=*), INTENT(IN) :: fieldName REAL*4, INTENT(OUT) :: fillValue ! Local variables INTEGER :: status ! HDF-EOS4 library routines INTEGER :: gdGetFill !---------------------------------- ! He4GridGetFillValue begins here! !---------------------------------- ! Call HDF library routine "gdrdfld" to read the data field status = gdGetFill( gId, TRIM( fieldName ), fillValue ) ! Assign a large negative number to FILLVALUE if IF ( status == FAIL ) fillValue = 0.0 END SUBROUTINE He4GridGetFillValue !----------------------------------------------------------------------------- SUBROUTINE He4GridReadData3D( fldName, data3D ) !===================================================================== ! Subroutine He4GridReadData3D" reads a 3-dimensional data field ! (X,Y,Time) from the HDF-EOS4 file. (bmy, 1/17/06) ! ! Arguments as Input: ! -------------------------------------------------------------------- ! (1) fldName (CHARACTER) : Name of the field to read in ! ! Arguments as Output: ! -------------------------------------------------------------------- ! (2) data3D (REAL*4 ) : Data array (3 dimensions) ! ! NOTES: !===================================================================== ! Arguments CHARACTER(LEN=*), INTENT(IN) :: fldName REAL*4, INTENT(OUT) :: data3D(:,:,:) ! Local variables INTEGER :: status CHARACTER(LEN=HE4_MAX_CHAR) :: msg, loc ! HDF-EOS4 library routines INTEGER :: gdRdFld !-------------------------------- ! He4GridReadData3D begins here! !-------------------------------- ! Call HDF library routine "gdrdfld" to read the data field status = gdRdFld( gId, TRIM( fldName ), start3D, stride3D, edge3D, data3D ) ! Error check IF ( status == FAIL ) THEN msg = 'ERROR reading data for field ' // TRIM( fldName ) loc = 'He4GridReadData3D ("He4GridModule.f90")' CALL He4ErrMsg( msg, loc ) ENDIF END SUBROUTINE He4GridReadData3D !----------------------------------------------------------------------------- SUBROUTINE He4GridReadData4D( fldName, data4D ) !===================================================================== ! Subroutine He4GridReadData4D reads a 4-dimensional data field ! (X,Y,Z,Time) from the HDF-EOS file. (bmy, 1/17/06) ! ! Arguments as Input: ! -------------------------------------------------------------------- ! (1) fldName (CHARACTER) : Name of the field to read in ! ! Arguments as Output: ! -------------------------------------------------------------------- ! (1) data4D (REAL*4 ) : Data array (4 dimensions) ! ! NOTES: !===================================================================== ! Arguments CHARACTER(LEN=*), INTENT(IN) :: fldName REAL*4, INTENT(OUT) :: data4D(:,:,:,:) ! Local variables INTEGER :: status CHARACTER(LEN=HE4_MAX_CHAR) :: msg, loc ! HDF-EOS4 library routines INTEGER :: gdRdFld !-------------------------------- ! He4GridReadData4D begins here! !-------------------------------- ! Call HDF library routine "gdrdfld" to read the data field status = gdRdFld( gId, TRIM( fldName ), start4D, stride4D, edge4D, data4D ) ! Error check IF ( status == FAIL ) THEN msg = 'ERROR reading data for field ' // TRIM( fldName ) loc = 'He4GridReadData4D ("He4GridReadModule.f90")' CALL He4ErrMsg( msg, loc ) ENDIF END SUBROUTINE He4GridReadData4D !----------------------------------------------------------------------------- SUBROUTINE He4GridReadX !===================================================================== ! Subroutine He4GridReadX reads XDIM, the index field for the ! X-dimension of the HDF-EOS4 grid structure. (bmy, 1/17/06) ! ! NOTES: !===================================================================== ! Local variables INTEGER :: status, as CHARACTER(LEN=HE4_MAX_CHAR) :: msg, loc ! HDF-EOS4 library routines INTEGER :: gdRdFld !--------------------------- ! He4GridReadX begins here! !--------------------------- ! Allocate the XDIM array of longitude centers (if necessary) IF ( xDimSize > 0 .and. .not. ALLOCATED( xDim ) ) THEN ALLOCATE( xDim( xEdge(1) ), stat=as ) IF ( as /= 0 ) CALL He4AllocErr( 'xDim' ) ELSE RETURN ENDIF ! Read XDIM, the vector of longitudes (in degrees), if present status = gdRdFld( gId, 'XDim', xStart, xStride, xEdge, xDim ) ! Error check IF ( status == FAIL ) THEN msg = 'ERROR reading data for field xDim!' loc = 'gridReadX ("He4GridReadModule.f90")' CALL He4ErrMsg( msg, loc ) ENDIF ! Echo information to the standard output IF ( VERBOSE ) THEN WRITE( 6, '(a)' ) WRITE( 6, '(a)' ) ' XDim: Longitude Centers (in degrees)' WRITE( 6, '(a)' ) REPEAT( '=', 79 ) WRITE( 6, '(9f8.2)' ) xDim ENDIF END SUBROUTINE He4GridReadX !----------------------------------------------------------------------------- SUBROUTINE He4GridReadY !===================================================================== ! Subroutine He4GridReadY reads YDIM, the index field for the ! Y-dimension of the HDF-EOS grid structure. (bmy, 1/17/06) ! ! NOTES: !===================================================================== ! Local variables INTEGER :: status, as CHARACTER(LEN=HE4_MAX_CHAR) :: msg, loc ! HDF-EOS4 library routines INTEGER :: gdRdFld !--------------------------- ! He4GridReadY begins here! !--------------------------- ! Allocate the YDIM array of longitude centers (if necessary) IF ( yDimSize > 0 .and. .not. ALLOCATED( yDim ) ) THEN ALLOCATE( yDim( yedge(1) ), stat=as ) IF ( as /= 0 ) CALL He4AllocErr( 'yDim' ) ELSE RETURN ENDIF ! Read YDIM, the vector of latitudes (in degrees), if present status = gdRdFld( gId, 'YDim', yStart, yStride, yEdge, yDim ) ! Error check IF ( status == FAIL ) THEN msg = 'ERROR reading data for field yDim!' loc = 'gridReadY ("He4GridModule.f90")' CALL He4ErrMsg( msg, loc ) ENDIF ! Echo information to the standard output IF ( verbose ) THEN WRITE( 6, '(a)' ) WRITE( 6, '(a)' ) ' YDim: Latitude Centers (in degrees)' WRITE( 6, '(a)' ) REPEAT( '=', 79 ) WRITE( 6, '(9f8.2)' ) yDim ENDIF END SUBROUTINE He4GridReadY !----------------------------------------------------------------------------- SUBROUTINE He4GridReadZ !===================================================================== ! Subroutine He4GridReadZ reads ZDIM, the index field for the ! Z-dimension of the HDF-EOS grid structure. (bmy, 1/17/06) ! ! ! NOTES: !===================================================================== ! Local variables INTEGER :: status, as CHARACTER(LEN=HE4_MAX_CHAR) :: msg, loc ! HDF-EOS4 library routines INTEGER :: gdRdFld !--------------------------- ! He4GridReadZ begins here! !--------------------------- ! Allocate the ZDIM array of altitude centers (if necessary) IF ( zDimSize > 0 .and. .not. ALLOCATED( zDim ) ) THEN ALLOCATE( zDim( zedge(1) ), stat=as ) IF ( as /= 0 ) CALL He4AllocErr( 'zDim' ) ELSE RETURN ENDIF ! Read ZDIM, the vector of pressures, if present status = gdRdFld( gId, 'Height', zStart, zStride, zEdge, zDim ) ! Error check IF ( status == FAIL ) THEN msg = 'ERROR reading data for field zDim!' loc = 'gridReadZ ("He4GridReadModule.f90")' CALL He4ErrMsg( msg, loc ) ENDIF ! Echo information to the standard output IF ( verbose ) THEN WRITE( 6, '(a)' ) WRITE( 6, '(a)' ) ' ZDim: Altitude Indices' WRITE( 6, '(a)' ) REPEAT( '=', 79 ) WRITE( 6, '(9f8.2)' ) zDim ENDIF END SUBROUTINE He4GridReadZ !----------------------------------------------------------------------------- SUBROUTINE He4GridReadT !===================================================================== ! Subroutine He4GridReadT reads TIME, the index field for the ! time-dimension of the HDF-EOS grid structure. (bmy, 1/17/06) ! ! NOTES: !===================================================================== ! Local variables INTEGER :: status, as, t CHARACTER(LEN=HE4_MAX_CHAR) :: msg, loc ! HDF-EOS4 library routines INTEGER :: gdRdFld !--------------------------- ! He4gridReadT begins here! !--------------------------- ! Allocate the time array, if it has not been previously allocated IF ( tDimSize > 0 .and. .not. ALLOCATED( time ) ) THEN ALLOCATE( time( tEdge(1) ), stat=as ) IF ( as /= 0 ) CALL He4AllocErr( 'time' ) ELSE RETURN ENDIF ! Read TIME, the vector of longitudes (in degrees), if present status = gdRdFld( gId, 'Time', tStart, tStride, tEdge, time ) ! Error check TIME IF ( status == FAIL ) THEN msg = 'ERROR reading data for field Time!' loc = 'He4GridReadT ("He4GridModule.f90")' CALL He4ErrMsg( msg, loc ) ENDIF END SUBROUTINE He4GridReadT !----------------------------------------------------------------------------- SUBROUTINE He4GetNymdNhms !===================================================================== ! Subroutine He4getNymdNhms converts the "Time" array into YYYYMMDD ! (NYMD) and HHMMSS (NHMS) values. ! ! NOTES: ! (1) Some HDF-EOS files index time as seconds since 1993. If this ! is the case, then set module variable TIMEFROM1993 = .TRUE. ! ! (2) The HDF-EOS files for the GEOS-3/Terra assimilation index time ! from the starting date and time contained in the file name. ! To read these files, first set TIMEFROM1993 = .FALSE. ! ! (3) Call routines JULDAY and CALDAT to compute the Year/Month/Day ! and Hour/Minute/Second. These will account for time periods ! that straddle a month change. ! ! (4) Now trim excess spaces from SAVEFILENAME before splitting ! it up into segments. Also error check NYMD and NHMS for ! negative values. (bmy, 9/21/00) !===================================================================== ! Local variables INTEGER :: t, as, year0, month0, day0, hour0 REAL*8 :: julianDay, julianDay0 CHARACTER(LEN=HE4_MAX_CHAR) :: tmpStr, suffix(10) !----------------------------- ! He4GetNymdNhms begins here! !----------------------------- ! Get the time index array CALL He4GridReadT ! Allocate the nymd and nhms arrays IF ( tDimSize > 0 ) THEN ! NYMD array IF ( .not. ALLOCATED( nymd ) ) THEN ALLOCATE( nymd( tEdge(1) ), stat=as ) IF ( as /= 0 ) CALL He4AllocErr( 'nymd' ) ENDIF ! NHMS array IF ( .not. ALLOCATED( nhms ) ) THEN ALLOCATE( nhms( tEdge(1) ), stat=as ) IF ( as /= 0 ) CALL He4AllocErr( 'nhms' ) ENDIF ELSE RETURN ENDIF !===================================================================== ! If TIME is measured from 1/1/1993, call "calDate" to ! convert time to YYYYMMDD and HHMMSS values. !===================================================================== IF ( timeFrom1993 ) THEN DO t = 1, tDimSize julianDay = 2448988.5d0 + ( time(t) / 86400d0 ) CALL calDate( julianDay, nymd(t), nhms(t) ) ENDDO !===================================================================== ! If TIME is NOT measured from 1/1/1993, then read YYYYMMDD from ! from the file name. HDF-EOS containing GEOS-3/Terra data stick ! to the following naming convention: ! ! (1) Assimilation files -- the suffix "tYYYYMMDD" indicates the ! starting date. The starting time is always 0h GMT. ! ! (2) Forecast files -- the suffix "bYYYYMMDDHH" indicates the ! starting date and GMT time. ! ! Therefore, extract the time/date info from the appropriate suffix. !===================================================================== ELSE ! Initialize suffix = '' ! Separate file name into individual segments ! Trim excess spaces from SAVEFILENAME (bmy, 9/21/00) CALL makeCharArrayfromCharList( TRIM( saveFileName ), '.', suffix ) ! Initialize TMPSTR, for safety's sake tmpStr = '' ! Loop thru the file name segments from right to left DO t = 1, 10 ! Save each segment into a temp string tmpStr = suffix(t) ! Skip null strings IF ( LEN_TRIM( tmpStr ) == 0 ) CYCLE ! Assimilation files have the date listed as "tYYYYMMDD" ! Extract starting year, month, day, and hour IF ( tmpStr(1:1) == 't' ) THEN IF ( LEN_TRIM( tmpStr ) == 9 ) THEN READ( tmpStr, '(1x,i4,i2,i2)' ) year0, month0, day0 hour0 = 0 EXIT ENDIF ENDIF ! Forecast files have the starting date/time listed as ! "bYYYYMMDDHH". Extract starting year, month, day, and hour IF ( tmpStr(1:1) == 'b' ) THEN IF ( LEN_TRIM( tmpStr ) == 11 ) THEN READ( tmpStr, '(1x,i4,i2,i2,i2)' ) year0, month0, day0, hour0 EXIT ENDIF ENDIF ENDDO ! Compute starting Julian day julianDay0 = julDay( year0, month0, DBLE( day0 ) ) ! Loop over all the elements of TIME DO t = 1, tDimSize ! Compute the julian day corresponding to each element of TIME julianDay = julianDay0 + ( time(t) / 1440.d0 ) + & ( DBLE( hour0 ) / 24d0 ) ! Convert Julian day to NYMD, NHMS ! This will work for days that straddle the 1st of the month CALL calDate( julianDay, nymd(t), nhms(t) ) ENDDO ENDIF ! Error check NYMD IF ( ANY( nymd < 0 ) ) THEN WRITE( 6, '(a)' ) REPEAT( '=', 79 ) WRITE( 6, '(a)' ) 'ERROR: NYMD is negative!' WRITE( 6, '(8i9)' ) nymd WRITE( 6, '(a)' ) 'STOP in getNymdNhms (HdfModule)' STOP ENDIF ! Error check NHMS IF ( ANY( nhms < 0 ) ) THEN WRITE( 6, '(a)' ) REPEAT( '=', 79 ) WRITE( 6, '(a)' ) 'ERROR: NYMD is negative!' WRITE( 6, '(8i9)' ) nymd WRITE( 6, '(a)' ) 'STOP in getNymdNhms (HdfModule)' STOP ENDIF ! Echo information values to the standard output IF ( VERBOSE ) THEN WRITE( 6, '(a)' ) WRITE( 6, '(a)' ) ' Time Time from Date Time' IF ( timeFrom1993 ) THEN WRITE( 6, '(a)' ) ' Index 1993 (s) (YYYYMMDD) (HHMMSS)' ELSE WRITE( 6, '(a)' ) ' Index start (s) (YYYYMMDD) (HHMMSS)' ENDIF WRITE( 6, '(a)' ) REPEAT( '=', 79 ) DO t = 1, tDimSize WRITE( 6, '(i5,1x,f13.1,8x,i8.8,8x,i6.6)' ) & t, time(t), nymd(t), nhms(t) ENDDO ENDIF END SUBROUTINE He4GetNymdNhms !----------------------------------------------------------------------------- SUBROUTINE He4CleanUpIndexFields !===================================================================== ! Subroutine He4CleanUpIndexFields deallocates the HDF-EOS index ! fields xDim, YDim, ZDim, time, nymd, and nhms. (bmy, 1/17/06) !===================================================================== IF ( ALLOCATED( xDim ) ) DEALLOCATE( xDim ) IF ( ALLOCATED( yDim ) ) DEALLOCATE( yDim ) IF ( ALLOCATED( zDim ) ) DEALLOCATE( zDim ) IF ( ALLOCATED( time ) ) DEALLOCATE( time ) IF ( ALLOCATED( nymd ) ) DEALLOCATE( nymd ) IF ( ALLOCATED( nhms ) ) DEALLOCATE( nhms ) END SUBROUTINE He4CleanUpIndexFields !----------------------------------------------------------------------------- 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. (bmy, 1/17/06) ! ! 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, INTENT(IN) :: year, month REAL*8, INTENT(IN) :: day ! Local variables LOGICAL :: isGregorian INTEGER :: year1, month1 REAL*8 :: x1, a, b, c, d, julianDay !====================================================================== ! 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 ! Function value REAL*8 :: value !-------------------- ! MINT begins here! !-------------------- IF ( x < 0d0 ) THEN value = -INT( ABS( x ) ) ELSE value = INT( ABS( x ) ) ENDIF END FUNCTION MINT !----------------------------------------------------------------------------- SUBROUTINE makeCharArrayFromCharList( list, separator, array ) !====================================================================== ! Subroutine makeCharArrayFromCharList takes a comma-separated word ! list, and places each word into a separate element of a character ! array. (bmy, 1/17/06, 11/8/06) ! ! Arguments as Input: ! --------------------------------------------------------------------- ! (1) list (CHARACTER) : String with comma-separated words ! (2) separator (CHARACTER) : String for separator text ! ! Arguments as output: ! --------------------------------------------------------------------- ! (3) array (CHARACTER) : Array of substrings ! ! NOTES: ! (1) Now set the output "array" argument to '' (bmy, 11/8/06) !====================================================================== ! Arguments CHARACTER(LEN=*), INTENT(IN) :: list CHARACTER(LEN=1 ), INTENT(IN) :: separator CHARACTER(LEN=HE4_MAX_CHAR), INTENT(OUT) :: array(:) ! local variables INTEGER :: P, N, ind(HE4_MAX_CHAR) CHARACTER(LEN=1) :: C !---------------------------------------- ! makeCharArrayFromCharList begins here! !---------------------------------------- ! Initialize N = 1 ind = 0 array = '' ! Find the positions of all the commas in LIST DO P = 1, LEN( list ) ! Look at each character individually C = list(P:P) ! If a comma... IF ( C == separator ) THEN ! Increment comma N = N + 1 ind(N) = P ENDIF ENDDO ! Add the position of the end of the string into IND ind(N+1) = LEN( list ) ! Save text between the commas into ARRAY DO P = 1, N IF ( P == N ) THEN array(P) = list( ind(P)+1:ind(P+1) ) ELSE array(P) = list( ind(P)+1:ind(P+1)-1 ) ENDIF ENDDO END SUBROUTINE makeCharArrayFromCharList !----------------------------------------------------------------------------- END MODULE He4GridModule