/[MITgcm]/MITgcm/eesupp/src/dfile.F
ViewVC logotype

Annotation of /MITgcm/eesupp/src/dfile.F

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

Revision 1.5 - (hide annotations) (download)
Mon Jun 22 16:24:51 1998 UTC (26 years ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint9
Changes since 1.4: +35 -19 lines 
o General tidy-up.
o MPI fix. Filename changes (meta/data). salbin*y stuff.
o SST.bin SSS.bin added to verification/exp2
1 adcroft 1.5 C $Header: /u/gcmpack/models/MITgcmUV/eesupp/src/dfile.F,v 1.3.2.1 1998/06/20 21:04:58 cnh Exp $
2 cnh 1.1
3     #include "CPP_EEOPTIONS.h"
4    
5     C-- File dfile.F: Routines that handle actual I/O
6     C-- to model "dump" files.
7     C-- These low-level routines could be replaced
8     C-- by platform/environment specific C or
9     C-- MPI-2 routines one day! In some situations the
10     C-- functionality of these low-level routines is
11     C-- encompassed by the data handling package. For
12     C-- example netCDF provides primitive that are
13     C-- higher level
14     C-- Contents
15     C-- DFILE_CLOSE - Closes dump file
16     C-- DFILE_INIT - Initialisation procedure for subsequent DFILE
17     C data-structures. Only called once per run.
18     C-- DFILE_OPEN - Opens dump file
19     C-- DFILE_READ_R8 - Reads from a dump file
20     C-- DFILE_READ_R4 - Reads from a dump file
21     C-- DFILE_SET_RO - Sets new connections to be read-only
22     C-- DFILE_SET_RW - Sets new connections to be read-write
23     C-- DFILE_SET_STOP_ON_ERROR - Sets new connections to STOP on error
24     C-- DFILE_SET_CONT_ON_ERROR - Sets new connections to continue
25     C on error
26     C-- DFILE_WRITE_R4 - Writes to a dump file
27     C-- DFILE_WRITE_R8 - Writes to a dump file
28     C
29     C Notes:
30     C ======
31     C The default behaviour is for the model to stop if an
32     C input errors occur but to continue if output errors occur.
33     C However, this policy is not enforced in these low-level routines.
34     C Instead these routines are coded to allow either continue
35     C on error or stop on error. Which action is taken
36     C is controlled via a mode flag which is set from the higher
37     C level calls to these routines. A mode flag is also used to
38     C control whether the DFILE_OPEN routine opens a file in
39     C read-write or read-only mode. On some systems this is necessary
40     C as the default is read-write and will fail for read-only files or
41     C file systems. Other systems don't support the OPEN(...='READ_ONLY')
42     C so this feature may need to be switched on or off as appropriate.
43     C The DFILE_SET routines provide this mechanism. They work by setting
44     C a "context" flag which is applied to IO ahndles when the DFILE_OPEN
45     C call is made. IO handles that are already open are not affected by
46     C subsequent calls to DFILE_SET routines.
47    
48     SUBROUTINE DFILE_CLOSE(
49     I fileHandle, myThid)
50     C /==========================================================\
51     C | SUBROUTINE DFILE_CLOSE |
52     C | o Close model "dump" file. |
53     C |==========================================================|
54     C | Controlling routine for doing actual I/O operations. |
55     C | Close the file referred to by handle fielHandle. |
56     C \==========================================================/
57    
58     C == Global variables ==
59     #include "SIZE.h"
60     #include "EEPARAMS.h"
61     #include "EESUPPORT.h"
62     #include "DFILE.h"
63    
64     C == Routine arguments ==
65     INTEGER myThid
66     INTEGER fileHandle
67    
68     C == Local variables ==
69     C msgBuf - Error message buffer
70     C I - Work variables
71     C dUnit Data unit
72     C mUnit Meta data unit
73     C eMode Error mode
74     CHARACTER*(MAX_LEN_MBUF) msgBuf
75     INTEGER I
76     INTEGER dUnit
77     INTEGER mUnit
78     INTEGER eMode
79    
80     I = fileHandle
81    
82     C-- Check that the fileHandle passed in is open
83     IF ( unitStatus(I,myThid) .NE. busyUnit ) GOTO 1000
84    
85     unitStatus(I,myThid) = freeUnit
86     dUnit = dUnitNumber(I,myThid)
87     mUnit = mUnitNumber(I,myThid)
88     eMode = errorMode(I,myThid)
89     CLOSE(dUnit,ERR=999)
90     CLOSE(mUnit,ERR=999)
91    
92     1000 CONTINUE
93     RETURN
94     999 CONTINUE
95     WRITE(msgBuf,'(A)') ' S/R DFILE_CLOSE'
96     CALL PRINT_ERROR( msgBuf , 1)
97     WRITE(msgBuf,'(A,A)') ' Thread ', myThid,' Close file failed'
98     CALL PRINT_ERROR( msgBuf , 1)
99     IF ( eMode .EQ. errorModeSTOP ) THEN
100     STOP 'ABNORMAL END: S/R DFILE_CLOSE'
101     ENDIF
102     ioErrorCount(myThid) = ioErrorCount(myThid)+1
103     GOTO 1000
104    
105     END
106    
107     SUBROUTINE DFILE_INIT
108     C /==========================================================\
109     C | SUBROUTINE DFILE_INIT |
110     C | o Model "dump" file initialisation procedure |
111     C |==========================================================|
112     C | Initalises data structures used by MITgcmUV "dump file" |
113     C | procedures. |
114     C | As coded this routine sets the unit number used for |
115     C | dump file IO. Two numbers are used one for data and one |
116     C | for meta data. It is possible to use more unit numbers |
117     C | and/or have different unit numbers per thread. This is |
118     C | not done here. |
119     C \==========================================================/
120    
121     C == Global variables ==
122     #include "SIZE.h"
123     #include "EEPARAMS.h"
124     #include "DFILE.h"
125    
126     C == Local variables ==
127     C I, J - Loop counters
128     INTEGER I, J
129    
130     DO j=1,MAX_NO_THREADS
131     DO i=1,ioUnitsPerThread
132     mUnitNumber(i,j) = 20+i*2-1
133     dUnitNumber(i,j) = 20+i*2
134     unitStatus (i,j) = freeUnit
135     metaDataStatus(i,j) = metaDataNotWritten
136     ENDDO
137     ENDDO
138    
139     C-- Set initial access and error modes
140     CALL DFILE_SET_RW
141     CALL DFILE_SET_STOP_ON_ERROR
142    
143     RETURN
144     END
145    
146     SUBROUTINE DFILE_OPEN(
147     I fNam, fNamMeta, myThid,
148     O fileHandle)
149     C /==========================================================\
150     C | SUBROUTINE DFILE_OPEN |
151     C | o Open model "dump" file. |
152     C |==========================================================|
153     C | Controlling routine for doing actual I/O operations. |
154     C | Routine returns a handle to the caller that can be used |
155     C | in subsequent read and write operations. |
156     C \==========================================================/
157    
158     C == Global variables ==
159     #include "SIZE.h"
160     #include "EEPARAMS.h"
161     #include "EESUPPORT.h"
162     #include "DFILE.h"
163    
164     INTEGER IFNBLNK
165     EXTERNAL IFNBLNK
166     INTEGER ILNBLNK
167     EXTERNAL ILNBLNK
168    
169     C == Routine arguments ==
170     CHARACTER*(*) fNam
171     CHARACTER*(*) fNamMeta
172     INTEGER myThid
173     INTEGER fileHandle
174    
175     C == Local variables ==
176     C msgBuf - Error message buffer
177     C dUnit - Unit number for data
178     C mUnit - Unit number for meta data
179     C eMode - Error mode
180     C aMode - Access mode
181     C I - Loop counters
182     INTEGER dUnit
183     INTEGER mUnit
184     INTEGER eMode
185     INTEGER aMode
186     CHARACTER*(MAX_LEN_MBUF) msgBuf
187     INTEGER I
188     INTEGER i1Lo, i1Hi, i2Lo, i2Hi
189    
190     C-- Get statistics on names
191     i1Lo = IFNBLNK(fNam)
192     i1Hi = ILNBLNK(fNam)
193     i2Lo = IFNBLNK(fNamMeta)
194     i2Hi = ILNBLNK(fNamMeta)
195    
196     C-- Choose a free I/O unit
197     fileHandle = -1
198     dUnit = 0
199     DO I=1, ioUnitsPerThread
200     IF ( unitStatus(I,myThid) .EQ. freeUnit ) THEN
201     dUnit = dUnitNumber(I,myThid)
202     mUnit = mUnitNumber(I,myThid)
203     unitStatus(I,myThid) = busyUnit
204     errorMode(I,myThid) = theErrorMode
205     accessMode(I,myThid) = theAccessMode
206     eMode = theErrorMode
207     aMode = theAccessMode
208     fileHandle = I
209     GOTO 10
210     ENDIF
211     ENDDO
212     10 CONTINUE
213     IF ( dUnit .EQ. 0 ) GOTO 999
214    
215     C-- Remove previous meta information if there was any
216     metaDataStatus(fileHandle,myThid) = metaDataWritten
217     IF ( fNamMeta .NE. ' ' ) THEN
218     IF ( aMode .EQ. accessModeRW ) THEN
219     OPEN(UNIT=mUnit,NAME=fNamMeta(i2Lo:i2Hi),STATUS='UNKNOWN',ERR=899)
220     CLOSE(mUnit,ERR=899)
221     ENDIF
222     OPEN(UNIT=mUnit,NAME=fNamMeta(i2Lo:i2Hi),STATUS='UNKNOWN',ERR=899)
223     metaDataStatus(fileHandle,myThid) = metaDataNotWritten
224     nameOfMFile(fileHandle,myThid) = fNamMeta(i2Lo:i2Hi)
225     ENDIF
226    
227     C-- Open data file
228     nameOfDFile(fileHandle,myThid) = fNam(i1Lo:i1Hi)
229     OPEN(UNIT=dUnit,NAME=fNam(i1Lo:i1Hi),STATUS='UNKNOWN',ERR=799,
230     & FORM='UNFORMATTED',ACCESS='SEQUENTIAL')
231    
232    
233     1000 CONTINUE
234     RETURN
235    
236     999 CONTINUE
237     WRITE(msgBuf,'(A)') ' S/R DFILE_OPEN '
238     CALL PRINT_ERROR( msgBuf , 1)
239     WRITE(msgBuf,'(A,A)') ' Too many open files '
240     CALL PRINT_ERROR( msgBuf , 1)
241     WRITE(msgBuf,'(A,I4,A,A)') ' Thread ', myThid, ' trying to open ',
242     & fNam(i1Lo:i1Hi)
243     CALL PRINT_ERROR( msgBuf , 1)
244     IF ( eMode .EQ. errorModeSTOP ) THEN
245     STOP 'ABNORMAL END: S/R DFILE_OPEN '
246     ENDIF
247     ioErrorCount(myThid) = ioErrorCount(myThid) + 1
248     GOTO 1000
249    
250     899 CONTINUE
251     WRITE(msgBuf,'(A)') ' S/R DFILE_OPEN '
252     CALL PRINT_ERROR( msgBuf , 1)
253     WRITE(msgBuf,'(A,I4,A,A)') ' Thread ', myThid, ' failed open for ',
254     & fNamMeta(i2Lo:i2Hi)
255     CALL PRINT_ERROR( msgBuf , 1)
256     IF ( eMode .EQ. errorModeSTOP ) THEN
257     STOP 'ABNORMAL END: S/R DFILE_OPEN '
258     ENDIF
259     ioErrorCount(myThid) = ioErrorCount(myThid) + 1
260     GOTO 1000
261    
262     799 CONTINUE
263     WRITE(msgBuf,'(A)') ' S/R DFILE_OPEN '
264     CALL PRINT_ERROR( msgBuf , 1)
265     WRITE(msgBuf,'(A,I4,A,A)') ' Thread ', myThid, ' failed open for ',
266     & fNam(i1Lo:i1Hi)
267     CALL PRINT_ERROR( msgBuf , 1)
268     IF ( eMode .EQ. errorModeSTOP ) THEN
269     STOP 'ABNORMAL END: S/R DFILE_OPEN '
270     ENDIF
271     ioErrorCount(myThid) = ioErrorCount(myThid) + 1
272     GOTO 1000
273    
274     END
275    
276     SUBROUTINE DFILE_READ_R4(
277     I lBuffer,
278     I fileHandle, myThid)
279     C /==========================================================\
280     C | SUBROUTINE DFILE_READ_R4 |
281     C | o Read record(s) from model dump file. |
282     C |==========================================================|
283     C | Controlling routine for doing actual I/O operations. |
284     C | Routine reads data from binary files formatted for |
285     C | model input. Could do elaborate reads from netCDF or |
286     C | using regular C I/O primitives. For now we use plain |
287     C | F77. |
288     C \==========================================================/
289    
290     C == Global variables ==
291     #include "SIZE.h"
292     #include "EEPARAMS.h"
293     #include "DFILE.h"
294    
295     INTEGER IFNBLNK
296     EXTERNAL IFNBLNK
297     INTEGER ILNBLNK
298     EXTERNAL ILNBLNK
299    
300     C == Routine arguments ==
301     C lBuffer - Length of buffer data will be read into
302     C fileHandle - Handle of already opened file
303     C myThid - Thread id calling this routine
304     INTEGER lBuffer
305     INTEGER fileHandle
306     INTEGER myThid
307    
308     C == Local variables ==
309     C ioUnit - Unit number associated with fileHandle
310     C I - Loop counter
311     C eMode - fileHandles error mode
312     CHARACTER*(MAX_LEN_FNAM) fNam
313     CHARACTER*(MAX_LEN_MBUF) msgBuf
314     INTEGER ioUnit
315     INTEGER I, iLo, iHi
316     INTEGER eMode
317    
318     C-- Get error mode
319     eMode = errorMode(fileHandle,myThid)
320    
321     C-- Check that file is active
322     IF ( unitStatus(fileHandle,myThid) .NE. busyUnit ) GOTO 999
323    
324     fNam = nameOfDFile(fileHandle,myThid)
325     iLo = IFNBLNK(fNam)
326     iHi = ILNBLNK(fNam)
327     ioUnit = dUnitNumber(fileHandle,myThid)
328 adcroft 1.5 READ(ioUnit,ERR=899) (ioBuf_R4(I),I=1,lBuffer)
329 cnh 1.1
330    
331     1000 CONTINUE
332     RETURN
333    
334     999 CONTINUE
335     WRITE(msgBuf,'(A)') ' S/R DFILE_READ_R4 '
336     CALL PRINT_ERROR( msgBuf , 1)
337     WRITE(msgBuf,'(A,I4,A)') ' Thread ', myThid, ' unit not open '
338     CALL PRINT_ERROR( msgBuf , 1)
339     IF ( eMode .EQ. errorModeSTOP ) THEN
340     STOP 'ABNORMAL END: S/R DFILE_READ_R4'
341     ENDIF
342     ioErrorCount(myThid) = ioErrorCount(myThid) + 1
343     GOTO 1000
344    
345     899 CONTINUE
346     WRITE(msgBuf,'(A)') ' S/R DFILE_READ_R4 '
347     CALL PRINT_ERROR( msgBuf , 1)
348 cnh 1.3 WRITE(msgBuf,'(A,I4,A)') ' Thread ', myThid, ' error reading file'
349     CALL PRINT_ERROR( msgBuf , 1)
350     WRITE(msgBuf,'(A,A,A)') ' "', fNam(iLo:iHi),'"'
351 cnh 1.1 CALL PRINT_ERROR( msgBuf , 1)
352     IF ( eMode .EQ. errorModeSTOP ) THEN
353     STOP 'ABNORMAL END: S/R DFILE_READ_R4'
354     ENDIF
355     ioErrorCount(myThid) = ioErrorCount(myThid) + 1
356     GOTO 1000
357    
358     END
359     SUBROUTINE DFILE_READ_R8(
360     I lBuffer,
361     I fileHandle, myThid)
362     C /==========================================================\
363     C | SUBROUTINE DFILE_READ_R8 |
364     C | o Read record(s) from model dump file. |
365     C |==========================================================|
366     C | Controlling routine for doing actual I/O operations. |
367     C | Routine reads data from binary files formatted for |
368     C | model input. Could do elaborate reads from netCDF or |
369     C | using regular C I/O primitives. For now we use plain |
370     C | F77. |
371     C \==========================================================/
372    
373     C == Global variables ==
374     #include "SIZE.h"
375     #include "EEPARAMS.h"
376     #include "DFILE.h"
377    
378     INTEGER IFNBLNK
379     EXTERNAL IFNBLNK
380     INTEGER ILNBLNK
381     EXTERNAL ILNBLNK
382    
383     C == Routine arguments ==
384     C lBuffer - Length of buffer data will be read into
385     C fileHandle - Handle of already opened file
386     C myThid - Thread id calling this routine
387     INTEGER lBuffer
388     INTEGER fileHandle
389     INTEGER myThid
390    
391     C == Local variables ==
392     C ioUnit - Unit number associated with fileHandle
393     C I - Loop counter
394     C eMode - fileHandles error mode
395     CHARACTER*(MAX_LEN_FNAM) fNam
396     CHARACTER*(MAX_LEN_MBUF) msgBuf
397     INTEGER ioUnit
398     INTEGER I, iLo, iHi
399     INTEGER eMode
400    
401     C-- Get error mode
402     eMode = errorMode(fileHandle,myThid)
403    
404     C-- Check that file is active
405     IF ( unitStatus(fileHandle,myThid) .NE. busyUnit ) GOTO 999
406    
407     fNam = nameOfDFile(fileHandle,myThid)
408     iLo = IFNBLNK(fNam)
409     iHi = ILNBLNK(fNam)
410     ioUnit = dUnitNumber(fileHandle,myThid)
411     READ(ioUnit,ERR=899) (ioBuf_R8(I),I=1,lBuffer)
412    
413    
414     1000 CONTINUE
415     RETURN
416    
417     999 CONTINUE
418     WRITE(msgBuf,'(A)') ' S/R DFILE_READ_R8 '
419     CALL PRINT_ERROR( msgBuf , 1)
420     WRITE(msgBuf,'(A,I4,A)') ' Thread ', myThid, ' unit not open '
421     CALL PRINT_ERROR( msgBuf , 1)
422     IF ( eMode .EQ. errorModeSTOP ) THEN
423     STOP 'ABNORMAL END: S/R DFILE_READ_R8'
424     ENDIF
425     ioErrorCount(myThid) = ioErrorCount(myThid) + 1
426     GOTO 1000
427    
428     899 CONTINUE
429     WRITE(msgBuf,'(A)') ' S/R DFILE_READ_R8 '
430     CALL PRINT_ERROR( msgBuf , 1)
431 cnh 1.3 WRITE(msgBuf,'(A,I4,A)') ' Thread ', myThid, ' error reading file'
432     CALL PRINT_ERROR( msgBuf , 1)
433     WRITE(msgBuf,'(A,A,A)') ' "', fNam(iLo:iHi),'"'
434 cnh 1.1 CALL PRINT_ERROR( msgBuf , 1)
435     IF ( eMode .EQ. errorModeSTOP ) THEN
436     STOP 'ABNORMAL END: S/R DFILE_READ_R8'
437     ENDIF
438     ioErrorCount(myThid) = ioErrorCount(myThid) + 1
439     GOTO 1000
440    
441     END
442    
443     SUBROUTINE DFILE_SET_RO
444     C /==========================================================\
445     C | SUBROUTINE DFILE_SET_RO |
446     C | o Sets new connections to be read-only. |
447     C \==========================================================/
448    
449     C == Global variables ==
450     #include "SIZE.h"
451     #include "EEPARAMS.h"
452     #include "DFILE.h"
453    
454     theAccessMode = accessModeRO
455    
456     RETURN
457     END
458    
459     SUBROUTINE DFILE_SET_RW
460     C /==========================================================\
461     C | SUBROUTINE DFILE_SET_RW |
462     C | o Sets new connections to be read-write |
463     C \==========================================================/
464    
465     C == Global variables ==
466     #include "SIZE.h"
467     #include "EEPARAMS.h"
468     #include "DFILE.h"
469    
470     theAccessMode = accessModeRW
471    
472     RETURN
473     END
474    
475     SUBROUTINE DFILE_SET_STOP_ON_ERROR
476     C /==========================================================\
477     C | SUBROUTINE DFILE_SET_STOP_ON_ERROR |
478     C | o Sets new connections to STOP on error |
479     C \==========================================================/
480    
481     C == Global variables ==
482     #include "SIZE.h"
483     #include "EEPARAMS.h"
484     #include "DFILE.h"
485    
486     theErrorMode = errorModeSTOP
487    
488     RETURN
489     END
490    
491     SUBROUTINE DFILE_SET_CONT_ON_ERROR
492     C /==========================================================\
493     C | SUBROUTINE DFILE_SET_CONT_ON_ERROR |
494     C | o Sets new connections to continue on error |
495     C \==========================================================/
496    
497     C == Global variables ==
498     #include "SIZE.h"
499     #include "EEPARAMS.h"
500     #include "DFILE.h"
501    
502     theErrorMode = errorModeCONT
503    
504     RETURN
505     END
506    
507     SUBROUTINE DFILE_WRITE_R4(
508     I lBuffer,
509     I nDims, dimList,
510     I fileHandle, fileId, myThid )
511     C /==========================================================\
512     C | SUBROUTINE DFILE_WRITE_R4 |
513     C | o Write record(s) to model dump file. |
514     C |==========================================================|
515     C | Controlling routine for doing actual I/O operations. |
516     C | Routine writes data to binary files. |
517     C | Could do elaborate write to netCDF or |
518     C | use C I/O primitives. For now we use plain F77 but the |
519     C | routine does write both data and metadata. Metadata is |
520     C | extra info. which describes the data - in this case it |
521     C | is information indicating the subregion of the global |
522     C | dataset being written out. |
523     C \==========================================================/
524    
525     C == Global variables ==
526     #include "SIZE.h"
527     #include "EEPARAMS.h"
528     #include "DFILE.h"
529    
530     C == Routine arguments ==
531     C lBuffer - Amount of data written
532     C nDims - Global and subset dimensionality
533     C dimList - List of global and subset extents
534     C fileHandle - Handle identifying actual IO unit
535     C myThid - Thread number of thread calling this
536     C routine
537     C eMode - error mode for this fileHandle
538     INTEGER lBuffer
539     INTEGER nDims
540     INTEGER dimList(nDims*3)
541     INTEGER fileHandle
542     INTEGER fileId
543     INTEGER myThid
544    
545     C == Local variables ==
546     C ioUnit - Unit number for I/O
547     C msgBuf - Textual printing message buffer
548     C eMode - Error mode for this file handle
549     INTEGER ioUnit
550 cnh 1.2 CHARACTER*(MAX_LEN_MBUF) msgBuf
551     CHARACTER*(MAX_LEN_FNAM) fNam
552 cnh 1.1 INTEGER eMode
553     INTEGER I
554    
555     C-- Set error mode
556     eMode = errorMode(fileHandle,myThid)
557    
558     C-- Check that file is active
559     IF ( unitStatus(fileHandle,myThid) .NE. busyUnit ) GOTO 999
560    
561     C-- Write data
562     ioUnit = dUnitNumber(fileHandle,myThid)
563     fNam = nameOfDFile(fileHandle,myThid)
564     WRITE(ioUnit,ERR=899) (ioBuf_R4(I),I=1,lBuffer)
565    
566     C-- Now write meta information
567     IF ( metaDataStatus(fileHandle,myThid) .EQ. metaDataNotWritten ) THEN
568     ioUnit = mUnitNumber(fileHandle,myThid)
569    
570     WRITE(msgBuf,'(A)') '// START OF META DATA'
571     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
572    
573 adcroft 1.5 WRITE(msgBuf,'(A,A)') ' id =[ ','/* Identifier */'
574 cnh 1.1 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
575 adcroft 1.5 CALL PRINT_LIST_I( fileId, 1, INDEX_NONE, .FALSE., .TRUE., ioUnit )
576     WRITE(msgBuf,'(A)') ' ]; '
577 cnh 1.1 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
578    
579 adcroft 1.5 WRITE(msgBuf,'(A,A)') ' nDims =[ ','/* Number of dimensions */'
580 cnh 1.1 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
581 adcroft 1.5 CALL PRINT_LIST_I( nDims, 1, INDEX_NONE, .FALSE., .TRUE., ioUnit )
582     WRITE(msgBuf,'(A)') ' ]; '
583 cnh 1.1 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
584    
585 adcroft 1.5 WRITE(msgBuf,'(A,A)') ' dimList =[ ',
586 cnh 1.1 & '/* Global1, local min1, local max1, ... */'
587     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
588     DO I=1,nDims
589 adcroft 1.5 CALL PRINT_LIST_I( dimList((I-1)*3+1), 3, INDEX_NONE, I.NE.nDims, .FALSE., ioUnit )
590 cnh 1.1 ENDDO
591 adcroft 1.5 WRITE(msgBuf,'(A)') ' ]; '
592     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
593    
594     WRITE(msgBuf,'(A,A)') ' format =[ ','/* Field format */'
595     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
596     WRITE(msgBuf,'(16X,A)') '''float32'''
597     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
598     WRITE(msgBuf,'(A)') ' ]; '
599 cnh 1.1 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
600    
601     WRITE(msgBuf,'(A)') '// END OF META DATA'
602     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
603     metaDataStatus(fileHandle,myThid) = metaDataWritten
604     ENDIF
605    
606     1000 CONTINUE
607     RETURN
608    
609     999 CONTINUE
610     WRITE(msgBuf,'(A)') ' S/R DFILE_WRITE_R4 '
611     CALL PRINT_ERROR( msgBuf , 1)
612     WRITE(msgBuf,'(A,A)') ' Thread ', myThid, ' unit not open '
613     CALL PRINT_ERROR( msgBuf , 1)
614     IF ( eMode .EQ. errorModeSTOP ) THEN
615     STOP 'ABNORMAL END: S/R DFILE_WRITE_R4'
616     ENDIF
617     ioErrorCount(myThid) = ioErrorCount(myThid) + 1
618     GOTO 1000
619    
620     899 CONTINUE
621     WRITE(msgBuf,'(A)') ' S/R DFILE_WRITE_R4 '
622     CALL PRINT_ERROR( msgBuf , 1)
623     WRITE(msgBuf,'(A,A)') ' Thread ', myThid, ' write error '
624     CALL PRINT_ERROR( msgBuf , 1)
625     WRITE(msgBuf,'(A,A)') ' File ', fNam
626     CALL PRINT_ERROR( msgBuf , 1)
627     IF ( eMode .EQ. errorModeSTOP ) THEN
628     STOP 'ABNORMAL END: S/R DFILE_WRITE_R4'
629     ENDIF
630     ioErrorCount(myThid) = ioErrorCount(myThid) + 1
631     GOTO 1000
632    
633     END
634    
635     SUBROUTINE DFILE_WRITE_R8(
636     I lBuffer,
637     I nDims, dimList,
638     I fileHandle, fileId, myThid )
639     C /==========================================================\
640     C | SUBROUTINE DFILE_WRITE_R8 |
641     C | o Write record(s) to model dump file. |
642     C |==========================================================|
643     C | Controlling routine for doing actual I/O operations. |
644     C | Routine writes data to binary files. |
645     C | Could do elaborate write to netCDF or |
646     C | use C I/O primitives. For now we use plain F77 but the |
647     C | routine does write both data and metadata. Metadata is |
648     C | extra info. which describes the data - in this case it |
649     C | is information indicating the subregion of the global |
650     C | dataset being written out. |
651     C \==========================================================/
652    
653     C == Global variables ==
654     #include "SIZE.h"
655     #include "EEPARAMS.h"
656     #include "DFILE.h"
657    
658     C == Routine arguments ==
659     C buffer - Subset data to write
660     C lBuffer - Amount of data written
661     C nDims - Global and subset dimensionality
662     C dimList - List of global and subset extents
663     C fileHandle - Handle identifying actual IO unit
664     C myThid - Thread number of thread calling this
665     C routine
666     C eMode - error mode for this fileHandle
667     INTEGER lBuffer
668     INTEGER nDims
669     INTEGER dimList(nDims*3)
670     INTEGER fileHandle
671     INTEGER fileId
672     INTEGER myThid
673    
674     C == Local variables ==
675     C ioUnit - Unit number for I/O
676     C msgBuf - Textual printing message buffer
677     C eMode - Error mode for this file handle
678     INTEGER ioUnit
679 cnh 1.2 CHARACTER*(MAX_LEN_MBUF) msgBuf
680     CHARACTER*(MAX_LEN_FNAM) fNam
681 cnh 1.1 INTEGER eMode
682     INTEGER I
683    
684     C-- Set error mode
685     eMode = errorMode(fileHandle,myThid)
686    
687     C-- Check that file is active
688     IF ( unitStatus(fileHandle,myThid) .NE. busyUnit ) GOTO 999
689    
690     C-- Write data
691     ioUnit = dUnitNumber(fileHandle,myThid)
692     fNam = nameOfDFile(fileHandle,myThid)
693     WRITE(ioUnit,ERR=899) (ioBuf_R8(I),I=1,lBuffer)
694    
695     C-- Now write meta information
696     IF ( metaDataStatus(fileHandle,myThid) .EQ. metaDataNotWritten ) THEN
697     ioUnit = mUnitNumber(fileHandle,myThid)
698    
699     WRITE(msgBuf,'(A)') '// START OF META DATA'
700     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
701    
702 adcroft 1.5 WRITE(msgBuf,'(A,A)') ' id =[ ','/* Identifier */'
703 cnh 1.1 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
704 adcroft 1.5 CALL PRINT_LIST_I( fileId, 1, INDEX_NONE, .FALSE., .TRUE., ioUnit )
705     WRITE(msgBuf,'(A)') ' ]; '
706 cnh 1.1 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
707    
708 adcroft 1.5 WRITE(msgBuf,'(A,A)') ' nDims =[ ','/* Number of dimensions */'
709 cnh 1.1 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
710 adcroft 1.5 CALL PRINT_LIST_I( nDims, 1, INDEX_NONE, .FALSE., .TRUE., ioUnit )
711     WRITE(msgBuf,'(A)') ' ]; '
712 cnh 1.1 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
713    
714 adcroft 1.5 WRITE(msgBuf,'(A,A)') ' dimList =[ ',
715 cnh 1.1 & '/* Global1, local min1, local max1, ... */'
716     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
717     DO I=1,nDims
718 adcroft 1.5 CALL PRINT_LIST_I( dimList((I-1)*3+1), 3, INDEX_NONE, I.NE.nDims, .FALSE., ioUnit )
719 cnh 1.1 ENDDO
720 adcroft 1.5 WRITE(msgBuf,'(A)') ' ]; '
721 cnh 1.1 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
722 adcroft 1.5
723     WRITE(msgBuf,'(A,A)') ' format =[ ','/* Field format */'
724     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
725     WRITE(msgBuf,'(16X,A)') '''float64'''
726     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
727     WRITE(msgBuf,'(A)') ' ]; '
728     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
729    
730 cnh 1.1 WRITE(msgBuf,'(A)') '// END OF META DATA'
731     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
732     metaDataStatus(fileHandle,myThid) = metaDataWritten
733     ENDIF
734    
735     1000 CONTINUE
736     RETURN
737    
738     999 CONTINUE
739     WRITE(msgBuf,'(A)') ' S/R DFILE_WRITE_R8 '
740     CALL PRINT_ERROR( msgBuf , 1)
741     WRITE(msgBuf,'(A,A)') ' Thread ', myThid, ' unit not open '
742     CALL PRINT_ERROR( msgBuf , 1)
743     IF ( eMode .EQ. errorModeSTOP ) THEN
744     STOP 'ABNORMAL END: S/R DFILE_WRITE_R8'
745     ENDIF
746     ioErrorCount(myThid) = ioErrorCount(myThid) + 1
747     GOTO 1000
748    
749     899 CONTINUE
750     WRITE(msgBuf,'(A)') ' S/R DFILE_WRITE_R8 '
751     CALL PRINT_ERROR( msgBuf , 1)
752     WRITE(msgBuf,'(A,A)') ' Thread ', myThid, ' write error '
753     CALL PRINT_ERROR( msgBuf , 1)
754     WRITE(msgBuf,'(A,A)') ' File ', fNam
755     CALL PRINT_ERROR( msgBuf , 1)
756     IF ( eMode .EQ. errorModeSTOP ) THEN
757     STOP 'ABNORMAL END: S/R DFILE_WRITE_R8'
758     ENDIF
759     ioErrorCount(myThid) = ioErrorCount(myThid) + 1
760     GOTO 1000
761    
762     END
  ViewVC Help
Powered by ViewVC 1.1.22