/[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.2 - (hide annotations) (download)
Wed Oct 24 22:07:47 2007 UTC (16 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59k, checkpoint59j
Changes since 1.1: +34 -16 lines
Thanks to Constantinos who set up all those daily testing,
was able to catch this one: enable reading olf meta file format
(even with a picky g95 compiler)

1 jmc 1.2 C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_read_meta.F,v 1.1 2007/10/22 13:16:29 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.2 C i,j,ii :: loop indices
81     C iG,jG :: global tile indices
82 jmc 1.1 C iL,pL,iLm :: length of character strings (temp. variables)
83     C nDimFil :: number of dimensions (in meta file)
84     C nFldFil :: number of fields in "fldList" (in meta file)
85     C nTimFil :: number of time-specification in "timList" (meta file)
86 jmc 1.2 INTEGER i,j,ii
87     INTEGER iG,jG
88     INTEGER iL,pL,iLm
89 jmc 1.1 INTEGER mUnit, errIO
90     INTEGER nDimFil, nFldFil, nTimFil
91     LOGICAL fileExist, globalFile
92     CHARACTER*(MAX_LEN_MBUF) msgBuf
93     CHARACTER*(MAX_LEN_MBUF) lineBuf
94     CHARACTER*(MAX_LEN_FNAM) mFileName, pfName
95    
96     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
97    
98     C-- Initialise output arguments
99     simulName = ' '
100     titleLine = ' '
101     filePrec = 0
102     nRecords = 0
103     fileIter = 0
104     c map2gl(1) = 0
105     c map2gl(2) = 1
106 jmc 1.2 DO j=1,nDims
107     DO i=1,3
108     dimList(i,j) = 0
109 jmc 1.1 ENDDO
110     ENDDO
111     DO i=1,nFlds
112     fldList(i)= ' '
113     ENDDO
114     DO i=1,nTimRec
115     timList(i) = 0.
116     ENDDO
117     C-- Initialise Temp Var.
118     fileExist = .FALSE.
119     globalFile = .FALSE.
120     nDimFil = 0
121     nFldFil = 0
122     nTimFil = 0
123    
124     C-- Only Master thread check for file, open & read ; others will
125     C return null argument ; sharing output needs to be done outside
126     C this S/R, using, e.g., common block (+ Master_thread + Barrier)
127     _BEGIN_MASTER( myThid )
128    
129     C Assign special directory
130     useCurrentDir = .FALSE.
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     IF ( debugLevel .GE. debLevA ) THEN
184     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 READ( mUnit, FMT='(3(1X,I5))', ERR=1002, END=1002 )
242     c & (dimList(i,j),i=1,3)
243     C- This is to accomodate with the 2 versions of meta file:
244     READ( mUnit, FMT='(A)', END=1001 ) lineBuf
245     ii = IFNBLNK(lineBuf)
246     IF ( ii.GT.6 ) THEN
247     C Old version (S/R MDSWRITEMETA, file mdsio_writemeta.F):
248     C start each line with 10 blanks.
249     READ(lineBuf, FMT='(9X,3(1X,I5))', ERR=1002, END=1002 )
250     & (dimList(i,j),i=1,3)
251     ELSE
252     C New version (S/R MDS_WRITE_META, file mdsio_write_meta.F):
253     C without starting blanks.
254     READ(lineBuf, FMT='(3(1X,I5))', ERR=1002, END=1002 )
255     & (dimList(i,j),i=1,3)
256     ENDIF
257 jmc 1.1 ENDDO
258     READ( mUnit, FMT='(A)', END=1001 ) lineBuf
259     iL = 0
260     ENDIF
261    
262     C- only write if different from default:
263     c IF ( map2gl(1).NE.0 .OR. map2gl(2).NE.1 ) THEN
264     c WRITE(mUnit,'(1X,2(A,I5),A)') 'map2glob = [ ',
265     c & map2gl(1),',',map2gl(2),' ];'
266     c ENDIF
267    
268     C- Read the precision of the file
269     IF ( iL.GE.20 .AND. lineBuf(1:12).EQ.' dataprec = ' ) THEN
270     IF ( lineBuf(16:22).EQ. 'float32' ) THEN
271     filePrec = precFloat32
272     ELSEIF ( lineBuf(16:22).EQ. 'float64' ) THEN
273     filePrec = precFloat64
274     ELSE
275     WRITE(msgBuf,'(A)') ' MDS_READ_META: invalid dataprec'
276     CALL PRINT_ERROR( msgBuf, myThid )
277     CALL PRINT_ERROR(lineBuf, myThid )
278     STOP 'ABNORMAL END: S/R MDS_READ_META'
279     ENDIF
280     iL = 0
281     ENDIF
282     C- Read (old format) precision of the file
283     IF ( filePrec.EQ.0 .AND.
284     & iL.GE.18 .AND. lineBuf(1:10).EQ.' format = ' ) THEN
285     IF ( lineBuf(14:20).EQ. 'float32' ) THEN
286     filePrec = precFloat32
287     ELSEIF ( lineBuf(14:20).EQ. 'float64' ) THEN
288     filePrec = precFloat64
289     ELSE
290     WRITE(msgBuf,'(A)') ' MDS_READ_META: invalid dataprec'
291     CALL PRINT_ERROR( msgBuf, myThid )
292     CALL PRINT_ERROR(lineBuf, myThid )
293     STOP 'ABNORMAL END: S/R MDS_READ_META'
294     ENDIF
295     iL = 0
296     ENDIF
297    
298     C- Read the number of records
299     IF ( nRecords.EQ.0 .AND.
300     & iL.GE.20 .AND. lineBuf(1:12).EQ.' nrecords = ' ) THEN
301     READ(lineBuf(15:iL),'(I5)') nRecords
302     iL = 0
303     ENDIF
304    
305     C- Read recorded iteration number
306     IF ( fileIter.EQ.0 .AND. iL.GE.31 .AND.
307     & lineBuf(1:18).EQ.' timeStepNumber = ' ) THEN
308     READ(lineBuf(21:iL),'(I10)') fileIter
309     iL = 0
310     ENDIF
311    
312     C- Read list of Time records
313     IF ( nTimFil.EQ.0 .AND.
314     & iL.GE.42 .AND. lineBuf(1:16).EQ.' /* modelTime = ' ) THEN
315     C note: format might change once we have a better idea of what will
316     C be the time-information to write.
317     C for now, comment out this line for rdmds (i.e.: between /* */)
318     nTimFil = INT((iL-17-5)/20)
319     IF ( nTimRec.GE.1 ) THEN
320     IF ( nTimFil.GT.nTimRec ) THEN
321     WRITE(msgBuf,'(2(A,I6),A)') ' MDS_READ_META: nTimRec=',
322     & nTimFil, ' too large ( >', nTimRec, ' )'
323     CALL PRINT_ERROR( msgBuf, myThid )
324     STOP 'ABNORMAL END: S/R MDS_READ_META'
325     ENDIF
326     READ(lineBuf(18:iL-5),'(1P20E20.12)',ERR=1003)
327     & (timList(i),i=1,nTimFil)
328     ENDIF
329     iL = 0
330     ELSEIF ( iL.GE.8 .AND. lineBuf(1:4).EQ.' /* ' ) THEN
331     IF ( lineBuf(iL-2:iL).EQ.' */' ) THEN
332     C- Read title or comments (ignored by rdmds)
333     ii = LEN(titleLine)
334     c IF ( ii.LT.iL-7 ) print 'warning: truncate titleLine'
335     ii = MIN(ii+4,iL-3)
336     titleLine = lineBuf(5:ii)
337     iL = 0
338     ENDIF
339     ENDIF
340    
341     C- Read number of Fields
342     IF ( nFldFil.EQ.0 .AND.
343     & iL.GE.16 .AND. lineBuf(1:9).EQ.' nFlds = ' ) THEN
344     READ(lineBuf(12:iL),'(I4)') nFldFil
345     IF ( nFldFil.GT.nFlds .AND. nFlds.GE.1 ) THEN
346     WRITE(msgBuf,'(2(A,I6),A)') ' MDS_READ_META: nFlds=',
347     & nFldFil, ' too large ( >', nFlds, ' )'
348     CALL PRINT_ERROR( msgBuf, myThid )
349     STOP 'ABNORMAL END: S/R MDS_READ_META'
350     ENDIF
351     iL = 0
352     ENDIF
353    
354     C- Read list of Fields
355     IF ( nFldFil.GE.1 .AND. nFlds.GE.1 .AND.
356     & iL.GE.11 .AND. lineBuf(1:11).EQ.' fldList = ' ) THEN
357 jmc 1.2 DO j=1,nFldFil,20
358 jmc 1.1 READ( mUnit, FMT='(20(2X,A8,1X))', ERR=1004, END=1004 )
359 jmc 1.2 & (fldList(i),i=j,MIN(nFldFil,j+19))
360 jmc 1.1 ENDDO
361     READ( mUnit, FMT='(A)', END=1001 ) lineBuf
362     iL = 0
363     ENDIF
364    
365     C-- End of reading file line per line
366     ENDDO
367     1004 CONTINUE
368     WRITE(msgBuf,'(2(A,I4),A)')
369     & ' MDS_READ_META: error reading Fields: nFlds=',
370 jmc 1.2 & nFldFil, ' , j=', j
371 jmc 1.1 CALL PRINT_ERROR( msgBuf, myThid )
372     STOP 'ABNORMAL END: S/R MDS_READ_META'
373     1003 CONTINUE
374     WRITE(msgBuf,'(2(A,I4),A)')
375     & ' MDS_READ_META: error reading Model-Time: nTimRec=',
376     & nTimFil, ' , iL=', iL
377     CALL PRINT_ERROR( msgBuf, myThid )
378     CALL PRINT_ERROR(lineBuf, myThid )
379     STOP 'ABNORMAL END: S/R MDS_READ_META'
380     1002 CONTINUE
381 jmc 1.2 WRITE(msgBuf,'(3(A,I3),A)')
382 jmc 1.1 & ' MDS_READ_META: error reading Dim-List: nDims=',
383 jmc 1.2 & nDimFil, ' , j=', j, ' , ii=', ii
384 jmc 1.1 CALL PRINT_ERROR( msgBuf, myThid )
385 jmc 1.2 CALL PRINT_ERROR(lineBuf, myThid )
386 jmc 1.1 STOP 'ABNORMAL END: S/R MDS_READ_META'
387     1001 CONTINUE
388    
389     C- Close meta-file
390     CLOSE(mUnit)
391    
392     C- end if block: file exist
393     ENDIF
394    
395     _END_MASTER( myThid )
396    
397     C- Update Arguments with values read from file
398     nDims = nDimFil
399     nFlds = nFldFil
400     nTimRec = nTimFil
401    
402     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
403    
404     RETURN
405     END

  ViewVC Help
Powered by ViewVC 1.1.22