home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l320 / 2.img / EXAMPLES / BINREAD.F < prev    next >
Encoding:
Text File  |  1989-09-28  |  6.3 KB  |  180 lines
  1. c This is an example of how to read sequentially from a file
  2. c without the bothersome 4-byte header and footer information.
  3. c Written by David Rapier, MicroWay, Inc.
  4. c Permission to use text and ideas in this file is granted.
  5. c
  6.     Program noheader
  7.  
  8. c L is the size of the buffer being used in the direct access file.
  9. c It may be set to any number.  The larger L is, the fewer times
  10. c the disk will be read.  The smaller L is, the less the file will
  11. c need to be padded at the end (the file should be padded with
  12. c blanks at the end).
  13. c
  14.     Parameter (L=512)
  15.  
  16. c The program will read three pieces of information from the file:
  17. c a 400-byte string, a 200-byte string, and a 10-byte number.
  18. c These are just examples -- the subroutine will handle any size
  19. c string.
  20. c
  21.     character*400 A400
  22.     character*200 A200
  23.     character*10  A10
  24.  
  25. c The open statement may be on any legal unit number.
  26. c It must include ACCESS='DIRECT' and RECL=L.
  27. c This example takes the FORT.7 file made with the BIN_WRITE example.
  28. c
  29.     open (1,file='fort.7',status='old',access='direct',recl=L)
  30.  
  31. c Reading character strings from the file is straightforward.
  32. c Pass the number of the file (must be the same throughout)
  33. c and a string of the length to be read.
  34. c
  35.     Call BIN_READ(1,a400)
  36.     Call BIN_READ(1,a200)
  37.     Print 80, "A400", A400(1:50)
  38.     Print 80, "A200", A200(1:50)
  39. 80    Format (' ',a4, ' = ', a50)
  40.  
  41. c To read numbers to the file, read a string first.
  42. c
  43.     Call BIN_READ(1,a10)
  44.  
  45. c Then get the number using an internal read statement.
  46. c
  47.     Read(A10,*) X
  48.     Print * ' X =', X
  49.  
  50.     Close (7)
  51.     End
  52.  
  53. c---------------------------------------------------------------c
  54. c Subroutine BIN_READ handles all READs from the designated file.
  55. c Input arguments:  FILENUM = Integer*4, file number.
  56. c                   CHARSTR = Character string to be read into.
  57. c
  58. c Variables: BUFFER  = Character string buffer
  59. c            CONNECT = Connect status to ensure FILENUM is really open.
  60. c            FILECONST Check to ensure that FILENUM is the same
  61. c                      throughout the program.
  62. c            IO      = Check during read to ensure IOSTAT is okay.
  63. c            L       = Length of buffer.  Same as in main program.
  64. c            LENGTH  = Length of character string passed.
  65. c            NUMBER  = Number of times this routine is called.
  66. c            POINTER = Shows place in buffer.
  67. c            RECORD  = Number of record presently being read from.
  68. c            TEMP    = Temporary pointer during read.
  69. c
  70. c Output:    Incoming arguments are never changed.
  71. c            Either the read will occur or program will halt.
  72. c
  73.     Subroutine    BIN_READ( FILENUM,CHARSTR )
  74.     Parameter     (L=512)
  75.     Integer*4     POINTER, NUMBER, LENGTH, RECORD, IO, TEMP
  76.     Integer*4     FILENUM, FILECONST
  77.     Character*(L) BUFFER
  78.     Character*(*) CHARSTR
  79.     Logical*4     CONNECT
  80.     Data POINTER, NUMBER, RECORD, FILECONST / (L), 0, 0, 0 /
  81.  
  82. c Increment number of times routine is called.  This variable is used
  83. c in error messages to help debug the main program.
  84. c
  85.     NUMBER = NUMBER + 1
  86.  
  87. c Although LENGTH starts out as the length of the string, it ends
  88. c up as the length remaining to read, if the string is larger than
  89. c the buffer being read from.
  90. c
  91.     LENGTH = len(CHARSTR)
  92.  
  93. c FILENUM will differ from FILECONST in two situations.
  94. c (1) First time the subroutine is called.
  95. c     If FILECONST=0 this is true.  In this case,
  96. c     FILECONST is set equal to FILENUM and the status of the
  97. c     file number is checked.  If the file is not open, a message
  98. c     is given and the file is properly opened, with default
  99. c     file name.
  100. c (2) User is trying to use subroutine for TWO file numbers.
  101. c     In this case, an error message is given with information to
  102. c     help the programmer find the problem.
  103. c
  104.     If (FILENUM.ne.FILECONST) then
  105.       If (FILECONST.eq.0) then
  106.         FILECONST = FILENUM
  107.         Inquire(FILENUM,opened=CONNECT)
  108.         If (.not. CONNECT) then
  109.           Print "(' *** OPENING FILE #',i4,'***')", FILENUM
  110.           Print "(' [Call #   1 of BIN_READ]')"
  111.           Open(FILENUM, Status='Direct',Recl=L)
  112.          End if
  113.        else
  114.         Print "(' This subroutine is designed to allow binary')"
  115.         Print "(' access to ONE file number only.  File number')"
  116.         Print "(' is INCONSISTANT on call number',i4)", NUMBER
  117.         Print "(' of BIN_READ.  Please change program.')"
  118.         Print "(' File number     =',i4)", FILENUM
  119.         Print "(' Number expected =',i4)", FILECONST
  120.         Stop
  121.        End if
  122.      End if
  123.  
  124. c These lines check to ensure the file is still open.
  125. c If the file is closed, it will be reopened using a default
  126. c file name and a warning message will be given.
  127. c
  128.     inquire(FILENUM,opened=CONNECT)
  129.     if (.NOT. CONNECT) then
  130.       Print "(' *** REOPENING FILE #',i4,'***')", FILENUM
  131.       Print "(' [Call #',i4,'of BIN_WRITE]')", NUMBER
  132.       Open(FILENUM, Status='Direct',Recl=L)
  133.      End If
  134.  
  135. c TEMP is the amount of CHARSTR already filled.
  136. c TEMP + LENGTH will always be the length of CHARSTR.
  137. c
  138.     TEMP = 0
  139.  
  140. c POINTER is how much buffer is already read from.
  141. c L - POINTER is how much buffer is left.
  142. c If LENGTH is greater than L-POINTER, part of BUFFER
  143. c is read into CHARSTR, BUFFER is read from disk, and
  144. c the comparison is made again.  All reads are checked for
  145. c I/O error flags and ERR flags.  The END flag is not checked
  146. c since it is possible that the buffer will exceed the file size.
  147. c
  148.     do 10 while (LENGTH.gt.L-POINTER)
  149.       If (POINTER.lt.L) then
  150.         CHARSTR(TEMP+1:TEMP+L-POINTER) = BUFFER(POINTER+1:L)
  151.         TEMP = TEMP+L-POINTER
  152.         LENGTH = LENGTH-L+POINTER
  153.        end if
  154.       RECORD = RECORD+1
  155.       Read (FILENUM, iostat=IO, err=100, rec=RECORD) BUFFER
  156.       If (IO .ne. 0) GoTo 101
  157.       POINTER = 0
  158. 10     Continue
  159.  
  160. c By this point, the amount left in BUFFER is sufficient to fill
  161. c CHARSTR.
  162. c
  163.     CHARSTR(TEMP+1:TEMP+LENGTH) = BUFFER(POINTER+1:POINTER+LENGTH)
  164.     POINTER = POINTER+LENGTH
  165.     Return
  166.  
  167. c These are diagnostic lines in case any read statement
  168. c gives an error.
  169. c
  170. 101    Print "(' IOSTAT ERROR.  IOSTAT =',i4)",   IOSTAT
  171. 100    Print "(' Error in invocation #',i4,$)",   NUMBER
  172.     Print "(' of READ from File #',i4,':')" ,  FILENUM
  173.     Print "(' Record #',i4,', Pointer =',i4)", RECORD, POINTER
  174.     Print "(' Length =',i4,', ',$)",           LEN(CHARSTR)
  175.     Print "(' Remaining length =',i4)",        LENGTH
  176.     Print "(' Buffer size =',i4,', ',$)",      L
  177.     Print "(' TEMP =',i4)",                    TEMP
  178.     Stop
  179.     End
  180.