/[MITgcm]/MITgcm/pkg/mdsio/mdsio_write_meta.F
ViewVC logotype

Annotation of /MITgcm/pkg/mdsio/mdsio_write_meta.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.6 - (hide annotations) (download)
Sun Jan 13 22:42:26 2013 UTC (12 years, 5 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64c, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint65, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, HEAD
Changes since 1.5: +10 -4 lines 
- write missing value (corresponding to undefined array value) to meta files;
  skip this if missing value is one (UNSET_RL would be a better value for the
  case of undefined missing value but it's current the default missing-value);
1 jmc 1.6 C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_write_meta.F,v 1.5 2010/01/07 23:41:35 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 jmc 1.6 I nTimRec, timList, misVal,
18 jmc 1.1 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 jmc 1.6 C misVal (real) :: missing value (ignored if = 1.)
48 jmc 1.1 C nrecords (integer) :: record number
49     C myIter (integer) :: time-step number
50     C myThid (integer) :: my Thread Id number
51     C
52     C !OUTPUT PARAMETERS:
53     C
54     CHARACTER*(*) mFileName
55     CHARACTER*(*) dFileName
56     CHARACTER*(*) simulName
57     CHARACTER*(*) titleLine
58     INTEGER filePrec
59     INTEGER nDims
60     INTEGER dimList(3,nDims)
61 jmc 1.2 INTEGER map2gl(2)
62 jmc 1.1 INTEGER nFlds
63     CHARACTER*(8) fldList(*)
64     INTEGER nTimRec
65     _RL timList(*)
66 jmc 1.6 _RL misVal
67 jmc 1.1 INTEGER nrecords
68     INTEGER myIter
69     INTEGER myThid
70     CEOP
71    
72     C !FUNCTIONS
73     INTEGER ILNBLNK
74     EXTERNAL ILNBLNK
75    
76     C !LOCAL VARIABLES:
77 jmc 1.4 INTEGER i,j,ii,iL
78 jmc 1.1 INTEGER mUnit
79     c LOGICAL exst
80     CHARACTER*(MAX_LEN_MBUF) msgBuf
81    
82     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
83    
84     C We should *read* the met-file IF it exists to check
85     C that the information we are writing is consistent
86     C with the current contents
87     c INQUIRE( file=mFileName, exist=exst )
88     C However, it is bloody difficult to parse files in fortran so someone
89     C else can do this.
90     C For now, we will assume everything is ok and that the last record
91     C is written to the last consecutive record in the file.
92    
93     C- Assign a free unit number as the I/O channel for this subroutine
94     CALL MDSFINDUNIT( mUnit, myThid )
95    
96     C- Open meta-file
97     OPEN( mUnit, file=mFileName, status='unknown',
98     & form='formatted' )
99    
100     C- Write the simulation name
101     iL = ILNBLNK(simulName)
102     IF ( iL.GT.0 ) THEN
103     WRITE(mUnit,'(3A)') " simulation = { '",simulName(1:iL),"' };"
104     ENDIF
105    
106     C- Write the number of dimensions
107     WRITE(mUnit,'(1X,A,I3,A)') 'nDims = [ ',nDims,' ];'
108    
109     C- For each dimension, write the following:
110     C 1 global size (ie. the size of the global dimension of all files)
111     C 2 global start (ie. the global position of the start of this file)
112     C 3 global end (ie. the global position of the end of this file)
113    
114 jmc 1.4 ii = 0
115     DO j=1,nDims
116     ii = MAX(dimList(1,j),ii)
117     ENDDO
118 jmc 1.1 WRITE(mUnit,'(1X,A)') 'dimList = ['
119 jmc 1.4 IF ( ii.LT.10000 ) THEN
120     C Small-size domain:
121     DO j=1,nDims
122     IF (j.LT.nDims) THEN
123     WRITE(mUnit,'(1X,3(I5,","))') (dimList(i,j),i=1,3)
124     ELSE
125     WRITE(mUnit,'(1X,2(I5,","),I5)') (dimList(i,j),i=1,3)
126     ENDIF
127     ENDDO
128     ELSE
129     C Large-size domain:
130     DO j=1,nDims
131     IF (j.LT.nDims) THEN
132     WRITE(mUnit,'(1X,3(I10,","))') (dimList(i,j),i=1,3)
133     ELSE
134     WRITE(mUnit,'(1X,2(I10,","),I10)') (dimList(i,j),i=1,3)
135     ENDIF
136     ENDDO
137     ENDIF
138 jmc 1.1 WRITE(mUnit,'(1X,A)') '];'
139 jmc 1.2 C- only write if different from default:
140     IF ( map2gl(1).NE.0 .OR. map2gl(2).NE.1 ) THEN
141     WRITE(mUnit,'(1X,2(A,I5),A)') 'map2glob = [ ',
142     & map2gl(1),',',map2gl(2),' ];'
143     ENDIF
144 jmc 1.1
145     C- Record the precision of the file
146     IF (filePrec .EQ. precFloat32) THEN
147     WRITE(mUnit,'(1X,A)') "dataprec = [ 'float32' ];"
148     ELSEIF (filePrec .EQ. precFloat64) THEN
149     WRITE(mUnit,'(1X,A)') "dataprec = [ 'float64' ];"
150     ELSE
151     WRITE(msgBuf,'(A)')
152     & ' MDSWRITEMETA: invalid filePrec'
153     CALL PRINT_ERROR( msgBuf, myThid )
154     STOP 'ABNORMAL END: S/R MDSWRITEMETA'
155     ENDIF
156    
157     C- Record the current record number
158     C This is a proxy for the actual number of records in the file.
159     C If we could read the file then we could do this properly.
160     WRITE(mUnit,'(1X,A,I5,A)') 'nrecords = [ ',nrecords,' ];'
161    
162     C- Record the file-name for the binary data
163     Cveto ii=ILNBLNK( dFileName )
164     Cveto WRITE(mUnit,'(1X,3A)') 'binarydatafile = [ ',dFileName(1:ii),' ];'
165    
166     C- Write the integer time (integer iteration number) for later record
167     C keeping. If the timestep number is less than 0 then we assume
168     C that the information is superfluous and do not write it.
169     IF ( myIter.GE.0 )
170     & WRITE(mUnit,'(1X,A,I10,A)') 'timeStepNumber = [ ',myIter,' ];'
171    
172     C- Write list of Time records
173     C note: format might change once we have a better idea of what will
174 jmc 1.2 C be the time-information to write.
175 jmc 1.1 IF ( nTimRec.GT.0 ) THEN
176     ii = MIN(nTimRec,20)
177     WRITE(msgBuf,'(1P20E20.12)') (timList(i),i=1,ii)
178 jmc 1.5 WRITE(mUnit,'(1X,3A)') 'timeInterval = [', msgBuf(1:20*ii),' ];'
179 jmc 1.1 ENDIF
180    
181 jmc 1.6 C- Write missing value
182     IF ( misVal.NE.oneRL ) THEN
183     WRITE(mUnit,'(1X,A,1PE21.14,A)')
184     & 'missingValue = [ ',misVal,' ];'
185     ENDIF
186    
187 jmc 1.1 C- Write list of Fields
188     IF ( nFlds.GT.0 ) THEN
189     WRITE(mUnit,'(1X,A,I4,A)') 'nFlds = [ ', nFlds, ' ];'
190     WRITE(mUnit,'(1X,A)') 'fldList = {'
191     WRITE(mUnit,'(20(A2,A8,A1))')
192     & (" '",fldList(i),"'",i=1,nFlds)
193     WRITE(mUnit,'(1X,A)') '};'
194     ENDIF
195    
196     C- Write title or comments (but ignored by rdmds)
197     iL = ILNBLNK(titleLine)
198     IF ( iL.GT.0 ) THEN
199     WRITE(mUnit,'(3A)')' /* ', titleLine(1:iL), ' */'
200     ENDIF
201    
202     C- Close meta-file
203     CLOSE(mUnit)
204    
205     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
206    
207     RETURN
208     END
  ViewVC Help
Powered by ViewVC 1.1.22