/[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.3 - (hide annotations) (download)
Sun Apr 6 00:01:55 2008 UTC (16 years, 2 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint60, checkpoint61, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i
Changes since 1.2: +1 -2 lines
do not reset "useCurrentDir" (forgot to delete this line from debugging stage)

1 jmc 1.3 C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_read_meta.F,v 1.2 2007/10/24 22:07:47 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     iL = ILNBLNK(fileName)
131     pL = ILNBLNK( mdsioLocalDir )
132     IF ( useCurrentDir .OR. pL.EQ.0 ) THEN
133     pfName = fileName
134     ELSE
135     WRITE(pfName,'(2A)') mdsioLocalDir(1:pL), fileName(1:iL)
136     ENDIF
137     pL = ILNBLNK( pfName )
138    
139     C-- Search for meta file:
140     C- look for meta-file = {fileName}
141     mFileName = fileName(1:iL)
142     iLm = iL
143     c INQUIRE( FILE=mFileName, EXIST=fileExist )
144     IF ( .NOT.fileExist ) THEN
145     C- look for meta-file = {fileName}'.meta'
146     WRITE(mFileName,'(2A)') fileName(1:iL), '.meta'
147     iLm = iL+5
148     INQUIRE( FILE=mFileName, EXIST=fileExist )
149     ENDIF
150     IF ( fileExist ) THEN
151     globalFile = .TRUE.
152     ELSE
153     C- look for meta-file = {fileName}'.{iG}.{jG}.meta'
154     iG = 1+(myXGlobalLo-1)/sNx
155     jG = 1+(myYGlobalLo-1)/sNy
156     WRITE(mFileName,'(2A,I3.3,A,I3.3,A)')
157     & pfName(1:pL),'.',iG,'.',jG,'.meta'
158     iLm = pL+8+5
159     INQUIRE( FILE=mFileName, EXIST=fileExist )
160     ENDIF
161     IF ( .NOT.fileExist ) THEN
162     C- look for meta-file = {fileName}'.001.001.meta'
163     WRITE(mFileName,'(2A,I3.3,A,I3.3,A)')
164     & pfName(1:pL),'.',1,'.',1,'.meta'
165     iLm = pL+8+5
166     INQUIRE( FILE=mFileName, EXIST=fileExist )
167     ENDIF
168     IF ( .NOT.fileExist ) THEN
169     WRITE(msgBuf,'(4A)') 'WARNING >> MDS_READ_META: file: ',
170     & fileName(1:iL), '.meta , ', mFileName(1:iLm)
171     c & fileName(1:iL), ' , ', mFileName(1:iLm)
172     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
173     & SQUEEZE_RIGHT , myThid )
174     WRITE(msgBuf,'(A)')
175     & 'WARNING >> MDS_READ_META: Files DO not exist'
176     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
177     & SQUEEZE_RIGHT , myThid )
178     nFldFil = -1
179     ELSE
180    
181     C-- File exist
182     IF ( debugLevel .GE. debLevA ) THEN
183     WRITE(msgBuf,'(2A)') ' MDS_READ_META: opening file: ',
184     & mFileName(1:iLm)
185     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
186     & SQUEEZE_RIGHT , myThid)
187     ENDIF
188    
189     C- Assign a free unit number as the I/O channel for this subroutine
190     CALL MDSFINDUNIT( mUnit, myThid )
191    
192     C- Open meta-file
193     OPEN( mUnit, FILE=mFileName, STATUS='old',
194     & FORM='formatted', IOSTAT=errIO )
195     c write(0,*) 'errIO=',errIO
196     IF ( errIO .NE. 0 ) THEN
197     WRITE(msgBuf,'(A,A)') 'MDS_READ_META: Unable to open file: ',
198     & mFileName(1:iLm)
199     CALL PRINT_ERROR( msgBuf , myThid )
200     STOP 'ABNORMAL END: S/R MDS_READ_META'
201     ENDIF
202    
203     C- Read the meta file in the same way as S/R OPEN_COPY_DATA_FILE
204     C (which seems to be works on many platforms):
205     DO WHILE ( .TRUE. )
206     READ( mUnit, FMT='(A)', END=1001 ) lineBuf
207     C-- Extract information from buffer: "lineBuf"
208     iL = ILNBLNK(lineBuf)
209    
210     C- Read simulation name (stored in file)
211     IF ( iL.GE.22 .AND. lineBuf(1:14).EQ.' simulation = ' ) THEN
212     ii = LEN(simulName)
213     c IF ( ii.LT.iL-21 ) print 'warning: truncate simulName'
214     ii = MIN(ii+17,iL-4)
215     simulName = lineBuf(18:ii)
216     iL = 0
217     ENDIF
218    
219     C- Read the number of dimensions
220     IF ( nDimFil.EQ.0 .AND.
221     & iL.GE.15 .AND. lineBuf(1:9).EQ.' nDims = ' ) THEN
222     READ(lineBuf(12:iL),'(I3)') nDimFil
223     IF ( nDimFil.GT.nDims .AND. nDims.GE.1 ) THEN
224     WRITE(msgBuf,'(2(A,I3),A)') ' MDS_READ_META: nDims=',
225     & nDimFil, ' too large ( >', nDims, ' )'
226     CALL PRINT_ERROR( msgBuf, myThid )
227     STOP 'ABNORMAL END: S/R MDS_READ_META'
228     ENDIF
229     iL = 0
230     ENDIF
231    
232     C- Read list of dimensions
233     IF ( nDims.GE.1 .AND. nDimFil.GE.1 .AND.
234     & iL.GE.11 .AND. lineBuf(1:11).EQ.' dimList = ' ) THEN
235     C- For each dimension, read the following:
236     C 1 global size (ie. the size of the global dimension of all files)
237     C 2 global start (ie. the global position of the start of this file)
238     C 3 global end (ie. the global position of the end of this file)
239 jmc 1.2 DO j=1,nDimFil
240     c READ( mUnit, FMT='(3(1X,I5))', ERR=1002, END=1002 )
241     c & (dimList(i,j),i=1,3)
242     C- This is to accomodate with the 2 versions of meta file:
243     READ( mUnit, FMT='(A)', END=1001 ) lineBuf
244     ii = IFNBLNK(lineBuf)
245     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     ELSE
251     C New version (S/R MDS_WRITE_META, file mdsio_write_meta.F):
252     C without starting blanks.
253     READ(lineBuf, FMT='(3(1X,I5))', ERR=1002, END=1002 )
254     & (dimList(i,j),i=1,3)
255     ENDIF
256 jmc 1.1 ENDDO
257     READ( mUnit, FMT='(A)', END=1001 ) lineBuf
258     iL = 0
259     ENDIF
260    
261     C- only write if different from default:
262     c IF ( map2gl(1).NE.0 .OR. map2gl(2).NE.1 ) THEN
263     c WRITE(mUnit,'(1X,2(A,I5),A)') 'map2glob = [ ',
264     c & map2gl(1),',',map2gl(2),' ];'
265     c ENDIF
266    
267     C- Read the precision of the file
268     IF ( iL.GE.20 .AND. lineBuf(1:12).EQ.' dataprec = ' ) THEN
269     IF ( lineBuf(16:22).EQ. 'float32' ) THEN
270     filePrec = precFloat32
271     ELSEIF ( lineBuf(16:22).EQ. 'float64' ) THEN
272     filePrec = precFloat64
273     ELSE
274     WRITE(msgBuf,'(A)') ' MDS_READ_META: invalid dataprec'
275     CALL PRINT_ERROR( msgBuf, myThid )
276     CALL PRINT_ERROR(lineBuf, myThid )
277     STOP 'ABNORMAL END: S/R MDS_READ_META'
278     ENDIF
279     iL = 0
280     ENDIF
281     C- Read (old format) precision of the file
282     IF ( filePrec.EQ.0 .AND.
283     & iL.GE.18 .AND. lineBuf(1:10).EQ.' format = ' ) THEN
284     IF ( lineBuf(14:20).EQ. 'float32' ) THEN
285     filePrec = precFloat32
286     ELSEIF ( lineBuf(14:20).EQ. 'float64' ) THEN
287     filePrec = precFloat64
288     ELSE
289     WRITE(msgBuf,'(A)') ' MDS_READ_META: invalid dataprec'
290     CALL PRINT_ERROR( msgBuf, myThid )
291     CALL PRINT_ERROR(lineBuf, myThid )
292     STOP 'ABNORMAL END: S/R MDS_READ_META'
293     ENDIF
294     iL = 0
295     ENDIF
296    
297     C- Read the number of records
298     IF ( nRecords.EQ.0 .AND.
299     & iL.GE.20 .AND. lineBuf(1:12).EQ.' nrecords = ' ) THEN
300     READ(lineBuf(15:iL),'(I5)') nRecords
301     iL = 0
302     ENDIF
303    
304     C- Read recorded iteration number
305     IF ( fileIter.EQ.0 .AND. iL.GE.31 .AND.
306     & lineBuf(1:18).EQ.' timeStepNumber = ' ) THEN
307     READ(lineBuf(21:iL),'(I10)') fileIter
308     iL = 0
309     ENDIF
310    
311     C- Read list of Time records
312     IF ( nTimFil.EQ.0 .AND.
313     & iL.GE.42 .AND. lineBuf(1:16).EQ.' /* modelTime = ' ) THEN
314     C note: format might change once we have a better idea of what will
315     C be the time-information to write.
316     C for now, comment out this line for rdmds (i.e.: between /* */)
317     nTimFil = INT((iL-17-5)/20)
318     IF ( nTimRec.GE.1 ) THEN
319     IF ( nTimFil.GT.nTimRec ) THEN
320     WRITE(msgBuf,'(2(A,I6),A)') ' MDS_READ_META: nTimRec=',
321     & nTimFil, ' too large ( >', nTimRec, ' )'
322     CALL PRINT_ERROR( msgBuf, myThid )
323     STOP 'ABNORMAL END: S/R MDS_READ_META'
324     ENDIF
325     READ(lineBuf(18:iL-5),'(1P20E20.12)',ERR=1003)
326     & (timList(i),i=1,nTimFil)
327     ENDIF
328     iL = 0
329     ELSEIF ( iL.GE.8 .AND. lineBuf(1:4).EQ.' /* ' ) THEN
330     IF ( lineBuf(iL-2:iL).EQ.' */' ) THEN
331     C- Read title or comments (ignored by rdmds)
332     ii = LEN(titleLine)
333     c IF ( ii.LT.iL-7 ) print 'warning: truncate titleLine'
334     ii = MIN(ii+4,iL-3)
335     titleLine = lineBuf(5:ii)
336     iL = 0
337     ENDIF
338     ENDIF
339    
340     C- Read number of Fields
341     IF ( nFldFil.EQ.0 .AND.
342     & iL.GE.16 .AND. lineBuf(1:9).EQ.' nFlds = ' ) THEN
343     READ(lineBuf(12:iL),'(I4)') nFldFil
344     IF ( nFldFil.GT.nFlds .AND. nFlds.GE.1 ) THEN
345     WRITE(msgBuf,'(2(A,I6),A)') ' MDS_READ_META: nFlds=',
346     & nFldFil, ' too large ( >', nFlds, ' )'
347     CALL PRINT_ERROR( msgBuf, myThid )
348     STOP 'ABNORMAL END: S/R MDS_READ_META'
349     ENDIF
350     iL = 0
351     ENDIF
352    
353     C- Read list of Fields
354     IF ( nFldFil.GE.1 .AND. nFlds.GE.1 .AND.
355     & iL.GE.11 .AND. lineBuf(1:11).EQ.' fldList = ' ) THEN
356 jmc 1.2 DO j=1,nFldFil,20
357 jmc 1.1 READ( mUnit, FMT='(20(2X,A8,1X))', ERR=1004, END=1004 )
358 jmc 1.2 & (fldList(i),i=j,MIN(nFldFil,j+19))
359 jmc 1.1 ENDDO
360     READ( mUnit, FMT='(A)', END=1001 ) lineBuf
361     iL = 0
362     ENDIF
363    
364     C-- End of reading file line per line
365     ENDDO
366     1004 CONTINUE
367     WRITE(msgBuf,'(2(A,I4),A)')
368     & ' MDS_READ_META: error reading Fields: nFlds=',
369 jmc 1.2 & nFldFil, ' , j=', j
370 jmc 1.1 CALL PRINT_ERROR( msgBuf, myThid )
371     STOP 'ABNORMAL END: S/R MDS_READ_META'
372     1003 CONTINUE
373     WRITE(msgBuf,'(2(A,I4),A)')
374     & ' MDS_READ_META: error reading Model-Time: nTimRec=',
375     & nTimFil, ' , iL=', iL
376     CALL PRINT_ERROR( msgBuf, myThid )
377     CALL PRINT_ERROR(lineBuf, myThid )
378     STOP 'ABNORMAL END: S/R MDS_READ_META'
379     1002 CONTINUE
380 jmc 1.2 WRITE(msgBuf,'(3(A,I3),A)')
381 jmc 1.1 & ' MDS_READ_META: error reading Dim-List: nDims=',
382 jmc 1.2 & nDimFil, ' , j=', j, ' , ii=', ii
383 jmc 1.1 CALL PRINT_ERROR( msgBuf, myThid )
384 jmc 1.2 CALL PRINT_ERROR(lineBuf, myThid )
385 jmc 1.1 STOP 'ABNORMAL END: S/R MDS_READ_META'
386     1001 CONTINUE
387    
388     C- Close meta-file
389     CLOSE(mUnit)
390    
391     C- end if block: file exist
392     ENDIF
393    
394     _END_MASTER( myThid )
395    
396     C- Update Arguments with values read from file
397     nDims = nDimFil
398     nFlds = nFldFil
399     nTimRec = nTimFil
400    
401     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
402    
403     RETURN
404     END

  ViewVC Help
Powered by ViewVC 1.1.22