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