pkg/mdsio/mdsio_write_meta.F

e62a71baf9 Jean*0001 #include "MDSIO_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: MDS_WRITE_META
                0005 C     !INTERFACE:
                0006       SUBROUTINE MDS_WRITE_META(
                0007      I    mFileName,
                0008      I    dFileName,
                0009      I    simulName,
                0010      I    titleLine,
                0011      I    filePrec,
20b1679b8a Jean*0012      I    nDims,   dimList, map2gl,
e62a71baf9 Jean*0013      I    nFlds,   fldList,
4774f70820 Jean*0014      I    nTimRec, timList, misVal,
e62a71baf9 Jean*0015      I    nrecords, myIter, myThid )
                0016
                0017 C     !DESCRIPTION: \bv
                0018 C     *==========================================================*
                0019 C     | S/R MDS_WRITE_META
                0020 C     | o Write 1 meta file to disk
                0021 C     *==========================================================*
                0022 C     \ev
                0023
                0024 C     !USES:
                0025       IMPLICIT NONE
                0026
                0027 C     == Global variables / common blocks
                0028 #include "SIZE.h"
                0029 #include "EEPARAMS.h"
                0030
                0031 C     !INPUT PARAMETERS:
                0032 C     mFileName (string ) :: complete name of meta-file
                0033 C     dFileName (string ) :: complete name of data-file
                0034 C     simulName (string)  :: name of this simulation
20b1679b8a Jean*0035 C     titleLine (string)  :: title or any descriptive comments
e62a71baf9 Jean*0036 C     filePrec  (integer) :: number of bits per word in data-file (32 or 64)
                0037 C     nDims     (integer) :: number of dimensions
                0038 C     dimList   (integer) :: array of dimensions, etc.
20b1679b8a Jean*0039 C     map2gl    (integer) :: used for mapping tiled file to global file
e62a71baf9 Jean*0040 C     nFlds     (integer) :: number of fields in "fldList"
                0041 C     fldList   (string)  :: array of field names to write
                0042 C     nTimRec   (integer) :: number of time-specification in "timList"
                0043 C     timList   (real)    :: array of time-specifications to write
4774f70820 Jean*0044 C     misVal    (real)    :: missing value (ignored if = 1.)
e62a71baf9 Jean*0045 C     nrecords  (integer) :: record number
                0046 C     myIter    (integer) :: time-step number
                0047 C     myThid    (integer) :: my Thread Id number
                0048 C
                0049 C     !OUTPUT PARAMETERS:
                0050 C
                0051       CHARACTER*(*) mFileName
                0052       CHARACTER*(*) dFileName
                0053       CHARACTER*(*) simulName
                0054       CHARACTER*(*) titleLine
                0055       INTEGER filePrec
                0056       INTEGER nDims
                0057       INTEGER dimList(3,nDims)
20b1679b8a Jean*0058       INTEGER map2gl(2)
e62a71baf9 Jean*0059       INTEGER nFlds
                0060       CHARACTER*(8) fldList(*)
                0061       INTEGER nTimRec
                0062       _RL     timList(*)
4774f70820 Jean*0063       _RL     misVal
e62a71baf9 Jean*0064       INTEGER nrecords
                0065       INTEGER myIter
                0066       INTEGER myThid
                0067 CEOP
                0068
                0069 C     !FUNCTIONS
                0070       INTEGER  ILNBLNK
                0071       EXTERNAL ILNBLNK
                0072
                0073 C     !LOCAL VARIABLES:
079512f56f Jean*0074       INTEGER i,j,ii,iL
e62a71baf9 Jean*0075       INTEGER mUnit
                0076 c     LOGICAL exst
                0077       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0078
                0079 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0080
                0081 C We should *read* the met-file IF it exists to check
                0082 C  that the information we are writing is consistent
                0083 C  with the current contents
                0084 c     INQUIRE( file=mFileName, exist=exst )
                0085 C However, it is bloody difficult to parse files in fortran so someone
                0086 C  else can do this.
                0087 C For now, we will assume everything is ok and that the last record
                0088 C  is written to the last consecutive record in the file.
                0089
                0090 C-    Assign a free unit number as the I/O channel for this subroutine
                0091       CALL MDSFINDUNIT( mUnit, myThid )
                0092
                0093 C-    Open meta-file
                0094       OPEN( mUnit, file=mFileName, status='unknown',
                0095      &      form='formatted' )
                0096
                0097 C-    Write the simulation name
                0098       iL = ILNBLNK(simulName)
                0099       IF ( iL.GT.0 ) THEN
                0100        WRITE(mUnit,'(3A)') " simulation = { '",simulName(1:iL),"' };"
                0101       ENDIF
                0102
                0103 C-    Write the number of dimensions
                0104       WRITE(mUnit,'(1X,A,I3,A)') 'nDims = [ ',nDims,' ];'
                0105
                0106 C-    For each dimension, write the following:
                0107 C     1  global size  (ie. the size of the global dimension of all files)
                0108 C     2  global start (ie. the global position of the start of this file)
                0109 C     3  global end   (ie. the global position of the end   of this file)
                0110
079512f56f Jean*0111       ii = 0
                0112       DO j=1,nDims
                0113        ii = MAX(dimList(1,j),ii)
e62a71baf9 Jean*0114       ENDDO
079512f56f Jean*0115       WRITE(mUnit,'(1X,A)') 'dimList = ['
                0116       IF ( ii.LT.10000 ) THEN
                0117 C     Small-size domain:
                0118        DO j=1,nDims
                0119         IF (j.LT.nDims) THEN
                0120          WRITE(mUnit,'(1X,3(I5,","))')    (dimList(i,j),i=1,3)
                0121         ELSE
                0122          WRITE(mUnit,'(1X,2(I5,","),I5)') (dimList(i,j),i=1,3)
                0123         ENDIF
                0124        ENDDO
                0125       ELSE
                0126 C     Large-size domain:
                0127        DO j=1,nDims
                0128         IF (j.LT.nDims) THEN
                0129          WRITE(mUnit,'(1X,3(I10,","))')     (dimList(i,j),i=1,3)
                0130         ELSE
                0131          WRITE(mUnit,'(1X,2(I10,","),I10)') (dimList(i,j),i=1,3)
                0132         ENDIF
                0133        ENDDO
                0134       ENDIF
e62a71baf9 Jean*0135       WRITE(mUnit,'(1X,A)') '];'
20b1679b8a Jean*0136 C-    only write if different from default:
                0137       IF ( map2gl(1).NE.0 .OR. map2gl(2).NE.1 ) THEN
                0138         WRITE(mUnit,'(1X,2(A,I5),A)') 'map2glob = [ ',
                0139      &                  map2gl(1),',',map2gl(2),' ];'
                0140       ENDIF
e62a71baf9 Jean*0141
                0142 C-    Record the precision of the file
                0143       IF (filePrec .EQ. precFloat32) THEN
                0144        WRITE(mUnit,'(1X,A)') "dataprec = [ 'float32' ];"
                0145       ELSEIF (filePrec .EQ. precFloat64) THEN
                0146        WRITE(mUnit,'(1X,A)') "dataprec = [ 'float64' ];"
                0147       ELSE
                0148        WRITE(msgBuf,'(A)')
                0149      &   ' MDSWRITEMETA: invalid filePrec'
                0150        CALL PRINT_ERROR( msgBuf, myThid )
                0151        STOP 'ABNORMAL END: S/R MDSWRITEMETA'
                0152       ENDIF
                0153
                0154 C-    Record the current record number
                0155 C     This is a proxy for the actual number of records in the file.
                0156 C     If we could read the file then we could do this properly.
66046ae6a1 Brun*0157       WRITE(mUnit,'(1X,A,I10,A)') 'nrecords = [ ',nrecords,' ];'
e62a71baf9 Jean*0158
                0159 C-    Record the file-name for the binary data
                0160 Cveto ii=ILNBLNK( dFileName )
                0161 Cveto WRITE(mUnit,'(1X,3A)') 'binarydatafile = [ ',dFileName(1:ii),' ];'
                0162
                0163 C-    Write the integer time (integer iteration number) for later record
                0164 C     keeping. If the timestep number is less than 0 then we assume
                0165 C     that the information is superfluous and do not write it.
                0166       IF ( myIter.GE.0 )
                0167      & WRITE(mUnit,'(1X,A,I10,A)') 'timeStepNumber = [ ',myIter,' ];'
                0168
                0169 C-    Write list of Time records
                0170 C note: format might change once we have a better idea of what will
20b1679b8a Jean*0171 C       be the time-information to write.
e62a71baf9 Jean*0172       IF ( nTimRec.GT.0 ) THEN
                0173        ii = MIN(nTimRec,20)
                0174        WRITE(msgBuf,'(1P20E20.12)') (timList(i),i=1,ii)
47d9634d91 Jean*0175        WRITE(mUnit,'(1X,3A)') 'timeInterval = [', msgBuf(1:20*ii),' ];'
e62a71baf9 Jean*0176       ENDIF
                0177
4774f70820 Jean*0178 C-    Write missing value
                0179       IF ( misVal.NE.oneRL ) THEN
                0180        WRITE(mUnit,'(1X,A,1PE21.14,A)')
                0181      &                        'missingValue = [ ',misVal,' ];'
                0182       ENDIF
                0183
e62a71baf9 Jean*0184 C-    Write list of Fields
                0185       IF ( nFlds.GT.0 ) THEN
                0186         WRITE(mUnit,'(1X,A,I4,A)') 'nFlds = [ ', nFlds, ' ];'
                0187         WRITE(mUnit,'(1X,A)') 'fldList = {'
                0188         WRITE(mUnit,'(20(A2,A8,A1))')
                0189      &          (" '",fldList(i),"'",i=1,nFlds)
                0190         WRITE(mUnit,'(1X,A)') '};'
                0191       ENDIF
                0192
                0193 C-    Write title or comments (but ignored by rdmds)
                0194       iL = ILNBLNK(titleLine)
                0195       IF ( iL.GT.0 ) THEN
                0196        WRITE(mUnit,'(3A)')' /* ', titleLine(1:iL), ' */'
                0197       ENDIF
                0198
                0199 C-    Close meta-file
                0200       CLOSE(mUnit)
                0201
                0202 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0203
                0204       RETURN
                0205       END