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

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

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


Revision 1.5 - (hide annotations) (download)
Tue Jun 7 22:30:29 2011 UTC (12 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint63p, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint63, checkpoint62z
Changes since 1.4: +2 -2 lines
refine debugLevel criteria when printing messages

1 jmc 1.5 C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_read_meta.F,v 1.4 2009/05/29 16:05:41 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "MDSIO_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: MDS_READ_META
8     C !INTERFACE:
9     SUBROUTINE MDS_READ_META(
10     I fileName,
11     O simulName,
12     O titleLine,
13     O filePrec,
14     U nDims, nFlds, nTimRec,
15     O dimList, fldList, timList,
16     O nRecords, fileIter,
17     I useCurrentDir,
18     I myThid )
19    
20     C !DESCRIPTION: \bv
21     C *==========================================================*
22     C | S/R MDS_READ_META
23     C | o Read the content of 1 meta file
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     #include "PARAMS.h"
34    
35     C !INPUT PARAMETERS:
36     C fileName (string ) :: prefix of meta-file name
37     C nDims (integer) :: max size of array dimList (or =0 if not reading dimList)
38     C nFlds (integer) :: max size of array fldList (or =0 if not reading fldList)
39     C nTimRec (integer) :: max size of array timList (or =0 if not reading timList)
40     C useCurrentDir(logic):: always read from the current directory (even if
41     C "mdsioLocalDir" is set)
42     C myThid (integer) :: my Thread Id number
43     C
44     C !OUTPUT PARAMETERS:
45     C simulName (string) :: name of simulation (recorded in file)
46     C titleLine (string) :: title or any descriptive comments (in file)
47     C filePrec (integer) :: number of bits per word in data-file (32 or 64)
48     C nDims (integer) :: number of dimensions
49     C dimList (integer) :: array of dimensions
50     cC map2gl (integer) :: used for mapping tiled file to global file
51     C nFlds (integer) :: number of fields in "fldList"
52     C fldList (string) :: list of fields (names) stored in file
53     C nTimRec (integer) :: number of time-specification in "timList"
54     C timList (real) :: array of time-specifications (recorded in file)
55     C nRecords (integer) :: number of records
56     C fileIter (integer) :: time-step number (recorded in file)
57     C
58     CHARACTER*(*) fileName
59     CHARACTER*(*) simulName
60     CHARACTER*(*) titleLine
61     INTEGER filePrec
62     INTEGER nDims
63     INTEGER dimList(3,*)
64     c INTEGER map2gl(2)
65     INTEGER nFlds
66     CHARACTER*(8) fldList(*)
67     INTEGER nTimRec
68     _RL timList(*)
69     INTEGER nRecords
70     INTEGER fileIter
71     LOGICAL useCurrentDir
72     INTEGER myThid
73     CEOP
74    
75     C !FUNCTIONS
76 jmc 1.2 INTEGER IFNBLNK, ILNBLNK
77     EXTERNAL IFNBLNK, ILNBLNK
78 jmc 1.1
79     C !LOCAL VARIABLES:
80 jmc 1.4 C i, j :: loop indices
81     C ii,jj :: indices
82 jmc 1.2 C iG,jG :: global tile indices
83 jmc 1.1 C iL,pL,iLm :: length of character strings (temp. variables)
84     C nDimFil :: number of dimensions (in meta file)
85     C nFldFil :: number of fields in "fldList" (in meta file)
86     C nTimFil :: number of time-specification in "timList" (meta file)
87 jmc 1.4 INTEGER i,j,ii,jj
88 jmc 1.2 INTEGER iG,jG
89     INTEGER iL,pL,iLm
90 jmc 1.1 INTEGER mUnit, errIO
91     INTEGER nDimFil, nFldFil, nTimFil
92     LOGICAL fileExist, globalFile
93     CHARACTER*(MAX_LEN_MBUF) msgBuf
94     CHARACTER*(MAX_LEN_MBUF) lineBuf
95     CHARACTER*(MAX_LEN_FNAM) mFileName, pfName
96    
97     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
98    
99     C-- Initialise output arguments
100     simulName = ' '
101     titleLine = ' '
102     filePrec = 0
103     nRecords = 0
104     fileIter = 0
105     c map2gl(1) = 0
106     c map2gl(2) = 1
107 jmc 1.2 DO j=1,nDims
108     DO i=1,3
109     dimList(i,j) = 0
110 jmc 1.1 ENDDO
111     ENDDO
112     DO i=1,nFlds
113     fldList(i)= ' '
114     ENDDO
115     DO i=1,nTimRec
116     timList(i) = 0.
117     ENDDO
118     C-- Initialise Temp Var.
119     fileExist = .FALSE.
120     globalFile = .FALSE.
121     nDimFil = 0
122     nFldFil = 0
123     nTimFil = 0
124    
125     C-- Only Master thread check for file, open & read ; others will
126     C return null argument ; sharing output needs to be done outside
127     C this S/R, using, e.g., common block (+ Master_thread + Barrier)
128     _BEGIN_MASTER( myThid )
129    
130     C Assign special directory
131     iL = ILNBLNK(fileName)
132     pL = ILNBLNK( mdsioLocalDir )
133     IF ( useCurrentDir .OR. pL.EQ.0 ) THEN
134     pfName = fileName
135     ELSE
136     WRITE(pfName,'(2A)') mdsioLocalDir(1:pL), fileName(1:iL)
137     ENDIF
138     pL = ILNBLNK( pfName )
139    
140     C-- Search for meta file:
141     C- look for meta-file = {fileName}
142     mFileName = fileName(1:iL)
143     iLm = iL
144     c INQUIRE( FILE=mFileName, EXIST=fileExist )
145     IF ( .NOT.fileExist ) THEN
146     C- look for meta-file = {fileName}'.meta'
147     WRITE(mFileName,'(2A)') fileName(1:iL), '.meta'
148     iLm = iL+5
149     INQUIRE( FILE=mFileName, EXIST=fileExist )
150     ENDIF
151     IF ( fileExist ) THEN
152     globalFile = .TRUE.
153     ELSE
154     C- look for meta-file = {fileName}'.{iG}.{jG}.meta'
155     iG = 1+(myXGlobalLo-1)/sNx
156     jG = 1+(myYGlobalLo-1)/sNy
157     WRITE(mFileName,'(2A,I3.3,A,I3.3,A)')
158     & pfName(1:pL),'.',iG,'.',jG,'.meta'
159     iLm = pL+8+5
160     INQUIRE( FILE=mFileName, EXIST=fileExist )
161     ENDIF
162     IF ( .NOT.fileExist ) THEN
163     C- look for meta-file = {fileName}'.001.001.meta'
164     WRITE(mFileName,'(2A,I3.3,A,I3.3,A)')
165     & pfName(1:pL),'.',1,'.',1,'.meta'
166     iLm = pL+8+5
167     INQUIRE( FILE=mFileName, EXIST=fileExist )
168     ENDIF
169     IF ( .NOT.fileExist ) THEN
170     WRITE(msgBuf,'(4A)') 'WARNING >> MDS_READ_META: file: ',
171     & fileName(1:iL), '.meta , ', mFileName(1:iLm)
172     c & fileName(1:iL), ' , ', mFileName(1:iLm)
173     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
174     & SQUEEZE_RIGHT , myThid )
175     WRITE(msgBuf,'(A)')
176     & 'WARNING >> MDS_READ_META: Files DO not exist'
177     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
178     & SQUEEZE_RIGHT , myThid )
179     nFldFil = -1
180     ELSE
181    
182     C-- File exist
183 jmc 1.5 IF ( debugLevel .GE. debLevB ) THEN
184 jmc 1.1 WRITE(msgBuf,'(2A)') ' MDS_READ_META: opening file: ',
185     & mFileName(1:iLm)
186     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
187     & SQUEEZE_RIGHT , myThid)
188     ENDIF
189    
190     C- Assign a free unit number as the I/O channel for this subroutine
191     CALL MDSFINDUNIT( mUnit, myThid )
192    
193     C- Open meta-file
194     OPEN( mUnit, FILE=mFileName, STATUS='old',
195     & FORM='formatted', IOSTAT=errIO )
196     c write(0,*) 'errIO=',errIO
197     IF ( errIO .NE. 0 ) THEN
198     WRITE(msgBuf,'(A,A)') 'MDS_READ_META: Unable to open file: ',
199     & mFileName(1:iLm)
200     CALL PRINT_ERROR( msgBuf , myThid )
201     STOP 'ABNORMAL END: S/R MDS_READ_META'
202     ENDIF
203    
204     C- Read the meta file in the same way as S/R OPEN_COPY_DATA_FILE
205     C (which seems to be works on many platforms):
206     DO WHILE ( .TRUE. )
207     READ( mUnit, FMT='(A)', END=1001 ) lineBuf
208     C-- Extract information from buffer: "lineBuf"
209     iL = ILNBLNK(lineBuf)
210    
211     C- Read simulation name (stored in file)
212     IF ( iL.GE.22 .AND. lineBuf(1:14).EQ.' simulation = ' ) THEN
213     ii = LEN(simulName)
214     c IF ( ii.LT.iL-21 ) print 'warning: truncate simulName'
215     ii = MIN(ii+17,iL-4)
216     simulName = lineBuf(18:ii)
217     iL = 0
218     ENDIF
219    
220     C- Read the number of dimensions
221     IF ( nDimFil.EQ.0 .AND.
222     & iL.GE.15 .AND. lineBuf(1:9).EQ.' nDims = ' ) THEN
223     READ(lineBuf(12:iL),'(I3)') nDimFil
224     IF ( nDimFil.GT.nDims .AND. nDims.GE.1 ) THEN
225     WRITE(msgBuf,'(2(A,I3),A)') ' MDS_READ_META: nDims=',
226     & nDimFil, ' too large ( >', nDims, ' )'
227     CALL PRINT_ERROR( msgBuf, myThid )
228     STOP 'ABNORMAL END: S/R MDS_READ_META'
229     ENDIF
230     iL = 0
231     ENDIF
232    
233     C- Read list of dimensions
234     IF ( nDims.GE.1 .AND. nDimFil.GE.1 .AND.
235     & iL.GE.11 .AND. lineBuf(1:11).EQ.' dimList = ' ) THEN
236     C- For each dimension, read the following:
237     C 1 global size (ie. the size of the global dimension of all files)
238     C 2 global start (ie. the global position of the start of this file)
239     C 3 global end (ie. the global position of the end of this file)
240 jmc 1.2 DO j=1,nDimFil
241     C- This is to accomodate with the 2 versions of meta file:
242     READ( mUnit, FMT='(A)', END=1001 ) lineBuf
243     ii = IFNBLNK(lineBuf)
244 jmc 1.4 jj = ILNBLNK(lineBuf)
245 jmc 1.2 IF ( ii.GT.6 ) THEN
246     C Old version (S/R MDSWRITEMETA, file mdsio_writemeta.F):
247     C start each line with 10 blanks.
248     READ(lineBuf, FMT='(9X,3(1X,I5))', ERR=1002, END=1002 )
249     & (dimList(i,j),i=1,3)
250 jmc 1.4 ELSEIF ( jj.LT.30 ) THEN
251     C New version (S/R MDS_WRITE_META, file mdsio_write_meta.F):
252     C small-size domain without starting blanks.
253     READ(lineBuf, FMT='(3(1X,I5))', ERR=1002, END=1002 )
254     & (dimList(i,j),i=1,3)
255 jmc 1.2 ELSE
256     C New version (S/R MDS_WRITE_META, file mdsio_write_meta.F):
257 jmc 1.4 C large-size domain without starting blanks.
258     READ(lineBuf, FMT='(3(1X,I10))', ERR=1002, END=1002 )
259 jmc 1.2 & (dimList(i,j),i=1,3)
260     ENDIF
261 jmc 1.1 ENDDO
262     READ( mUnit, FMT='(A)', END=1001 ) lineBuf
263     iL = 0
264     ENDIF
265    
266     C- only write if different from default:
267     c IF ( map2gl(1).NE.0 .OR. map2gl(2).NE.1 ) THEN
268     c WRITE(mUnit,'(1X,2(A,I5),A)') 'map2glob = [ ',
269     c & map2gl(1),',',map2gl(2),' ];'
270     c ENDIF
271    
272     C- Read the precision of the file
273     IF ( iL.GE.20 .AND. lineBuf(1:12).EQ.' dataprec = ' ) THEN
274     IF ( lineBuf(16:22).EQ. 'float32' ) THEN
275     filePrec = precFloat32
276     ELSEIF ( lineBuf(16:22).EQ. 'float64' ) THEN
277     filePrec = precFloat64
278     ELSE
279     WRITE(msgBuf,'(A)') ' MDS_READ_META: invalid dataprec'
280     CALL PRINT_ERROR( msgBuf, myThid )
281     CALL PRINT_ERROR(lineBuf, myThid )
282     STOP 'ABNORMAL END: S/R MDS_READ_META'
283     ENDIF
284     iL = 0
285     ENDIF
286     C- Read (old format) precision of the file
287     IF ( filePrec.EQ.0 .AND.
288     & iL.GE.18 .AND. lineBuf(1:10).EQ.' format = ' ) THEN
289     IF ( lineBuf(14:20).EQ. 'float32' ) THEN
290     filePrec = precFloat32
291     ELSEIF ( lineBuf(14:20).EQ. 'float64' ) THEN
292     filePrec = precFloat64
293     ELSE
294     WRITE(msgBuf,'(A)') ' MDS_READ_META: invalid dataprec'
295     CALL PRINT_ERROR( msgBuf, myThid )
296     CALL PRINT_ERROR(lineBuf, myThid )
297     STOP 'ABNORMAL END: S/R MDS_READ_META'
298     ENDIF
299     iL = 0
300     ENDIF
301    
302     C- Read the number of records
303     IF ( nRecords.EQ.0 .AND.
304     & iL.GE.20 .AND. lineBuf(1:12).EQ.' nrecords = ' ) THEN
305     READ(lineBuf(15:iL),'(I5)') nRecords
306     iL = 0
307     ENDIF
308    
309     C- Read recorded iteration number
310     IF ( fileIter.EQ.0 .AND. iL.GE.31 .AND.
311     & lineBuf(1:18).EQ.' timeStepNumber = ' ) THEN
312     READ(lineBuf(21:iL),'(I10)') fileIter
313     iL = 0
314     ENDIF
315    
316     C- Read list of Time records
317     IF ( nTimFil.EQ.0 .AND.
318     & iL.GE.42 .AND. lineBuf(1:16).EQ.' /* modelTime = ' ) THEN
319     C note: format might change once we have a better idea of what will
320     C be the time-information to write.
321     C for now, comment out this line for rdmds (i.e.: between /* */)
322     nTimFil = INT((iL-17-5)/20)
323     IF ( nTimRec.GE.1 ) THEN
324     IF ( nTimFil.GT.nTimRec ) THEN
325     WRITE(msgBuf,'(2(A,I6),A)') ' MDS_READ_META: nTimRec=',
326     & nTimFil, ' too large ( >', nTimRec, ' )'
327     CALL PRINT_ERROR( msgBuf, myThid )
328     STOP 'ABNORMAL END: S/R MDS_READ_META'
329     ENDIF
330     READ(lineBuf(18:iL-5),'(1P20E20.12)',ERR=1003)
331     & (timList(i),i=1,nTimFil)
332     ENDIF
333     iL = 0
334     ELSEIF ( iL.GE.8 .AND. lineBuf(1:4).EQ.' /* ' ) THEN
335     IF ( lineBuf(iL-2:iL).EQ.' */' ) THEN
336     C- Read title or comments (ignored by rdmds)
337     ii = LEN(titleLine)
338     c IF ( ii.LT.iL-7 ) print 'warning: truncate titleLine'
339     ii = MIN(ii+4,iL-3)
340     titleLine = lineBuf(5:ii)
341     iL = 0
342     ENDIF
343     ENDIF
344    
345     C- Read number of Fields
346     IF ( nFldFil.EQ.0 .AND.
347     & iL.GE.16 .AND. lineBuf(1:9).EQ.' nFlds = ' ) THEN
348     READ(lineBuf(12:iL),'(I4)') nFldFil
349     IF ( nFldFil.GT.nFlds .AND. nFlds.GE.1 ) THEN
350     WRITE(msgBuf,'(2(A,I6),A)') ' MDS_READ_META: nFlds=',
351     & nFldFil, ' too large ( >', nFlds, ' )'
352     CALL PRINT_ERROR( msgBuf, myThid )
353     STOP 'ABNORMAL END: S/R MDS_READ_META'
354     ENDIF
355     iL = 0
356     ENDIF
357    
358     C- Read list of Fields
359     IF ( nFldFil.GE.1 .AND. nFlds.GE.1 .AND.
360     & iL.GE.11 .AND. lineBuf(1:11).EQ.' fldList = ' ) THEN
361 jmc 1.2 DO j=1,nFldFil,20
362 jmc 1.1 READ( mUnit, FMT='(20(2X,A8,1X))', ERR=1004, END=1004 )
363 jmc 1.2 & (fldList(i),i=j,MIN(nFldFil,j+19))
364 jmc 1.1 ENDDO
365     READ( mUnit, FMT='(A)', END=1001 ) lineBuf
366     iL = 0
367     ENDIF
368    
369     C-- End of reading file line per line
370     ENDDO
371     1004 CONTINUE
372     WRITE(msgBuf,'(2(A,I4),A)')
373     & ' MDS_READ_META: error reading Fields: nFlds=',
374 jmc 1.2 & nFldFil, ' , j=', j
375 jmc 1.1 CALL PRINT_ERROR( msgBuf, myThid )
376     STOP 'ABNORMAL END: S/R MDS_READ_META'
377     1003 CONTINUE
378     WRITE(msgBuf,'(2(A,I4),A)')
379     & ' MDS_READ_META: error reading Model-Time: nTimRec=',
380     & nTimFil, ' , iL=', iL
381     CALL PRINT_ERROR( msgBuf, myThid )
382     CALL PRINT_ERROR(lineBuf, myThid )
383     STOP 'ABNORMAL END: S/R MDS_READ_META'
384     1002 CONTINUE
385 jmc 1.2 WRITE(msgBuf,'(3(A,I3),A)')
386 jmc 1.1 & ' MDS_READ_META: error reading Dim-List: nDims=',
387 jmc 1.2 & nDimFil, ' , j=', j, ' , ii=', ii
388 jmc 1.1 CALL PRINT_ERROR( msgBuf, myThid )
389 jmc 1.2 CALL PRINT_ERROR(lineBuf, myThid )
390 jmc 1.1 STOP 'ABNORMAL END: S/R MDS_READ_META'
391     1001 CONTINUE
392    
393     C- Close meta-file
394     CLOSE(mUnit)
395    
396     C- end if block: file exist
397     ENDIF
398    
399     _END_MASTER( myThid )
400    
401     C- Update Arguments with values read from file
402     nDims = nDimFil
403     nFlds = nFldFil
404     nTimRec = nTimFil
405    
406     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
407    
408     RETURN
409     END

  ViewVC Help
Powered by ViewVC 1.1.22