pkg/mdsio/mdsio_write_meta.F

C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_write_meta.F,v 1.3 2008/07/20 12:26:10 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,
     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     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(*)
      INTEGER nrecords
      INTEGER myIter
      INTEGER myThid
CEOP

C     !FUNCTIONS
      INTEGER  ILNBLNK
      EXTERNAL ILNBLNK

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.
C     for now, comment out this line for rdmds (i.e.: between /* */)
      IF ( nTimRec.GT.0 ) THEN
       ii = MIN(nTimRec,20)
       WRITE(msgBuf,'(1P20E20.12)') (timList(i),i=1,ii)
       WRITE(mUnit,'(3A)')' /* modelTime = [', msgBuf(1:20*ii),' ];*/'
c      iL = ILNBLNK(msgBuf)
c      WRITE(mUnit,'(1X,3A)') 'modelTime = [', msgBuf(1:iL),' ];'
      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
1	jmc	1.4	C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_write_meta.F,v 1.3 2008/07/20 12:26:10 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "MDSIO_OPTIONS.h"
5
6			CBOP
7			C !ROUTINE: MDS_WRITE_META
8			C !INTERFACE:
9			SUBROUTINE MDS_WRITE_META(
10			I mFileName,
11			I dFileName,
12			I simulName,
13			I titleLine,
14			I filePrec,
15	jmc	1.2	I nDims, dimList, map2gl,
16	jmc	1.1	I nFlds, fldList,
17			I nTimRec, timList,
18			I nrecords, myIter, myThid )
19
20			C !DESCRIPTION: \bv
21			C ==========================================================
22			C \| S/R MDS_WRITE_META
23			C \| o Write 1 meta file to disk
24			C ==========================================================
25			C \ev
26
27			C !USES:
28			IMPLICIT NONE
29
30			C == Global variables / common blocks
31			#include "SIZE.h"
32			#include "EEPARAMS.h"
33
34			C !INPUT PARAMETERS:
35			C mFileName (string ) :: complete name of meta-file
36			C dFileName (string ) :: complete name of data-file
37			C simulName (string) :: name of this simulation
38	jmc	1.2	C titleLine (string) :: title or any descriptive comments
39	jmc	1.1	C filePrec (integer) :: number of bits per word in data-file (32 or 64)
40			C nDims (integer) :: number of dimensions
41			C dimList (integer) :: array of dimensions, etc.
42	jmc	1.2	C map2gl (integer) :: used for mapping tiled file to global file
43	jmc	1.1	C nFlds (integer) :: number of fields in "fldList"
44			C fldList (string) :: array of field names to write
45			C nTimRec (integer) :: number of time-specification in "timList"
46			C timList (real) :: array of time-specifications to write
47			C nrecords (integer) :: record number
48			C myIter (integer) :: time-step number
49			C myThid (integer) :: my Thread Id number
50			C
51			C !OUTPUT PARAMETERS:
52			C
53			CHARACTER() mFileName
54			CHARACTER() dFileName
55			CHARACTER() simulName
56			CHARACTER() titleLine
57			INTEGER filePrec
58			INTEGER nDims
59			INTEGER dimList(3,nDims)
60	jmc	1.2	INTEGER map2gl(2)
61	jmc	1.1	INTEGER nFlds
62			CHARACTER(8) fldList()
63			INTEGER nTimRec
64			_RL timList(*)
65			INTEGER nrecords
66			INTEGER myIter
67			INTEGER myThid
68			CEOP
69
70			C !FUNCTIONS
71			INTEGER ILNBLNK
72			EXTERNAL ILNBLNK
73
74			C !LOCAL VARIABLES:
75	jmc	1.4	INTEGER i,j,ii,iL
76	jmc	1.1	INTEGER mUnit
77			c LOGICAL exst
78			CHARACTER*(MAX_LEN_MBUF) msgBuf
79
80			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
81
82			C We should read the met-file IF it exists to check
83			C that the information we are writing is consistent
84			C with the current contents
85			c INQUIRE( file=mFileName, exist=exst )
86			C However, it is bloody difficult to parse files in fortran so someone
87			C else can do this.
88			C For now, we will assume everything is ok and that the last record
89			C is written to the last consecutive record in the file.
90
91			C- Assign a free unit number as the I/O channel for this subroutine
92			CALL MDSFINDUNIT( mUnit, myThid )
93
94			C- Open meta-file
95			OPEN( mUnit, file=mFileName, status='unknown',
96			& form='formatted' )
97
98			C- Write the simulation name
99			iL = ILNBLNK(simulName)
100			IF ( iL.GT.0 ) THEN
101			WRITE(mUnit,'(3A)') " simulation = { '",simulName(1:iL),"' };"
102			ENDIF
103
104			C- Write the number of dimensions
105			WRITE(mUnit,'(1X,A,I3,A)') 'nDims = [ ',nDims,' ];'
106
107			C- For each dimension, write the following:
108			C 1 global size (ie. the size of the global dimension of all files)
109			C 2 global start (ie. the global position of the start of this file)
110			C 3 global end (ie. the global position of the end of this file)
111
112	jmc	1.4	ii = 0
113			DO j=1,nDims
114			ii = MAX(dimList(1,j),ii)
115			ENDDO
116	jmc	1.1	WRITE(mUnit,'(1X,A)') 'dimList = ['
117	jmc	1.4	IF ( ii.LT.10000 ) THEN
118			C Small-size domain:
119			DO j=1,nDims
120			IF (j.LT.nDims) THEN
121			WRITE(mUnit,'(1X,3(I5,","))') (dimList(i,j),i=1,3)
122			ELSE
123			WRITE(mUnit,'(1X,2(I5,","),I5)') (dimList(i,j),i=1,3)
124			ENDIF
125			ENDDO
126			ELSE
127			C Large-size domain:
128			DO j=1,nDims
129			IF (j.LT.nDims) THEN
130			WRITE(mUnit,'(1X,3(I10,","))') (dimList(i,j),i=1,3)
131			ELSE
132			WRITE(mUnit,'(1X,2(I10,","),I10)') (dimList(i,j),i=1,3)
133			ENDIF
134			ENDDO
135			ENDIF
136	jmc	1.1	WRITE(mUnit,'(1X,A)') '];'
137	jmc	1.2	C- only write if different from default:
138			IF ( map2gl(1).NE.0 .OR. map2gl(2).NE.1 ) THEN
139			WRITE(mUnit,'(1X,2(A,I5),A)') 'map2glob = [ ',
140			& map2gl(1),',',map2gl(2),' ];'
141			ENDIF
142	jmc	1.1
143			C- Record the precision of the file
144			IF (filePrec .EQ. precFloat32) THEN
145			WRITE(mUnit,'(1X,A)') "dataprec = [ 'float32' ];"
146			ELSEIF (filePrec .EQ. precFloat64) THEN
147			WRITE(mUnit,'(1X,A)') "dataprec = [ 'float64' ];"
148			ELSE
149			WRITE(msgBuf,'(A)')
150			& ' MDSWRITEMETA: invalid filePrec'
151			CALL PRINT_ERROR( msgBuf, myThid )
152			STOP 'ABNORMAL END: S/R MDSWRITEMETA'
153			ENDIF
154
155			C- Record the current record number
156			C This is a proxy for the actual number of records in the file.
157			C If we could read the file then we could do this properly.
158			WRITE(mUnit,'(1X,A,I5,A)') 'nrecords = [ ',nrecords,' ];'
159
160			C- Record the file-name for the binary data
161			Cveto ii=ILNBLNK( dFileName )
162			Cveto WRITE(mUnit,'(1X,3A)') 'binarydatafile = [ ',dFileName(1:ii),' ];'
163
164			C- Write the integer time (integer iteration number) for later record
165			C keeping. If the timestep number is less than 0 then we assume
166			C that the information is superfluous and do not write it.
167			IF ( myIter.GE.0 )
168			& WRITE(mUnit,'(1X,A,I10,A)') 'timeStepNumber = [ ',myIter,' ];'
169
170			C- Write list of Time records
171			C note: format might change once we have a better idea of what will
172	jmc	1.2	C be the time-information to write.
173	jmc	1.1	C for now, comment out this line for rdmds (i.e.: between /* */)
174			IF ( nTimRec.GT.0 ) THEN
175			ii = MIN(nTimRec,20)
176			WRITE(msgBuf,'(1P20E20.12)') (timList(i),i=1,ii)
177			WRITE(mUnit,'(3A)')' /* modelTime = [', msgBuf(1:20ii),' ];/'
178			c iL = ILNBLNK(msgBuf)
179			c WRITE(mUnit,'(1X,3A)') 'modelTime = [', msgBuf(1:iL),' ];'
180			ENDIF
181
182			C- Write list of Fields
183			IF ( nFlds.GT.0 ) THEN
184			WRITE(mUnit,'(1X,A,I4,A)') 'nFlds = [ ', nFlds, ' ];'
185			WRITE(mUnit,'(1X,A)') 'fldList = {'
186			WRITE(mUnit,'(20(A2,A8,A1))')
187			& (" '",fldList(i),"'",i=1,nFlds)
188			WRITE(mUnit,'(1X,A)') '};'
189			ENDIF
190
191			C- Write title or comments (but ignored by rdmds)
192			iL = ILNBLNK(titleLine)
193			IF ( iL.GT.0 ) THEN
194			WRITE(mUnit,'(3A)')' /* ', titleLine(1:iL), ' */'
195			ENDIF
196
197			C- Close meta-file
198			CLOSE(mUnit)
199
200			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
201
202			RETURN
203			END