C
C     MAG TAPE MUST BE MOUNTED AS A 'FOREIGN VOLUMN'
C
      DIMENSION IBUF(16384),ISTAT(2),IPRM(6)
      LOGICAL*1 JBUF(8192),NFILE(30)
      EQUIVALENCE (IBUF,JBUF)
C
      IOATT="1400
      IODET="2000
      IORLB="1000
      IORWD="2400
      IOSKIP="2440
      IEDAO="363
      IEEOF="366
      ISIZE=32766
      ITI=5
      IMT0=4
      IOUT=3
      CALL GETADR(IPRM,IBUF)
      IPRM(2)=ISIZE
C
      CALL WTQIO(IOATT,IMT0,1,50,ISTAT)
C
      CALL WTQIO(IORWD,IMT0,1,50,ISTAT)
C
100   WRITE(ITI,4000)
4000  FORMAT(/,'$ENTER OUTPUT FILE NAME    ? ')
      READ(ITI,4100) NF,NFILE
4100  FORMAT(Q,30A1)
      IF(NF.EQ.0) GOTO 6000
      CALL ASSIGN(IOUT,NFILE,NF)
      WRITE(ITI,4200)
4200  FORMAT('$NUMBER OF RECORDS TO COPY ? ')
      READ(ITI,4300) NCOPY
4300  FORMAT(I5)
      ICOPY=0
      JCOPY=0
C
      DO 5000 IREC=1,NCOPY
      CALL WTQIO(IORLB,IMT0,1,50,ISTAT,IPRM,ISW)
      IF(ISTAT(1).EQ.1)GOTO 400
      IF(ISTAT(1).EQ.IEDAO) WRITE(ITI,200)
  200 FORMAT(' RECORD SIZE EXCEEDED BUFFER, DATA LOST',/)
      IF(ISTAT(1).EQ.IEDAO) GOTO 5000
      IF(ISTAT(1).EQ.IEEOF) WRITE(ITI,300)
  300 FORMAT(' END OF FILE DURING READ',/)
  400 ICOPY=ICOPY+1
      WRITE(IOUT,900) ISTAT(2)
  900 FORMAT(1X,I6)
      WRITE(IOUT,1000) (JBUF(I),I=1,ISTAT(2))
 1000 FORMAT(128A1)
      JCOPY=JCOPY+((ISTAT(2)+127)/128)+1
      IF(ISTAT(1).EQ.IEEOF) GOTO 5200
5000  CONTINUE
5200  CALL CLOSE(IOUT)
      WRITE(ITI,7000) ICOPY,JCOPY
7000  FORMAT(/,1X,I8,' RECORDS READ',10X,I8,' RECORDS WRITTEN')
      GOTO 100
C
6000  STOP 'ALL DONE'
      END
