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

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

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

revision 1.7 by cnh, Tue Jun 30 12:25:14 1998 UTC revision 1.8 by cnh, Wed Oct 28 03:11:33 1998 UTC
# Line 38  C   level calls to these routines. A mod Line 38  C   level calls to these routines. A mod
38  C   control whether the DFILE_OPEN routine opens a file in  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  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  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')  C   file systems. Other systems do not support the OPEN(...='READ_ONLY')
42  C   so this feature may need to be switched on or off as appropriate.  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  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  C   a "context" flag which is applied to IO ahndles when the DFILE_OPEN
# Line 216  C--   Remove previous meta information i Line 216  C--   Remove previous meta information i
216        metaDataStatus(fileHandle,myThid) = metaDataWritten        metaDataStatus(fileHandle,myThid) = metaDataWritten
217        IF ( fNamMeta .NE. ' ' ) THEN        IF ( fNamMeta .NE. ' ' ) THEN
218         IF ( aMode .EQ. accessModeRW ) THEN         IF ( aMode .EQ. accessModeRW ) THEN
219          OPEN(UNIT=mUnit,NAME=fNamMeta(i2Lo:i2Hi),STATUS='UNKNOWN',ERR=899)          OPEN(UNIT=mUnit,NAME=fNamMeta(i2Lo:i2Hi),
220         &       STATUS='UNKNOWN',ERR=899)
221          CLOSE(mUnit,ERR=899)          CLOSE(mUnit,ERR=899)
222          OPEN(UNIT=mUnit,NAME=fNamMeta(i2Lo:i2Hi),STATUS='UNKNOWN',ERR=899)          OPEN(UNIT=mUnit,NAME=fNamMeta(i2Lo:i2Hi),
223         &       STATUS='UNKNOWN',ERR=899)
224          metaDataStatus(fileHandle,myThid) = metaDataNotWritten          metaDataStatus(fileHandle,myThid) = metaDataNotWritten
225          nameOfMFile(fileHandle,myThid) = fNamMeta(i2Lo:i2Hi)          nameOfMFile(fileHandle,myThid) = fNamMeta(i2Lo:i2Hi)
226         ENDIF         ENDIF
# Line 238  C--   Open data file Line 240  C--   Open data file
240         CALL PRINT_ERROR( msgBuf , 1)         CALL PRINT_ERROR( msgBuf , 1)
241         WRITE(msgBuf,'(A,A)') ' Too many open files '         WRITE(msgBuf,'(A,A)') ' Too many open files '
242         CALL PRINT_ERROR( msgBuf , 1)         CALL PRINT_ERROR( msgBuf , 1)
243         WRITE(msgBuf,'(A,I4,A,A)') ' Thread ', myThid, ' trying to open ',         WRITE(msgBuf,'(A,I4,A,A)') ' Thread ', myThid,' trying to open ',
244       & fNam(i1Lo:i1Hi)       & fNam(i1Lo:i1Hi)
245         CALL PRINT_ERROR( msgBuf , 1)         CALL PRINT_ERROR( msgBuf , 1)
246         IF ( eMode .EQ. errorModeSTOP ) THEN         IF ( eMode .EQ. errorModeSTOP ) THEN
# Line 250  C--   Open data file Line 252  C--   Open data file
252    899 CONTINUE    899 CONTINUE
253         WRITE(msgBuf,'(A)') ' S/R DFILE_OPEN '         WRITE(msgBuf,'(A)') ' S/R DFILE_OPEN '
254         CALL PRINT_ERROR( msgBuf , 1)         CALL PRINT_ERROR( msgBuf , 1)
255         WRITE(msgBuf,'(A,I4,A,A)') ' Thread ', myThid, ' failed open for ',         WRITE(msgBuf,'(A,I4,A,A)') ' Thread ',myThid,' failed open for ',
256       & fNamMeta(i2Lo:i2Hi)       & fNamMeta(i2Lo:i2Hi)
257         CALL PRINT_ERROR( msgBuf , 1)         CALL PRINT_ERROR( msgBuf , 1)
258         IF ( eMode .EQ. errorModeSTOP ) THEN         IF ( eMode .EQ. errorModeSTOP ) THEN
# Line 262  C--   Open data file Line 264  C--   Open data file
264    799 CONTINUE    799 CONTINUE
265         WRITE(msgBuf,'(A)') ' S/R DFILE_OPEN '         WRITE(msgBuf,'(A)') ' S/R DFILE_OPEN '
266         CALL PRINT_ERROR( msgBuf , 1)         CALL PRINT_ERROR( msgBuf , 1)
267         WRITE(msgBuf,'(A,I4,A,A)') ' Thread ', myThid, ' failed open for ',         WRITE(msgBuf,'(A,I4,A,A)') ' Thread ',myThid,' failed open for ',
268       & fNam(i1Lo:i1Hi)       & fNam(i1Lo:i1Hi)
269         CALL PRINT_ERROR( msgBuf , 1)         CALL PRINT_ERROR( msgBuf , 1)
270         IF ( eMode .EQ. errorModeSTOP ) THEN         IF ( eMode .EQ. errorModeSTOP ) THEN
# Line 345  C--   Check that file is active Line 347  C--   Check that file is active
347    899 CONTINUE    899 CONTINUE
348         WRITE(msgBuf,'(A)') ' S/R DFILE_READ_R4 '         WRITE(msgBuf,'(A)') ' S/R DFILE_READ_R4 '
349         CALL PRINT_ERROR( msgBuf , 1)         CALL PRINT_ERROR( msgBuf , 1)
350         WRITE(msgBuf,'(A,I4,A)') ' Thread ', myThid, ' error reading file'         WRITE(msgBuf,'(A,I4,A)') ' Thread ', myThid,' error reading file'
351         CALL PRINT_ERROR( msgBuf , 1)         CALL PRINT_ERROR( msgBuf , 1)
352         WRITE(msgBuf,'(A,A,A)') ' "', fNam(iLo:iHi),'"'         WRITE(msgBuf,'(A,A,A)') ' "', fNam(iLo:iHi),'"'
353         CALL PRINT_ERROR( msgBuf , 1)         CALL PRINT_ERROR( msgBuf , 1)
# Line 428  C--   Check that file is active Line 430  C--   Check that file is active
430    899 CONTINUE    899 CONTINUE
431         WRITE(msgBuf,'(A)') ' S/R DFILE_READ_R8 '         WRITE(msgBuf,'(A)') ' S/R DFILE_READ_R8 '
432         CALL PRINT_ERROR( msgBuf , 1)         CALL PRINT_ERROR( msgBuf , 1)
433         WRITE(msgBuf,'(A,I4,A)') ' Thread ', myThid, ' error reading file'         WRITE(msgBuf,'(A,I4,A)') ' Thread ', myThid,' error reading file'
434         CALL PRINT_ERROR( msgBuf , 1)         CALL PRINT_ERROR( msgBuf , 1)
435         WRITE(msgBuf,'(A,A,A)') ' "', fNam(iLo:iHi),'"'         WRITE(msgBuf,'(A,A,A)') ' "', fNam(iLo:iHi),'"'
436         CALL PRINT_ERROR( msgBuf , 1)         CALL PRINT_ERROR( msgBuf , 1)
# Line 564  C--   Write data Line 566  C--   Write data
566        WRITE(ioUnit,ERR=899) (ioBuf_R4(I),I=1,lBuffer)        WRITE(ioUnit,ERR=899) (ioBuf_R4(I),I=1,lBuffer)
567    
568  C--   Now write meta information  C--   Now write meta information
569        IF ( metaDataStatus(fileHandle,myThid) .EQ. metaDataNotWritten ) THEN        IF ( metaDataStatus(fileHandle,myThid) .EQ.
570         &     metaDataNotWritten ) THEN
571         ioUnit = mUnitNumber(fileHandle,myThid)         ioUnit = mUnitNumber(fileHandle,myThid)
572    
573         WRITE(msgBuf,'(A)') '// START OF META DATA'         WRITE(msgBuf,'(A)') '// START OF META DATA'
# Line 572  C--   Now write meta information Line 575  C--   Now write meta information
575    
576         WRITE(msgBuf,'(A,A)') ' id =[ ','/* Identifier */'         WRITE(msgBuf,'(A,A)') ' id =[ ','/* Identifier */'
577         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
578         CALL PRINT_LIST_I( fileId, 1, INDEX_NONE, .FALSE., .TRUE., ioUnit )         CALL PRINT_LIST_I( fileId, 1, INDEX_NONE, .FALSE., .TRUE.,
579         &                    ioUnit )
580         WRITE(msgBuf,'(A)')   '   ];     '         WRITE(msgBuf,'(A)')   '   ];     '
581         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
582    
583         WRITE(msgBuf,'(A,A)') ' nDims =[ ','/* Number of dimensions */'         WRITE(msgBuf,'(A,A)') ' nDims =[ ','/* Number of dimensions */'
584         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
585         CALL PRINT_LIST_I( nDims, 1, INDEX_NONE, .FALSE., .TRUE., ioUnit )         CALL PRINT_LIST_I( nDims, 1, INDEX_NONE, .FALSE., .TRUE.,
586         &                    ioUnit )
587         WRITE(msgBuf,'(A)')   '   ];     '         WRITE(msgBuf,'(A)')   '   ];     '
588         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
589    
# Line 586  C--   Now write meta information Line 591  C--   Now write meta information
591       &  '/* Global1, local min1, local max1, ... */'       &  '/* Global1, local min1, local max1, ... */'
592         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
593         DO I=1,nDims         DO I=1,nDims
594          CALL PRINT_LIST_I( dimList((I-1)*3+1), 3, INDEX_NONE, I.NE.nDims, .FALSE., ioUnit )          CALL PRINT_LIST_I( dimList((I-1)*3+1), 3, INDEX_NONE,
595         &                    I.NE.nDims, .FALSE., ioUnit )
596         ENDDO         ENDDO
597         WRITE(msgBuf,'(A)')   '   ];     '         WRITE(msgBuf,'(A)')   '   ];     '
598         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
# Line 693  C--   Write data Line 699  C--   Write data
699        WRITE(ioUnit,ERR=899) (ioBuf_R8(I),I=1,lBuffer)        WRITE(ioUnit,ERR=899) (ioBuf_R8(I),I=1,lBuffer)
700    
701  C--   Now write meta information  C--   Now write meta information
702        IF ( metaDataStatus(fileHandle,myThid) .EQ. metaDataNotWritten ) THEN        IF ( metaDataStatus(fileHandle,myThid) .EQ.
703         &                    metaDataNotWritten ) THEN
704         ioUnit = mUnitNumber(fileHandle,myThid)         ioUnit = mUnitNumber(fileHandle,myThid)
705    
706         WRITE(msgBuf,'(A)') '// START OF META DATA'         WRITE(msgBuf,'(A)') '// START OF META DATA'
# Line 701  C--   Now write meta information Line 708  C--   Now write meta information
708    
709         WRITE(msgBuf,'(A,A)') ' id =[ ','/* Identifier */'         WRITE(msgBuf,'(A,A)') ' id =[ ','/* Identifier */'
710         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
711         CALL PRINT_LIST_I( fileId, 1, INDEX_NONE, .FALSE., .TRUE., ioUnit )         CALL PRINT_LIST_I( fileId, 1, INDEX_NONE, .FALSE., .TRUE.,
712         &                    ioUnit )
713         WRITE(msgBuf,'(A)')   '   ];     '         WRITE(msgBuf,'(A)')   '   ];     '
714         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
715    
716         WRITE(msgBuf,'(A,A)') ' nDims =[ ','/* Number of dimensions */'         WRITE(msgBuf,'(A,A)') ' nDims =[ ','/* Number of dimensions */'
717         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
718         CALL PRINT_LIST_I( nDims, 1, INDEX_NONE, .FALSE., .TRUE., ioUnit )         CALL PRINT_LIST_I( nDims, 1, INDEX_NONE, .FALSE., .TRUE.,
719         &                    ioUnit )
720         WRITE(msgBuf,'(A)')   '   ];     '         WRITE(msgBuf,'(A)')   '   ];     '
721         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
722    
# Line 715  C--   Now write meta information Line 724  C--   Now write meta information
724       &  '/* Global1, local min1, local max1, ... */'       &  '/* Global1, local min1, local max1, ... */'
725         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
726         DO I=1,nDims         DO I=1,nDims
727          CALL PRINT_LIST_I( dimList((I-1)*3+1), 3, INDEX_NONE, I.NE.nDims, .FALSE., ioUnit )          CALL PRINT_LIST_I( dimList((I-1)*3+1), 3, INDEX_NONE,
728         &                    I.NE.nDims, .FALSE., ioUnit )
729         ENDDO         ENDDO
730         WRITE(msgBuf,'(A)')   '   ];     '         WRITE(msgBuf,'(A)')   '   ];     '
731         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22