/[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.1 by cnh, Thu May 21 18:30:08 1998 UTC revision 1.6 by cnh, Mon Jun 29 14:04:32 1998 UTC
# Line 218  C--   Remove previous meta information i Line 218  C--   Remove previous meta information i
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),STATUS='UNKNOWN',ERR=899)
220          CLOSE(mUnit,ERR=899)          CLOSE(mUnit,ERR=899)
221            OPEN(UNIT=mUnit,NAME=fNamMeta(i2Lo:i2Hi),STATUS='UNKNOWN',ERR=899)
222            metaDataStatus(fileHandle,myThid) = metaDataNotWritten
223            nameOfMFile(fileHandle,myThid) = fNamMeta(i2Lo:i2Hi)
224         ENDIF         ENDIF
        OPEN(UNIT=mUnit,NAME=fNamMeta(i2Lo:i2Hi),STATUS='UNKNOWN',ERR=899)  
        metaDataStatus(fileHandle,myThid) = metaDataNotWritten  
        nameOfMFile(fileHandle,myThid) = fNamMeta(i2Lo:i2Hi)  
225        ENDIF        ENDIF
226    
227  C--   Open data file  C--   Open data file
228        nameOfDFile(fileHandle,myThid) = fNam(i1Lo:i1Hi)        nameOfDFile(fileHandle,myThid) = fNam(i1Lo:i1Hi)
229        OPEN(UNIT=dUnit,NAME=fNam(i1Lo:i1Hi),STATUS='UNKNOWN',ERR=799,        OPEN(UNIT=dUnit,NAME=fNam(i1Lo:i1Hi),STATUS='UNKNOWN', !ERR=799,
230       &     FORM='UNFORMATTED',ACCESS='SEQUENTIAL')       &     FORM='UNFORMATTED',ACCESS='SEQUENTIAL')
231    
232    
# Line 345  C--   Check that file is active Line 345  C--   Check that file is active
345    899 CONTINUE    899 CONTINUE
346         WRITE(msgBuf,'(A)') ' S/R DFILE_READ_R4 '         WRITE(msgBuf,'(A)') ' S/R DFILE_READ_R4 '
347         CALL PRINT_ERROR( msgBuf , 1)         CALL PRINT_ERROR( msgBuf , 1)
348         WRITE(msgBuf,'(A,I4,A,A)') ' Thread ', myThid, ' read error for ',         WRITE(msgBuf,'(A,I4,A)') ' Thread ', myThid, ' error reading file'
349       &  fNam(iLo:iHi)         CALL PRINT_ERROR( msgBuf , 1)
350           WRITE(msgBuf,'(A,A,A)') ' "', fNam(iLo:iHi),'"'
351         CALL PRINT_ERROR( msgBuf , 1)         CALL PRINT_ERROR( msgBuf , 1)
352         IF ( eMode .EQ. errorModeSTOP ) THEN         IF ( eMode .EQ. errorModeSTOP ) THEN
353          STOP 'ABNORMAL END: S/R DFILE_READ_R4'          STOP 'ABNORMAL END: S/R DFILE_READ_R4'
# Line 427  C--   Check that file is active Line 428  C--   Check that file is active
428    899 CONTINUE    899 CONTINUE
429         WRITE(msgBuf,'(A)') ' S/R DFILE_READ_R8 '         WRITE(msgBuf,'(A)') ' S/R DFILE_READ_R8 '
430         CALL PRINT_ERROR( msgBuf , 1)         CALL PRINT_ERROR( msgBuf , 1)
431         WRITE(msgBuf,'(A,I4,A,A)') ' Thread ', myThid, ' read error for ',         WRITE(msgBuf,'(A,I4,A)') ' Thread ', myThid, ' error reading file'
432       &  fNam(iLo:iHi)         CALL PRINT_ERROR( msgBuf , 1)
433           WRITE(msgBuf,'(A,A,A)') ' "', fNam(iLo:iHi),'"'
434         CALL PRINT_ERROR( msgBuf , 1)         CALL PRINT_ERROR( msgBuf , 1)
435         IF ( eMode .EQ. errorModeSTOP ) THEN         IF ( eMode .EQ. errorModeSTOP ) THEN
436          STOP 'ABNORMAL END: S/R DFILE_READ_R8'          STOP 'ABNORMAL END: S/R DFILE_READ_R8'
# Line 545  C     ioUnit - Unit number for I/O Line 547  C     ioUnit - Unit number for I/O
547  C     msgBuf - Textual printing message buffer  C     msgBuf - Textual printing message buffer
548  C     eMode  - Error mode for this file handle  C     eMode  - Error mode for this file handle
549        INTEGER ioUnit        INTEGER ioUnit
550        CHARACTER(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
551        CHARACTER(MAX_LEN_FNAM) fNam        CHARACTER*(MAX_LEN_FNAM) fNam
552        INTEGER eMode        INTEGER eMode
553        INTEGER I        INTEGER I
554    
# Line 568  C--   Now write meta information Line 570  C--   Now write meta information
570         WRITE(msgBuf,'(A)') '// START OF META DATA'         WRITE(msgBuf,'(A)') '// START OF META DATA'
571         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
572    
573         WRITE(msgBuf,'(A,A)') ' id = ','/* Identifier */'         WRITE(msgBuf,'(A,A)') ' id =[ ','/* Identifier */'
574         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
575         CALL PRINT_LIST_I( fileId, 1, INDEX_NONE, ioUnit )         CALL PRINT_LIST_I( fileId, 1, INDEX_NONE, .FALSE., .TRUE., ioUnit )
576         WRITE(msgBuf,'(A)')   '    ;     '         WRITE(msgBuf,'(A)')   '   ];     '
577         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
578    
579         WRITE(msgBuf,'(A,A)') ' nDims = ','/* Number of dimensions */'         WRITE(msgBuf,'(A,A)') ' nDims =[ ','/* Number of dimensions */'
580         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
581         CALL PRINT_LIST_I( nDims, 1, INDEX_NONE, ioUnit )         CALL PRINT_LIST_I( nDims, 1, INDEX_NONE, .FALSE., .TRUE., ioUnit )
582         WRITE(msgBuf,'(A)')   '    ;     '         WRITE(msgBuf,'(A)')   '   ];     '
583         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
584    
585         WRITE(msgBuf,'(A,A)') ' dimList = ',         WRITE(msgBuf,'(A,A)') ' dimList =[ ',
586       &  '/* Global1, local min1, local max1, ... */'       &  '/* Global1, local min1, local max1, ... */'
587         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
588         DO I=1,nDims         DO I=1,nDims
589          CALL PRINT_LIST_I( dimList((I-1)*3+1), 3, INDEX_NONE, ioUnit )          CALL PRINT_LIST_I( dimList((I-1)*3+1), 3, INDEX_NONE, I.NE.nDims, .FALSE., ioUnit )
590         ENDDO         ENDDO
591         WRITE(msgBuf,'(A)')   '    ;     '         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         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
600    
601         WRITE(msgBuf,'(A)') '// END OF META DATA'         WRITE(msgBuf,'(A)') '// END OF META DATA'
# Line 667  C     ioUnit - Unit number for I/O Line 676  C     ioUnit - Unit number for I/O
676  C     msgBuf - Textual printing message buffer  C     msgBuf - Textual printing message buffer
677  C     eMode  - Error mode for this file handle  C     eMode  - Error mode for this file handle
678        INTEGER ioUnit        INTEGER ioUnit
679        CHARACTER(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
680        CHARACTER(MAX_LEN_FNAM) fNam        CHARACTER*(MAX_LEN_FNAM) fNam
681        INTEGER eMode        INTEGER eMode
682        INTEGER I        INTEGER I
683    
# Line 690  C--   Now write meta information Line 699  C--   Now write meta information
699         WRITE(msgBuf,'(A)') '// START OF META DATA'         WRITE(msgBuf,'(A)') '// START OF META DATA'
700         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
701    
702         WRITE(msgBuf,'(A,A)') ' id = ','/* Identifier */'         WRITE(msgBuf,'(A,A)') ' id =[ ','/* Identifier */'
703         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
704         CALL PRINT_LIST_I( fileId, 1, INDEX_NONE, ioUnit )         CALL PRINT_LIST_I( fileId, 1, INDEX_NONE, .FALSE., .TRUE., ioUnit )
705         WRITE(msgBuf,'(A)')   '    ;     '         WRITE(msgBuf,'(A)')   '   ];     '
706         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
707    
708         WRITE(msgBuf,'(A,A)') ' nDims = ','/* Number of dimensions */'         WRITE(msgBuf,'(A,A)') ' nDims =[ ','/* Number of dimensions */'
709         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
710         CALL PRINT_LIST_I( nDims, 1, INDEX_NONE, ioUnit )         CALL PRINT_LIST_I( nDims, 1, INDEX_NONE, .FALSE., .TRUE., ioUnit )
711         WRITE(msgBuf,'(A)')   '    ;     '         WRITE(msgBuf,'(A)')   '   ];     '
712         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
713    
714         WRITE(msgBuf,'(A,A)') ' dimList = ',         WRITE(msgBuf,'(A,A)') ' dimList =[ ',
715       &  '/* Global1, local min1, local max1, ... */'       &  '/* Global1, local min1, local max1, ... */'
716         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
717         DO I=1,nDims         DO I=1,nDims
718          CALL PRINT_LIST_I( dimList((I-1)*3+1), 3, INDEX_NONE, ioUnit )          CALL PRINT_LIST_I( dimList((I-1)*3+1), 3, INDEX_NONE, I.NE.nDims, .FALSE., ioUnit )
719         ENDDO         ENDDO
720           WRITE(msgBuf,'(A)')   '   ];     '
721           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
722    
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)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
727           WRITE(msgBuf,'(A)')   '   ];     '
728           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
729    
730         WRITE(msgBuf,'(A)') '// END OF META DATA'         WRITE(msgBuf,'(A)') '// END OF META DATA'
731         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
732         metaDataStatus(fileHandle,myThid) = metaDataWritten         metaDataStatus(fileHandle,myThid) = metaDataWritten
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22