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