FTN4
      SUBROUTINE EOFRE(LU1,TAPE,HDR,TDCB,TDSZ,P5,IERR)
     +,92069-16197 REV.2013 790511
C 
C 
C*****************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED.
C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR
C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR
C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. 
C****************************************************************** 
C 
C 
C     SOURCE:    92069-18197
C     RELOC:     92069-16197
C 
C 
C****************************************************************:
C 
C 
C************************************************************ 
C EOFRE HANDLES AN EOF ON A TYPE 3 FILE.
C EOFRE DOES THESE THINGS:
C 1) REQUESTS THE USER TO ENTER THE NEXT STORAGE FILE NAME. 
C 2) OPENS THE FILE 
C 3) CHECKS THE TAPE HEADER INCLUDING THE REEL NUMBER.
C 4) RETURNS. 
C***********************************************************
C FORMAL PARAMETERS.
C 
      INTEGER LU1,TAPE(1),HDR(1),TDCB(1),TDSZ,P5(1),IERR
C*************************************************************
C LOCAL PARAMETERS. 
C 
      INTEGER FILE(24)
      INTEGER IA(2) 
      EQUIVALENCE (REG,IA),(IA(2),IB) 
C************************************************************** 
C PRINT OUT MESSAGES. 
C 
      CALL REIO(2,LU1,14H END OF FILE _,7)
      CALL REIO(2,LU1,TAPE,3) 
1000  CALL REIO(2,LU1,34H NEXT STORAGE FILE(AB TO ABORT)? _,17) 
      REG = REIO(1,LU1+400B,FILE,20)
      LNGTH2=2*IB 
      IF ((LNGTH2 .EQ. 2) .AND. (FILE .EQ. 2HAB)) GO TO 9000
C**************************************************************** 
C PARSE THE FILE NAME USER JUST ENTERED.
C 
      ISTRC=1 
      CALL PRAM(LU1,FILE,LNGTH2,ISTRC,TAPE) 
      IF (TAPE(4) .EQ. 3) GO TO 2000
      CALL REIO(2,LU1,26H PLEASE ENTER A FILE NAME.,13) 
      GO TO 1000
C***********************************************************
C HAVE A VALID ASCII STRING FOR FILE. OPEN THE FILE.
C 
2000  CALL ECLOS(TDCB,IERR) 
      CALL OPENF(TDCB,IERR,TAPE,0,TAPE(5),TAPE(6),TDSZ) 
      IF (IERR .GT. 0) IERR=0 
      CALL DBER2(LU1,IERR,TAPE,6HEOFRE ,2HXX) 
      IF (IERR .LT. 0) GO TO 1000 
C***********************************************************
C CHECK THE TAPE HEADER IN THE NEW FILE.
C 
      CALL EREAD(TDCB,IERR,FILE,24,LEN) 
      CALL DBER2(LU1,IERR,TAPE,6HEOFRE ,2HXX) 
      IF (IERR .LT. 0) GO TO 1000 
      CALL CKTHD(LU1,HDR,FILE,IERR) 
      IF (IERR .LT. 0) GO TO 1000 
      RETURN
C*************************************************************
C ABORT POINT.
C 
9000  CONTINUE
      CALL REIO(2,LU1,25H ABORTING AT END OF FILE.,-25) 
      IERR=-235 
      CALL DBER2(LU1,IERR,6HXXXXXX,6HEOFRE ,2HXX) 
      RETURN
      END 
                        