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"
242228367a Mart*0030 #ifdef ALLOW_CAL
                0031 # include "PARAMS.h"
                0032 #endif
e62a71baf9 Jean*0033
                0034 C     !INPUT PARAMETERS:
                0035 C     mFileName (string ) :: complete name of meta-file
                0036 C     dFileName (string ) :: complete name of data-file
                0037 C     simulName (string)  :: name of this simulation
20b1679b8a Jean*0038 C     titleLine (string)  :: title or any descriptive comments
e62a71baf9 Jean*0039 C     filePrec  (integer) :: number of bits per word in data-file (32 or 64)
                0040 C     nDims     (integer) :: number of dimensions
                0041 C     dimList   (integer) :: array of dimensions, etc.
20b1679b8a Jean*0042 C     map2gl    (integer) :: used for mapping tiled file to global file
e62a71baf9 Jean*0043 C     nFlds     (integer) :: number of fields in "fldList"
                0044 C     fldList   (string)  :: array of field names to write
                0045 C     nTimRec   (integer) :: number of time-specification in "timList"
                0046 C     timList   (real)    :: array of time-specifications to write
4774f70820 Jean*0047 C     misVal    (real)    :: missing value (ignored if = 1.)
e62a71baf9 Jean*0048 C     nrecords  (integer) :: record number
                0049 C     myIter    (integer) :: time-step number
                0050 C     myThid    (integer) :: my Thread Id number
                0051 C
                0052 C     !OUTPUT PARAMETERS:
                0053 C
                0054       CHARACTER*(*) mFileName
                0055       CHARACTER*(*) dFileName
                0056       CHARACTER*(*) simulName
                0057       CHARACTER*(*) titleLine
                0058       INTEGER filePrec
                0059       INTEGER nDims
                0060       INTEGER dimList(3,nDims)
20b1679b8a Jean*0061       INTEGER map2gl(2)
e62a71baf9 Jean*0062       INTEGER nFlds
                0063       CHARACTER*(8) fldList(*)
                0064       INTEGER nTimRec
                0065       _RL     timList(*)
4774f70820 Jean*0066       _RL     misVal
e62a71baf9 Jean*0067       INTEGER nrecords
                0068       INTEGER myIter
                0069       INTEGER myThid
                0070 CEOP
                0071
                0072 C     !FUNCTIONS
                0073       INTEGER  ILNBLNK
                0074       EXTERNAL ILNBLNK
                0075
                0076 C     !LOCAL VARIABLES:
079512f56f Jean*0077       INTEGER i,j,ii,iL
e62a71baf9 Jean*0078       INTEGER mUnit
                0079 c     LOGICAL exst
                0080       CHARACTER*(MAX_LEN_MBUF) msgBuf
242228367a Mart*0081 #ifdef ALLOW_CAL
                0082       _RL     myTime
                0083       INTEGER myDate(4)
                0084       INTEGER year, month, day, hour, minute, second
                0085 #endif
e62a71baf9 Jean*0086
                0087 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0088
                0089 C We should *read* the met-file IF it exists to check
                0090 C  that the information we are writing is consistent
                0091 C  with the current contents
                0092 c     INQUIRE( file=mFileName, exist=exst )
                0093 C However, it is bloody difficult to parse files in fortran so someone
                0094 C  else can do this.
                0095 C For now, we will assume everything is ok and that the last record
                0096 C  is written to the last consecutive record in the file.
                0097
                0098 C-    Assign a free unit number as the I/O channel for this subroutine
                0099       CALL MDSFINDUNIT( mUnit, myThid )
                0100
                0101 C-    Open meta-file
                0102       OPEN( mUnit, file=mFileName, status='unknown',
                0103      &      form='formatted' )
                0104
                0105 C-    Write the simulation name
                0106       iL = ILNBLNK(simulName)
                0107       IF ( iL.GT.0 ) THEN
                0108        WRITE(mUnit,'(3A)') " simulation = { '",simulName(1:iL),"' };"
                0109       ENDIF
                0110
                0111 C-    Write the number of dimensions
                0112       WRITE(mUnit,'(1X,A,I3,A)') 'nDims = [ ',nDims,' ];'
                0113
                0114 C-    For each dimension, write the following:
                0115 C     1  global size  (ie. the size of the global dimension of all files)
                0116 C     2  global start (ie. the global position of the start of this file)
                0117 C     3  global end   (ie. the global position of the end   of this file)
                0118
079512f56f Jean*0119       ii = 0
                0120       DO j=1,nDims
                0121        ii = MAX(dimList(1,j),ii)
e62a71baf9 Jean*0122       ENDDO
079512f56f Jean*0123       WRITE(mUnit,'(1X,A)') 'dimList = ['
                0124       IF ( ii.LT.10000 ) THEN
                0125 C     Small-size domain:
                0126        DO j=1,nDims
                0127         IF (j.LT.nDims) THEN
                0128          WRITE(mUnit,'(1X,3(I5,","))')    (dimList(i,j),i=1,3)
                0129         ELSE
                0130          WRITE(mUnit,'(1X,2(I5,","),I5)') (dimList(i,j),i=1,3)
                0131         ENDIF
                0132        ENDDO
                0133       ELSE
                0134 C     Large-size domain:
                0135        DO j=1,nDims
                0136         IF (j.LT.nDims) THEN
                0137          WRITE(mUnit,'(1X,3(I10,","))')     (dimList(i,j),i=1,3)
                0138         ELSE
                0139          WRITE(mUnit,'(1X,2(I10,","),I10)') (dimList(i,j),i=1,3)
                0140         ENDIF
                0141        ENDDO
                0142       ENDIF
e62a71baf9 Jean*0143       WRITE(mUnit,'(1X,A)') '];'
20b1679b8a Jean*0144 C-    only write if different from default:
                0145       IF ( map2gl(1).NE.0 .OR. map2gl(2).NE.1 ) THEN
                0146         WRITE(mUnit,'(1X,2(A,I5),A)') 'map2glob = [ ',
                0147      &                  map2gl(1),',',map2gl(2),' ];'
                0148       ENDIF
e62a71baf9 Jean*0149
                0150 C-    Record the precision of the file
                0151       IF (filePrec .EQ. precFloat32) THEN
                0152        WRITE(mUnit,'(1X,A)') "dataprec = [ 'float32' ];"
                0153       ELSEIF (filePrec .EQ. precFloat64) THEN
                0154        WRITE(mUnit,'(1X,A)') "dataprec = [ 'float64' ];"
                0155       ELSE
                0156        WRITE(msgBuf,'(A)')
                0157      &   ' MDSWRITEMETA: invalid filePrec'
                0158        CALL PRINT_ERROR( msgBuf, myThid )
                0159        STOP 'ABNORMAL END: S/R MDSWRITEMETA'
                0160       ENDIF
                0161
                0162 C-    Record the current record number
                0163 C     This is a proxy for the actual number of records in the file.
                0164 C     If we could read the file then we could do this properly.
66046ae6a1 Brun*0165       WRITE(mUnit,'(1X,A,I10,A)') 'nrecords = [ ',nrecords,' ];'
e62a71baf9 Jean*0166
                0167 C-    Record the file-name for the binary data
                0168 Cveto ii=ILNBLNK( dFileName )
                0169 Cveto WRITE(mUnit,'(1X,3A)') 'binarydatafile = [ ',dFileName(1:ii),' ];'
                0170
                0171 C-    Write the integer time (integer iteration number) for later record
                0172 C     keeping. If the timestep number is less than 0 then we assume
                0173 C     that the information is superfluous and do not write it.
                0174       IF ( myIter.GE.0 )
                0175      & WRITE(mUnit,'(1X,A,I10,A)') 'timeStepNumber = [ ',myIter,' ];'
                0176
242228367a Mart*0177 #ifdef ALLOW_CAL
                0178       IF ( useCal .AND. myIter.GE.0 ) THEN
                0179 C     add the date and time according to pkg/cal that corresponds to the
                0180 C     current timestep myIter,
                0181 C     First recover current time and get date in pkg/cal-format
                0182        myTime = baseTime + myIter*deltaTClock
                0183        CALL CAL_GETDATE( myIter, myTime, myDate, myThid )
                0184 CMLC     this is simpler, but not so easy to read
                0185 CML       WRITE(mUnit,'(1X,A,I8.8,A,I6.6,A)')
                0186 CML     &      "timeStepDate (YYYYMMDDTHHmmss) = [ '",
                0187 CML     &      myDate(1),"T",myDate(2),"' ];"
                0188 C     Follow ISO 8601
                0189        day    = MOD(myDate(1),100)
                0190        month  = MOD(myDate(1)/100,100)
                0191        year   = myDate(1)/10000
                0192        second = MOD(myDate(2),100)
                0193        minute = MOD(myDate(2)/100,100)
                0194        hour   = myDate(2)/10000
                0195        WRITE(mUnit,'(1X,A,I4.4,A,5(I2.2,A))')
                0196      &      "timeStepDate = [ '",
                0197      &      year,"-",month,"-",day,"T",hour,":",minute,":",second,
                0198      &      "Z' ];"
                0199       ENDIf
                0200 #endif
                0201
e62a71baf9 Jean*0202 C-    Write list of Time records
                0203 C note: format might change once we have a better idea of what will
20b1679b8a Jean*0204 C       be the time-information to write.
e62a71baf9 Jean*0205       IF ( nTimRec.GT.0 ) THEN
                0206        ii = MIN(nTimRec,20)
                0207        WRITE(msgBuf,'(1P20E20.12)') (timList(i),i=1,ii)
47d9634d91 Jean*0208        WRITE(mUnit,'(1X,3A)') 'timeInterval = [', msgBuf(1:20*ii),' ];'
e62a71baf9 Jean*0209       ENDIF
                0210
4774f70820 Jean*0211 C-    Write missing value
                0212       IF ( misVal.NE.oneRL ) THEN
                0213        WRITE(mUnit,'(1X,A,1PE21.14,A)')
                0214      &                        'missingValue = [ ',misVal,' ];'
                0215       ENDIF
                0216
e62a71baf9 Jean*0217 C-    Write list of Fields
                0218       IF ( nFlds.GT.0 ) THEN
                0219         WRITE(mUnit,'(1X,A,I4,A)') 'nFlds = [ ', nFlds, ' ];'
                0220         WRITE(mUnit,'(1X,A)') 'fldList = {'
                0221         WRITE(mUnit,'(20(A2,A8,A1))')
                0222      &          (" '",fldList(i),"'",i=1,nFlds)
                0223         WRITE(mUnit,'(1X,A)') '};'
                0224       ENDIF
                0225
                0226 C-    Write title or comments (but ignored by rdmds)
                0227       iL = ILNBLNK(titleLine)
                0228       IF ( iL.GT.0 ) THEN
                0229        WRITE(mUnit,'(3A)')' /* ', titleLine(1:iL), ' */'
                0230       ENDIF
                0231
                0232 C-    Close meta-file
                0233       CLOSE(mUnit)
                0234
                0235 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0236
                0237       RETURN
                0238       END