PROGRAM TCPY
	IMPLICIT INTEGER*4 (A-Z)
	INCLUDE '($IODEF)'
	INCLUDE '($SSDEF)'
	BYTE		Z(64000)
	BYTE		BELL
	BYTE		FLAG
	CHARACTER*4	ALLMT0,ALLMT1
	INTEGER*4	IOSB$L(2)
	INTEGER*2	IOSB$W(4)
	EQUIVALENCE (IOSB$L(1),IOSB$W(1))
C	DATA	ALLMT0/'MTA0'/,ALLMT1/'MTB0'/
	BELL=7

	STATUS = SYS$ASSIGN( 'MTA0', INCHAN,, )
C	STATUS = SYS$ALLOC( ALLMT0,,,)
C	IF(STATUS.NE.SS$_NORMAL.AND.STATUS.NE.SS$_DEVALRALLOC)GO TO 9000

	STATUS = SYS$ASSIGN( 'MTB0', OUTCHAN,, )
C	STATUS = SYS$ALLOC( ALLMT1,,,)
C	IF(STATUS.NE.SS$_NORMAL.AND.STATUS.NE.SS$_DEVALRALLOC)GOTO 9000

	STATUS = SYS$QIOW(,%VAL(INCHAN),%VAL(IO$_REWIND),IOSB$L,,,,,,,,)
	IF(STATUS.NE.1) CALL LIB$SIGNAL(%VAL(STATUS))
	STATUS = SYS$QIOW(,%VAL(OUTCHAN),%VAL(IO$_REWIND),IOSB$L,,,,,,,,)
	IF(STATUS.NE.1) CALL LIB$SIGNAL(%VAL(STATUS))
	IF(IOSB$W(1).EQ.SS$_WRITLCK)GOTO 9100

	DO WHILE (.TRUE.)
	 STATUS = SYS$QIOW(,%VAL(INCHAN),%VAL(IO$_READVBLK),
     1	%REF(IOSB$L),,,%REF(Z),%VAL(64000),,,,)
	 IF(STATUS.NE.1) CALL LIB$SIGNAL(%VAL(STATUS))

	 IF(IOSB$W(1).EQ.SS$_ENDOFTAPE)CALL EXIT
	 IF(IOSB$W(1).EQ.SS$_ENDOFFILE)THEN
	  STATUS = SYS$QIOW(,%VAL(OUTCHAN),%VAL(IO$_WRITEOF),IOSB$L,,,,,,,,)
	  IF(STATUS.NE.1) CALL LIB$SIGNAL(%VAL(STATUS))
	  FLAG=FLAG+1
	  IF(FLAG.EQ.2)CALL EXIT
	 ELSE
	  FLAG=0
	  STATUS = SYS$QIOW(,%VAL(OUTCHAN),%VAL(IO$_WRITEVBLK),
     1		%REF(IOSB$L),,,%REF(Z),%VAL(IOSB$W(2)),,,,)
	  IF(STATUS.NE.1) CALL LIB$SIGNAL(%VAL(STATUS))
	  IF(IOSB$W(1).NE.1) CALL LIB$SIGNAL(%VAL(STATUS))
	 END IF

	END DO

9000	WRITE(6,9010)BELL
9010	FORMAT(/,1A1,'ERROR - Cannot allocate tape drive.'//)
	GOTO 9999
9100	WRITE(6,9110)BELL
9110	FORMAT(/,1A1,'ERROR - Cannot write to MTB0:  Please insert write
     1 ring.'//)
9999	CALL EXIT
	END