FTN4,L
       SUBROUTINE WREOT(ITTY,MTLU,IHDR,IBUF,ISIZE 
     X),92067-1X550 REV.2001 791101 
C*****************************************************************
C*                                                               *
C*  (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS       *
C*  RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,        *
C*  REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE     *
C*  WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD     *
C*  COMPANY.                                                     *
C*                                                               *
C*****************************************************************
C 
C     NAME:  WREOT
C   SOURCE:  92067-18550  
C    RELOC:  PART OF 92067-12003
C     PGMR:  J.S.W
C 
       DIMENSION IHDR(1),IBUF(1)
C 
C 
C 
C PUMP TAPE NUMBER
C 
10    IHDR(247)=IHDR(247)+1 
C 
      CALL EXEC(2,ITTY,11HEND OF TAPE,-11)
      CALL EXEC(2,ITTY,15HMOUNT NEXT TAPE,-15)
100   CALL EXEC(2,ITTY,32HTYPE "GO,<PROG-NAM>" TO CONTINUE,-32) 
C 
C 
      PAUSE 
C 
120   CALL EXEC(13,MTLU,IEQT5)
      IF(IAND(IEQT5,40000B).EQ.0) GO TO 150 
      CALL EXEC(2,ITTY,10HMT LU DOWN,-10) 
      GO TO 100 
C 
C 
150   CALL EXEC(3,600B+MTLU)
      CALL ABREG(IA,IB) 
      IF(IAND(IA,4B).EQ.4) GO TO 900
      IF(IAND(IA,1).NEQ.0) GO TO 950
C 
      CALL EXEC(2,MTLU,IHDR,247)
      CALL EXEC(2,MTLU,IBUF,ISIZE)
      CALL ABREG(IA,IB) 
      IF(IAND(IA,40B).EQ.40B) GO TO 10
       RETURN 
C 
C 
900   CALL EXEC(2,ITTY,18HWRITE RING MISSING,-18) 
      GO TO 100 
950   CALL EXEC(2,ITTY,17HMAG TAPE OFF-LINE,-17)
      GO TO 100 
       END
       END$ 
                                                                            