c This is an example of how to read sequentially from a file
c without the bothersome 4-byte header and footer information.
c Written by David Rapier, MicroWay, Inc.
c Permission to use text and ideas in this file is granted.
c
	Program noheader

c L is the size of the buffer being used in the direct access file.
c It may be set to any number.  The larger L is, the fewer times
c the disk will be read.  The smaller L is, the less the file will
c need to be padded at the end (the file should be padded with
c blanks at the end).
c
	Parameter (L=512)

c The program will read three pieces of information from the file:
c a 400-byte string, a 200-byte string, and a 10-byte number.
c These are just examples -- the subroutine will handle any size
c string.
c
	character*400 A400
	character*200 A200
	character*10  A10

c The open statement may be on any legal unit number.
c It must include ACCESS='DIRECT' and RECL=L.
c This example takes the FORT.7 file made with the BIN_WRITE example.
c
	open (1,file='fort.7',status='old',access='direct',recl=L)

c Reading character strings from the file is straightforward.
c Pass the number of the file (must be the same throughout)
c and a string of the length to be read.
c
	Call BIN_READ(1,a400)
	Call BIN_READ(1,a200)
	Print 80, "A400", A400(1:50)
	Print 80, "A200", A200(1:50)
80	Format (' ',a4, ' = ', a50)

c To read numbers to the file, read a string first.
c
	Call BIN_READ(1,a10)

c Then get the number using an internal read statement.
c
	Read(A10,*) X
	Print * ' X =', X

	Close (7)
	End

c---------------------------------------------------------------c
c Subroutine BIN_READ handles all READs from the designated file.
c Input arguments:  FILENUM = Integer*4, file number.
c                   CHARSTR = Character string to be read into.
c
c Variables: BUFFER  = Character string buffer
c            CONNECT = Connect status to ensure FILENUM is really open.
c            FILECONST Check to ensure that FILENUM is the same
c                      throughout the program.
c            IO      = Check during read to ensure IOSTAT is okay.
c            L       = Length of buffer.  Same as in main program.
c            LENGTH  = Length of character string passed.
c            NUMBER  = Number of times this routine is called.
c            POINTER = Shows place in buffer.
c            RECORD  = Number of record presently being read from.
c            TEMP    = Temporary pointer during read.
c
c Output:    Incoming arguments are never changed.
c            Either the read will occur or program will halt.
c
	Subroutine    BIN_READ( FILENUM,CHARSTR )
	Parameter     (L=512)
	Integer*4     POINTER, NUMBER, LENGTH, RECORD, IO, TEMP
	Integer*4     FILENUM, FILECONST
	Character*(L) BUFFER
	Character*(*) CHARSTR
	Logical*4     CONNECT
	Data POINTER, NUMBER, RECORD, FILECONST / (L), 0, 0, 0 /

c Increment number of times routine is called.  This variable is used
c in error messages to help debug the main program.
c
	NUMBER = NUMBER + 1

c Although LENGTH starts out as the length of the string, it ends
c up as the length remaining to read, if the string is larger than
c the buffer being read from.
c
	LENGTH = len(CHARSTR)

c FILENUM will differ from FILECONST in two situations.
c (1) First time the subroutine is called.
c     If FILECONST=0 this is true.  In this case,
c     FILECONST is set equal to FILENUM and the status of the
c     file number is checked.  If the file is not open, a message
c     is given and the file is properly opened, with default
c     file name.
c (2) User is trying to use subroutine for TWO file numbers.
c     In this case, an error message is given with information to
c     help the programmer find the problem.
c
	If (FILENUM.ne.FILECONST) then
	  If (FILECONST.eq.0) then
	    FILECONST = FILENUM
	    Inquire(FILENUM,opened=CONNECT)
	    If (.not. CONNECT) then
	      Print "(' *** OPENING FILE #',i4,'***')", FILENUM
	      Print "(' [Call #   1 of BIN_READ]')"
	      Open(FILENUM, Status='Direct',Recl=L)
	     End if
	   else
	    Print "(' This subroutine is designed to allow binary')"
	    Print "(' access to ONE file number only.  File number')"
	    Print "(' is INCONSISTANT on call number',i4)", NUMBER
	    Print "(' of BIN_READ.  Please change program.')"
	    Print "(' File number     =',i4)", FILENUM
	    Print "(' Number expected =',i4)", FILECONST
	    Stop
	   End if
	 End if

c These lines check to ensure the file is still open.
c If the file is closed, it will be reopened using a default
c file name and a warning message will be given.
c
	inquire(FILENUM,opened=CONNECT)
	if (.NOT. CONNECT) then
	  Print "(' *** REOPENING FILE #',i4,'***')", FILENUM
	  Print "(' [Call #',i4,'of BIN_WRITE]')", NUMBER
	  Open(FILENUM, Status='Direct',Recl=L)
	 End If

c TEMP is the amount of CHARSTR already filled.
c TEMP + LENGTH will always be the length of CHARSTR.
c
	TEMP = 0

c POINTER is how much buffer is already read from.
c L - POINTER is how much buffer is left.
c If LENGTH is greater than L-POINTER, part of BUFFER
c is read into CHARSTR, BUFFER is read from disk, and
c the comparison is made again.  All reads are checked for
c I/O error flags and ERR flags.  The END flag is not checked
c since it is possible that the buffer will exceed the file size.
c
	do 10 while (LENGTH.gt.L-POINTER)
	  If (POINTER.lt.L) then
	    CHARSTR(TEMP+1:TEMP+L-POINTER) = BUFFER(POINTER+1:L)
	    TEMP = TEMP+L-POINTER
	    LENGTH = LENGTH-L+POINTER
	   end if
	  RECORD = RECORD+1
	  Read (FILENUM, iostat=IO, err=100, rec=RECORD) BUFFER
	  If (IO .ne. 0) GoTo 101
	  POINTER = 0
10	 Continue

c By this point, the amount left in BUFFER is sufficient to fill
c CHARSTR.
c
	CHARSTR(TEMP+1:TEMP+LENGTH) = BUFFER(POINTER+1:POINTER+LENGTH)
	POINTER = POINTER+LENGTH
	Return

c These are diagnostic lines in case any read statement
c gives an error.
c
101	Print "(' IOSTAT ERROR.  IOSTAT =',i4)",   IOSTAT
100	Print "(' Error in invocation #',i4,$)",   NUMBER
	Print "(' of READ from File #',i4,':')" ,  FILENUM
	Print "(' Record #',i4,', Pointer =',i4)", RECORD, POINTER
	Print "(' Length =',i4,', ',$)",           LEN(CHARSTR)
	Print "(' Remaining length =',i4)",        LENGTH
	Print "(' Buffer size =',i4,', ',$)",      L
	Print "(' TEMP =',i4)",                    TEMP
	Stop
	End
