C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_read_meta.F,v 1.7 2013/01/13 22:48:49 jmc Exp $
C $Name: $
#include "MDSIO_OPTIONS.h"
CBOP
C !ROUTINE: MDS_READ_META
C !INTERFACE:
SUBROUTINE MDS_READ_META(
I fileName,
O simulName,
O titleLine,
O filePrec,
U nDims, nFlds, nTimRec,
O dimList, fldList, timList,
O misVal, nRecords, fileIter,
I useCurrentDir,
I myThid )
C !DESCRIPTION: \bv
C *==========================================================*
C | S/R MDS_READ_META
C | o Read the content of 1 meta file
C *==========================================================*
C \ev
C !USES:
IMPLICIT NONE
C == Global variables / common blocks
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
C !INPUT PARAMETERS:
C fileName (string ) :: prefix of meta-file name
C nDims (integer) :: max size of array dimList (or =0 if not reading dimList)
C nFlds (integer) :: max size of array fldList (or =0 if not reading fldList)
C nTimRec (integer) :: max size of array timList (or =0 if not reading timList)
C useCurrentDir(logic):: always read from the current directory (even if
C "mdsioLocalDir" is set)
C myThid (integer) :: my Thread Id number
C
C !OUTPUT PARAMETERS:
C simulName (string) :: name of simulation (recorded in file)
C titleLine (string) :: title or any descriptive comments (in file)
C filePrec (integer) :: number of bits per word in data-file (32 or 64)
C nDims (integer) :: number of dimensions
C dimList (integer) :: array of dimensions
cC map2gl (integer) :: used for mapping tiled file to global file
C nFlds (integer) :: number of fields in "fldList"
C fldList (string) :: list of fields (names) stored in file
C nTimRec (integer) :: number of time-specification in "timList"
C timList (real) :: array of time-specifications (recorded in file)
C misVal (real) :: missing value
C nRecords (integer) :: number of records
C fileIter (integer) :: time-step number (recorded in file)
C
CHARACTER*(*) fileName
CHARACTER*(*) simulName
CHARACTER*(*) titleLine
INTEGER filePrec
INTEGER nDims
INTEGER dimList(3,*)
c INTEGER map2gl(2)
INTEGER nFlds
CHARACTER*(8) fldList(*)
INTEGER nTimRec
_RL timList(*)
_RL misVal
INTEGER nRecords
INTEGER fileIter
LOGICAL useCurrentDir
INTEGER myThid
CEOP
C !FUNCTIONS
INTEGER ILNBLNK
EXTERNAL
C !LOCAL VARIABLES:
C i, j, ii :: loop indices
C iG,jG :: global tile indices
C iL,pL,iLm :: length of character strings (temp. variables)
C nDimFil :: number of dimensions (in meta file)
C nFldFil :: number of fields in "fldList" (in meta file)
C nTimFil :: number of time-specification in "timList" (meta file)
INTEGER i,j,ii
INTEGER iG,jG
INTEGER iL,pL,iLm
INTEGER mUnit, errIO
INTEGER nDimFil, nFldFil, nTimFil
LOGICAL fileExist, globalFile
CHARACTER*(MAX_LEN_MBUF) msgBuf
CHARACTER*(MAX_LEN_MBUF) lineBuf
CHARACTER*(MAX_LEN_FNAM) mFileName, pfName
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C-- Initialise output arguments
simulName = ' '
titleLine = ' '
filePrec = 0
nRecords = 0
fileIter = 0
c map2gl(1) = 0
c map2gl(2) = 1
DO j=1,nDims
DO i=1,3
dimList(i,j) = 0
ENDDO
ENDDO
DO i=1,nFlds
fldList(i)= ' '
ENDDO
DO i=1,nTimRec
timList(i) = 0.
ENDDO
misVal = oneRL
C-- Initialise Temp Var.
fileExist = .FALSE.
globalFile = .FALSE.
nDimFil = 0
nFldFil = 0
nTimFil = 0
C-- Only Master thread check for file, open & read ; others will
C return null argument ; sharing output needs to be done outside
C this S/R, using, e.g., common block (+ Master_thread + Barrier)
_BEGIN_MASTER( myThid )
C Assign special directory
iL = ILNBLNK(fileName)
pL = ILNBLNK( mdsioLocalDir )
IF ( useCurrentDir .OR. pL.EQ.0 ) THEN
pfName = fileName
ELSE
WRITE(pfName,'(2A)') mdsioLocalDir(1:pL), fileName(1:iL)
ENDIF
pL = ILNBLNK( pfName )
C-- Search for meta file:
C- look for meta-file = {fileName}
mFileName = fileName(1:iL)
iLm = iL
c INQUIRE( FILE=mFileName, EXIST=fileExist )
IF ( .NOT.fileExist ) THEN
C- look for meta-file = {fileName}'.meta'
WRITE(mFileName,'(2A)') fileName(1:iL), '.meta'
iLm = iL+5
INQUIRE( FILE=mFileName, EXIST=fileExist )
ENDIF
IF ( fileExist ) THEN
globalFile = .TRUE.
ELSE
C- look for meta-file = {fileName}'.{iG}.{jG}.meta'
iG = 1+(myXGlobalLo-1)/sNx
jG = 1+(myYGlobalLo-1)/sNy
WRITE(mFileName,'(2A,I3.3,A,I3.3,A)')
& pfName(1:pL),'.',iG,'.',jG,'.meta'
iLm = pL+8+5
INQUIRE( FILE=mFileName, EXIST=fileExist )
ENDIF
IF ( .NOT.fileExist ) THEN
C- look for meta-file = {fileName}'.001.001.meta'
WRITE(mFileName,'(2A,I3.3,A,I3.3,A)')
& pfName(1:pL),'.',1,'.',1,'.meta'
iLm = pL+8+5
INQUIRE( FILE=mFileName, EXIST=fileExist )
ENDIF
IF ( .NOT.fileExist ) THEN
WRITE(msgBuf,'(4A)') 'WARNING >> MDS_READ_META: file: ',
& fileName(1:iL), '.meta , ', mFileName(1:iLm)
c & fileName(1:iL), ' , ', mFileName(1:iLm)
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT , myThid )
WRITE(msgBuf,'(A)')
& 'WARNING >> MDS_READ_META: Files DO not exist'
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT , myThid )
nFldFil = -1
ELSE
C-- File exist
IF ( debugLevel .GE. debLevB ) THEN
WRITE(msgBuf,'(2A)') ' MDS_READ_META: opening file: ',
& mFileName(1:iLm)
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT , myThid)
ENDIF
C- Assign a free unit number as the I/O channel for this subroutine
CALL MDSFINDUNIT( mUnit, myThid )
C- Open meta-file
OPEN( mUnit, FILE=mFileName, STATUS='old',
& FORM='formatted', IOSTAT=errIO )
c write(0,*) 'errIO=',errIO
IF ( errIO .NE. 0 ) THEN
WRITE(msgBuf,'(A,A)') 'MDS_READ_META: Unable to open file: ',
& mFileName(1:iLm)
CALL PRINT_ERROR( msgBuf , myThid )
STOP 'ABNORMAL END: S/R MDS_READ_META'
ENDIF
C- Read the meta file in the same way as S/R OPEN_COPY_DATA_FILE
C (which seems to be works on many platforms):
DO WHILE ( .TRUE. )
READ( mUnit, FMT='(A)', END=1001 ) lineBuf
C-- Extract information from buffer: "lineBuf"
iL = ILNBLNK(lineBuf)
C- Read simulation name (stored in file)
IF ( iL.GE.22 .AND. lineBuf(1:14).EQ.' simulation = ' ) THEN
ii = LEN(simulName)
c IF ( ii.LT.iL-21 ) print 'warning: truncate simulName'
ii = MIN(ii+17,iL-4)
simulName = lineBuf(18:ii)
iL = 0
ENDIF
C- Read the number of dimensions
IF ( nDimFil.EQ.0 .AND.
& iL.GE.15 .AND. lineBuf(1:9).EQ.' nDims = ' ) THEN
READ(lineBuf(12:iL),'(I3)') nDimFil
IF ( nDimFil.GT.nDims .AND. nDims.GE.1 ) THEN
WRITE(msgBuf,'(2(A,I3),A)') ' MDS_READ_META: nDims=',
& nDimFil, ' too large ( >', nDims, ' )'
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R MDS_READ_META'
ENDIF
iL = 0
ENDIF
C- Read list of dimensions
IF ( nDims.GE.1 .AND. nDimFil.GE.1 .AND.
& iL.GE.11 .AND. lineBuf(1:11).EQ.' dimList = ' ) THEN
C- For each dimension, read the following:
C 1 global size (ie. the size of the global dimension of all files)
C 2 global start (ie. the global position of the start of this file)
C 3 global end (ie. the global position of the end of this file)
DO j=1,nDimFil
C- This is to accomodate with the 2 versions of meta file:
READ( mUnit, FMT='(A)', END=1001 ) lineBuf
ii = ILNBLNK(lineBuf)
IF ( ii.LT.20 ) THEN
C New version (S/R MDS_WRITE_META, file mdsio_write_meta.F):
C small-size domain without starting blanks.
READ(lineBuf, FMT='(3(1X,I5))', ERR=1002, END=1002 )
& (dimList(i,j),i=1,3)
ELSEIF ( ii.LT.30 ) THEN
C Old version (S/R MDSWRITEMETA, file mdsio_writemeta.F):
C start each line with 10 blanks.
READ(lineBuf, FMT='(9X,3(1X,I5))', ERR=1002, END=1002 )
& (dimList(i,j),i=1,3)
ELSE
C New version (S/R MDS_WRITE_META, file mdsio_write_meta.F):
C large-size domain without starting blanks.
READ(lineBuf, FMT='(3(1X,I10))', ERR=1002, END=1002 )
& (dimList(i,j),i=1,3)
ENDIF
ENDDO
READ( mUnit, FMT='(A)', END=1001 ) lineBuf
iL = 0
ENDIF
C- only write if different from default:
c IF ( map2gl(1).NE.0 .OR. map2gl(2).NE.1 ) THEN
c WRITE(mUnit,'(1X,2(A,I5),A)') 'map2glob = [ ',
c & map2gl(1),',',map2gl(2),' ];'
c ENDIF
C- Read the precision of the file
IF ( iL.GE.20 .AND. lineBuf(1:12).EQ.' dataprec = ' ) THEN
IF ( lineBuf(16:22).EQ. 'float32' ) THEN
filePrec = precFloat32
ELSEIF ( lineBuf(16:22).EQ. 'float64' ) THEN
filePrec = precFloat64
ELSE
WRITE(msgBuf,'(A)') ' MDS_READ_META: invalid dataprec'
CALL PRINT_ERROR( msgBuf, myThid )
CALL PRINT_ERROR(lineBuf, myThid )
STOP 'ABNORMAL END: S/R MDS_READ_META'
ENDIF
iL = 0
ENDIF
C- Read (old format) precision of the file
IF ( filePrec.EQ.0 .AND.
& iL.GE.18 .AND. lineBuf(1:10).EQ.' format = ' ) THEN
IF ( lineBuf(14:20).EQ. 'float32' ) THEN
filePrec = precFloat32
ELSEIF ( lineBuf(14:20).EQ. 'float64' ) THEN
filePrec = precFloat64
ELSE
WRITE(msgBuf,'(A)') ' MDS_READ_META: invalid dataprec'
CALL PRINT_ERROR( msgBuf, myThid )
CALL PRINT_ERROR(lineBuf, myThid )
STOP 'ABNORMAL END: S/R MDS_READ_META'
ENDIF
iL = 0
ENDIF
C- Read the number of records
IF ( nRecords.EQ.0 .AND.
& iL.GE.20 .AND. lineBuf(1:12).EQ.' nrecords = ' ) THEN
READ(lineBuf(15:iL),'(I5)') nRecords
iL = 0
ENDIF
C- Read recorded iteration number
IF ( fileIter.EQ.0 .AND. iL.GE.31 .AND.
& lineBuf(1:18).EQ.' timeStepNumber = ' ) THEN
READ(lineBuf(21:iL),'(I10)') fileIter
iL = 0
ENDIF
C- Read list of Time Intervals
IF ( nTimFil.EQ.0 .AND.
& iL.GE.38 .AND. lineBuf(1:16).EQ.' timeInterval = ' ) THEN
C note: format might change once we have a better idea of what will
C be the time-information to write.
nTimFil = INT((iL-17-3)/20)
IF ( nTimRec.GE.1 ) THEN
IF ( nTimFil.GT.nTimRec ) THEN
WRITE(msgBuf,'(2(A,I6),A)') ' MDS_READ_META: nTimRec=',
& nTimFil, ' too large ( >', nTimRec, ' )'
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R MDS_READ_META'
ENDIF
READ(lineBuf(18:iL-3),'(1P20E20.12)',ERR=1003)
& (timList(i),i=1,nTimFil)
ENDIF
iL = 0
ENDIF
IF ( iL.GE.8 .AND. lineBuf(1:4).EQ.' /* ' ) THEN
IF ( lineBuf(iL-2:iL).EQ.' */' ) THEN
C- Read title or comments (ignored by rdmds)
ii = LEN(titleLine)
c IF ( ii.LT.iL-7 ) print 'warning: truncate titleLine'
ii = MIN(ii+4,iL-3)
titleLine = lineBuf(5:ii)
iL = 0
ENDIF
ENDIF
C- Read missing value
IF ( misVal.EQ.oneRL .AND. iL.GE.40 .AND.
& lineBuf(1:16).EQ.' missingValue = ' ) THEN
READ(lineBuf(19:iL),'(1PE21.14)') misVal
iL = 0
ENDIF
C- Read number of Fields
IF ( nFldFil.EQ.0 .AND.
& iL.GE.16 .AND. lineBuf(1:9).EQ.' nFlds = ' ) THEN
READ(lineBuf(12:iL),'(I4)') nFldFil
IF ( nFldFil.GT.nFlds .AND. nFlds.GE.1 ) THEN
WRITE(msgBuf,'(2(A,I6),A)') ' MDS_READ_META: nFlds=',
& nFldFil, ' too large ( >', nFlds, ' )'
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R MDS_READ_META'
ENDIF
iL = 0
ENDIF
C- Read list of Fields
IF ( nFldFil.GE.1 .AND. nFlds.GE.1 .AND.
& iL.GE.11 .AND. lineBuf(1:11).EQ.' fldList = ' ) THEN
DO j=1,nFldFil,20
READ( mUnit, FMT='(20(2X,A8,1X))', ERR=1004, END=1004 )
& (fldList(i),i=j,MIN(nFldFil,j+19))
ENDDO
READ( mUnit, FMT='(A)', END=1001 ) lineBuf
iL = 0
ENDIF
C-- End of reading file line per line
ENDDO
1004 CONTINUE
WRITE(msgBuf,'(2(A,I4),A)')
& ' MDS_READ_META: error reading Fields: nFlds=',
& nFldFil, ' , j=', j
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R MDS_READ_META'
1003 CONTINUE
WRITE(msgBuf,'(2(A,I4),A)')
& ' MDS_READ_META: error reading Time-Interval: nTimRec=',
& nTimFil, ' , iL=', iL
CALL PRINT_ERROR( msgBuf, myThid )
CALL PRINT_ERROR(lineBuf, myThid )
STOP 'ABNORMAL END: S/R MDS_READ_META'
1002 CONTINUE
WRITE(msgBuf,'(3(A,I3),A)')
& ' MDS_READ_META: error reading Dim-List: nDims=',
& nDimFil, ' , j=', j, ' , ii=', ii
CALL PRINT_ERROR( msgBuf, myThid )
CALL PRINT_ERROR(lineBuf, myThid )
STOP 'ABNORMAL END: S/R MDS_READ_META'
1001 CONTINUE
C- Close meta-file
CLOSE(mUnit)
C- end if block: file exist
ENDIF
_END_MASTER( myThid )
C- Update Arguments with values read from file
nDims = nDimFil
nFlds = nFldFil
nTimRec = nTimFil
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
RETURN
END