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