PROGRAM TCOPY
C
C----	Purpose:	Copy a foreign tape to tape
C
	IMPLICIT INTEGER*4(A-Z)
	CHARACTER*1 REPLY
	BYTE BUFFER
C
	INCLUDE '($SSDEF)'
	INCLUDE '($IODEF)'
C
	PARAMETER(RBYTES=64000)
	PARAMETER(NORMAL=1)
	PARAMETER(EOF=2)
	PARAMETER(EOT=3)
	PARAMETER(EOV=4)
	PARAMETER(DATACHECK=5)
	PARAMETER(PARITY=6)
	PARAMETER(OVERRUN=7)
	PARAMETER(ILUN=40)
	PARAMETER(OLUN=41)
	PARAMETER(NOWAIT=1)
	PARAMETER(NTRIES=4)
C
	DIMENSION BUFFER(RBYTES)
C
C----	Initialization
C
	NIPARITY = 0
	NOPARITY = 0
	NFILES   = 0
	NEOF     = 0
	NRECORDS = 0
	NOVERRUN = 0
	NIVOL    = 1
	NOVOL    = 1
	NOFATAL  = 0
	NIFATAL  = 0
C
C----	Operating instructions
C
	TYPE 1000
1000	FORMAT(//,' TCOPY operating procedure:',/,
	1      ' $ ALLOCATE MTAx: ITAPE',/,
	2      ' $ ALLOCATE MTAy: OTAPE',/,
	3      ' $ MOUNT/FOREIGN ITAPE',/,
	4      ' $ INITIALIZE/DENSITY=z OTAPE LABEL',/,
	5      ' $ MOUNT/FOREIGN/DENSITY=z OTAPE',/,
	6      ' $ RUN TCOPY',/)
C
C----	Connect logical units to the tape drives and check logical
C----	name assignments and devices mounted
C
	CALL SETUPFT(ILUN,'ITAPE',ISTATUS)
	CALL SETUPFT(OLUN,'OTAPE',OSTATUS)
	IF(ISTATUS .NE. NORMAL) GO TO 9990
	IF(OSTATUS .NE. NORMAL) GO TO 9990
C
C----	Read/Write loop
C
10	CONTINUE
	CALL RITAPE(ILUN,BUFFER,RBYTES,ABYTES,ISTATUS)
C
C----	Check input status
C
	IF(ISTATUS .EQ. NORMAL) THEN
	    NRECORDS = NRECORDS + 1
	    NEOF = 0
C
	ELSE IF(ISTATUS .EQ. PARITY) THEN
	    NRECORDS = NRECORDS + 1
	    NEOF = 0
	    NIPARITY = NIPARITY + 1
	    DO I = 1,NTRIES
		CALL SKIPREC(ILUN,-1,NSKIP,ISTATUS)
		CALL RITAPE(ILUN,BUFFER,RBYTES,ABYTES,ISTATUS)
		IF(ISTATUS .EQ. NORMAL) GO TO 15
	    ENDDO
	    NIFATAL = NIFATAL + 1
C
	ELSE IF(ISTATUS .EQ. OVERRUN) THEN
	    NRECORDS = NRECORDS + 1
	    NEOF = 0
	    NOVERRUN = NOVERRUN + 1
	    ABYTES = RBYTES
C
	ELSE IF(ISTATUS .EQ. EOF) THEN
	    NEOF = NEOF + 1
	    IF(NEOF .EQ. 2) THEN
		GO TO 900		!Done
	    ELSE
		NFILES = NFILES + 1
		CALL TAPE_EOF(OLUN,OSTATUS)
		EOF_FLAG = .TRUE.
		GO TO 20		!Write status check	    	    
	    ENDIF
C
	ELSE IF(ISTATUS .EQ. EOT) THEN
	    NRECORDS = NRECORDS + 1
	    NEOF = 0
	    NIVOL = NIVOL + 1
	    CALL UNLOAD(ILUN,ISTATUS,NOWAIT)
	    TYPE 1001, NIVOL
1001	    FORMAT(//,' Mount input volume # ',I2,
	1          '; press return when ready')
	    ACCEPT 1002, REPLY
1002	    FORMAT(A)
C
	ELSE IF(ISTATUS .EQ. EOV) THEN
	    GO TO 900			!Done
	ENDIF
C
C----	Copy record to output
C
15	CONTINUE
	CALL WITAPE(OLUN,BUFFER,ABYTES,WBYTES,OSTATUS)
	EOF_FLAG = .FALSE.
C
C----	Check output status
C
20	CONTINUE
	IF(OSTATUS .EQ. NORMAL) THEN
	    CONTINUE
C
	ELSE IF(OSTATUS .EQ. DATACHECK) THEN
	    NOPARITY = NOPARITY + 1
	    DO I = 1,NTRIES
		CALL SKIPREC(OLUN,-1,NSKIP,OSTATUS)
		IF(EOF_FLAG .EQ. .TRUE.) THEN
		    CALL TAPE_EOF(OLUN,OSTATUS)
		ELSE
		    CALL WITAPE(OLUN,BUFFER,ABYTES,WBYTES,OSTATUS)
		ENDIF
		IF(OSTATUS .EQ. NORMAL) GO TO 10
	    ENDDO
	    NOFATAL = NOFATAL + 1
C
	ELSE IF(OSTATUS .EQ. EOT) THEN
	    NOVOL = NOVOL + 1
	    CALL UNLOAD(OLUN,OSTATUS,NOWAIT)
	    TYPE 1003, NOVOL
1003	    FORMAT(//,' Mount output volume # ',I2,
	1          '; press return when ready')
	    ACCEPT 1002, REPLY
	ENDIF
C
C----	Re-loop for next record
C
	GO TO 10
C
C----	Normal termination due to EOV status return from RITAPE or
C----	double EOFs detected here.
C
900	CONTINUE
C
	TYPE 1004, NRECORDS,NFILES,NIVOL,NOVOL,NIPARITY,NOPARITY,
	1          NIFATAL,NOFATAL,NOVERRUN
1004	FORMAT(//,' Tape copy operation complete:',/,
	1 I10, ' records',/,
	2 I10, ' files',/,
	3 I10, ' input volumes',/,
	4 I10, ' output volumes',/,
	5 I10, ' recoverable input errors',/,
	6 I10, ' recoverable output errors',/,
	7 I10, ' non-recoverable input errors',/,
	8 I10, ' non-recoverable output errors',/,
	9 I10, ' input buffer overruns',/)
C
	STOP
C
C----	Abnormal termination due to logical names or
C----	tape(s) improperly mounted
C
9990	CONTINUE
	TYPE 1005
1005	FORMAT(' Logical names not properly assigned,',/,
	1      ' or tape(s) not properly mounted; abnormal termination')
C
	STOP
	END