C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_write_meta.F,v 1.6 2013/01/13 22:42:26 jmc Exp $
C $Name:  $

#include "MDSIO_OPTIONS.h"

CBOP
C     !ROUTINE: MDS_WRITE_META
C     !INTERFACE:
      SUBROUTINE MDS_WRITE_META(
     I    mFileName,
     I    dFileName,
     I    simulName,
     I    titleLine,
     I    filePrec,
     I    nDims,   dimList, map2gl,
     I    nFlds,   fldList,
     I    nTimRec, timList, misVal,
     I    nrecords, myIter, myThid )

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R MDS_WRITE_META
C     | o Write 1 meta file to disk
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE

C     == Global variables / common blocks
#include "SIZE.h"
#include "EEPARAMS.h"

C     !INPUT PARAMETERS:
C     mFileName (string ) :: complete name of meta-file
C     dFileName (string ) :: complete name of data-file
C     simulName (string)  :: name of this simulation
C     titleLine (string)  :: title or any descriptive comments
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, etc.
C     map2gl    (integer) :: used for mapping tiled file to global file
C     nFlds     (integer) :: number of fields in "fldList"
C     fldList   (string)  :: array of field names to write
C     nTimRec   (integer) :: number of time-specification in "timList"
C     timList   (real)    :: array of time-specifications to write
C     misVal    (real)    :: missing value (ignored if = 1.)
C     nrecords  (integer) :: record number
C     myIter    (integer) :: time-step number
C     myThid    (integer) :: my Thread Id number
C
C     !OUTPUT PARAMETERS:
C
      CHARACTER*(*) mFileName
      CHARACTER*(*) dFileName
      CHARACTER*(*) simulName
      CHARACTER*(*) titleLine
      INTEGER filePrec
      INTEGER nDims
      INTEGER dimList(3,nDims)
      INTEGER map2gl(2)
      INTEGER nFlds
      CHARACTER*(8) fldList(*)
      INTEGER nTimRec
      _RL     timList(*)
      _RL     misVal
      INTEGER nrecords
      INTEGER myIter
      INTEGER myThid
CEOP

C     !FUNCTIONS
      INTEGER  ILNBLNK
      EXTERNAL 

C     !LOCAL VARIABLES:
      INTEGER i,j,ii,iL
      INTEGER mUnit
c     LOGICAL exst
      CHARACTER*(MAX_LEN_MBUF) msgBuf

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

C We should *read* the met-file IF it exists to check
C  that the information we are writing is consistent
C  with the current contents
c     INQUIRE( file=mFileName, exist=exst )
C However, it is bloody difficult to parse files in fortran so someone
C  else can do this.
C For now, we will assume everything is ok and that the last record
C  is written to the last consecutive record in the file.

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='unknown',
     &      form='formatted' )

C-    Write the simulation name
      iL = ILNBLNK(simulName)
      IF ( iL.GT.0 ) THEN
       WRITE(mUnit,'(3A)') " simulation = { '",simulName(1:iL),"' };"
      ENDIF

C-    Write the number of dimensions
      WRITE(mUnit,'(1X,A,I3,A)') 'nDims = [ ',nDims,' ];'

C-    For each dimension, write 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)

      ii = 0
      DO j=1,nDims
       ii = MAX(dimList(1,j),ii)
      ENDDO
      WRITE(mUnit,'(1X,A)') 'dimList = ['
      IF ( ii.LT.10000 ) THEN
C     Small-size domain:
       DO j=1,nDims
        IF (j.LT.nDims) THEN
         WRITE(mUnit,'(1X,3(I5,","))')    (dimList(i,j),i=1,3)
        ELSE
         WRITE(mUnit,'(1X,2(I5,","),I5)') (dimList(i,j),i=1,3)
        ENDIF
       ENDDO
      ELSE
C     Large-size domain:
       DO j=1,nDims
        IF (j.LT.nDims) THEN
         WRITE(mUnit,'(1X,3(I10,","))')     (dimList(i,j),i=1,3)
        ELSE
         WRITE(mUnit,'(1X,2(I10,","),I10)') (dimList(i,j),i=1,3)
        ENDIF
       ENDDO
      ENDIF
      WRITE(mUnit,'(1X,A)') '];'
C-    only write if different from default:
      IF ( map2gl(1).NE.0 .OR. map2gl(2).NE.1 ) THEN
        WRITE(mUnit,'(1X,2(A,I5),A)') 'map2glob = [ ',
     &                  map2gl(1),',',map2gl(2),' ];'
      ENDIF

C-    Record the precision of the file
      IF (filePrec .EQ. precFloat32) THEN
       WRITE(mUnit,'(1X,A)') "dataprec = [ 'float32' ];"
      ELSEIF (filePrec .EQ. precFloat64) THEN
       WRITE(mUnit,'(1X,A)') "dataprec = [ 'float64' ];"
      ELSE
       WRITE(msgBuf,'(A)')
     &   ' MDSWRITEMETA: invalid filePrec'
       CALL PRINT_ERROR( msgBuf, myThid )
       STOP 'ABNORMAL END: S/R MDSWRITEMETA'
      ENDIF

C-    Record the current record number
C     This is a proxy for the actual number of records in the file.
C     If we could read the file then we could do this properly.
      WRITE(mUnit,'(1X,A,I5,A)') 'nrecords = [ ',nrecords,' ];'

C-    Record the file-name for the binary data
Cveto ii=ILNBLNK( dFileName )
Cveto WRITE(mUnit,'(1X,3A)') 'binarydatafile = [ ',dFileName(1:ii),' ];'

C-    Write the integer time (integer iteration number) for later record
C     keeping. If the timestep number is less than 0 then we assume
C     that the information is superfluous and do not write it.
      IF ( myIter.GE.0 )
     & WRITE(mUnit,'(1X,A,I10,A)') 'timeStepNumber = [ ',myIter,' ];'

C-    Write list of Time records
C note: format might change once we have a better idea of what will
C       be the time-information to write.
      IF ( nTimRec.GT.0 ) THEN
       ii = MIN(nTimRec,20)
       WRITE(msgBuf,'(1P20E20.12)') (timList(i),i=1,ii)
       WRITE(mUnit,'(1X,3A)') 'timeInterval = [', msgBuf(1:20*ii),' ];'
      ENDIF

C-    Write missing value
      IF ( misVal.NE.oneRL ) THEN
       WRITE(mUnit,'(1X,A,1PE21.14,A)')
     &                        'missingValue = [ ',misVal,' ];'
      ENDIF

C-    Write list of Fields
      IF ( nFlds.GT.0 ) THEN
        WRITE(mUnit,'(1X,A,I4,A)') 'nFlds = [ ', nFlds, ' ];'
        WRITE(mUnit,'(1X,A)') 'fldList = {'
        WRITE(mUnit,'(20(A2,A8,A1))')
     &          (" '",fldList(i),"'",i=1,nFlds)
        WRITE(mUnit,'(1X,A)') '};'
      ENDIF

C-    Write title or comments (but ignored by rdmds)
      iL = ILNBLNK(titleLine)
      IF ( iL.GT.0 ) THEN
       WRITE(mUnit,'(3A)')' /* ', titleLine(1:iL), ' */'
      ENDIF

C-    Close meta-file
      CLOSE(mUnit)

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      RETURN
      END