/[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.1 - (hide annotations) (download)
Mon Oct 22 13:16:29 2007 UTC (16 years, 7 months ago) by jmc
Branch: MAIN
new S/R to read 1 meta file

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

  ViewVC Help
Powered by ViewVC 1.1.22