PROGRAM TAPCPY
C
C	THIS PROGRAM WILL COPY FROM ONE TAPE DRIVE TO THE OTHER.
C
C	MODIFIED BY:
C	RAC001(11/13/81) - ALLOWED BYTE REVERSAL FOR READING OF IBM TAPES
C	RAC002(11/13/81) - ALLOWED FOR CONTINUING AFTER A READ ERROR
C
	PARAMETER BUFSIZ=8192
	LOGICAL*1 END,SWBYTE,MT
	BYTE FORMIN,FORMOT,ANS,RW,BR,BUFFTB(BUFSIZ)
	INTEGER BUFFIN(BUFSIZ/2),ISTAT(2),STATUS,LUNIN,LUNOUT
	INTEGER BUFFOT(BUFSIZ/2),DENSIN,DENSOT
	INTEGER UNITIN,UNITOT
	INTEGER EOF,EOV
	EQUIVALENCE (BUFFTB,BUFFOT)
	DATA LUNIN/1/LUNOUT/2/
	DATA EOF/"366/EOV/"365/
C
C	START OF MAIN CODE
C
	CALL ASNLUN(3,'TI',0)			!LINK TO TERMINAL
	WRITE(3,200)				!WRITE PROMPT
	READ(3,*)UNITIN,UNITOT			!GET FROM,TO UNITS
	WRITE(3,202)				!ASK WHICH OUTPUT
	READ(3,203)FORMIN,FORMOT		!GET FORM
5	WRITE(3,204)
	READ(3,*)DENSIN,DENSOT			!GET DENSITIES
	IF((DENSIN.NE.1600.AND.DENSIN.NE.800)	!
	1.OR.(DENSOT.NE.1600.AND.DENSOT.NE.800))!
	2	GO TO 5				!IT HAS TO BE RIGHT
	WRITE(3,225)				!RAC001 SWITCH BYTES?
	READ(3,207)BR				!RAC001 GET REPLY
	SWBYTE=.FALSE.				!RAC001 FALSE IF NO SWITCH
	IF(BR.EQ.'Y')SWBYTE=.TRUE.		!RAC001 TRUE IF SWITCH
	CALL ASNLUN(LUNIN,'MM',UNITIN)		!LINK INPUT UNITS
	CALL ASNLUN(LUNOUT,'MM',UNITOT)		!LINK OUTPUT UNIT
	ISIZE=BUFSIZ				!INITIALIZE TO FIND DENSITY
	CALL TAPEIO(1,LUNIN,ISTAT,BUFFIN,ISIZE)	!READ ONE BLOCK
	CALL TAPEIO(7,LUNIN,ISTAT)		!GET INPUT SPECIFICATION
	INSTAT=ISTAT(2)				!SAVE IN STATUS
	CALL TAPEIO(3,LUNIN,ISTAT)		!REWIND TO BOT
	IF(((INSTAT .AND. 2048) .EQ. 2048)	!
	1 .AND. DENSIN .EQ. 800)WRITE(3,100)	!IF 1600 TELL USER
	IF(((INSTAT .AND. 2048) .NE. 2048)	!
	1 .AND. DENSIN .EQ. 1600)WRITE(3,205)	!IF 800 TELL USER
	IF((INSTAT .AND. 2048) .EQ. 2048)	!WHAT IT REALLY IS
	1 DENSIN=1600				!MAKE CORRECTION
	IF((INSTAT .AND. 2048) .NE. 2048)	!WHAT IT REALLY IS
	1 DENSIN=800				!MAKE CORRECTION
	BUFFIN(1)=((DENSOT-800)/800)*2048	!SET THE OUTPUT DENSITY
10	IF(DENSIN .NE. DENSOT)WRITE(3,206)	!.NE., WANT THEM .EQ.?
	IF(DENSIN .NE. DENSOT)READ(3,207)ANS	!YES OR NO
	IF((DENSIN .NE. DENSOT) .AND.
	1(ANS .NE. 'Y' .AND. ANS .NE. 'N'))GO TO 10
	IF((DENSIN .NE. DENSOT) .AND.
	1(ANS .EQ. 'N'))GO TO 15		!DON'T MAKE EQUAL
	BUFFIN(1)=INSTAT			!MAKE OUTPUT DENSITY
	ISTAT(2)=0				!..SAME AS INPUT DENSITY
15	CALL TAPEIO(6,LUNOUT,ISTAT,BUFFIN)	!SET OUTPUT DENSITY 
	CALL TAPEIO(3,LUNIN,ISTAT)		!REWIND INP
	CALL TAPEIO(3,LUNOUT,ISTAT)		!REWIND OUTP
	ISIZE=BUFSIZ				!INITILIZE BUFFER SIZE
19	END=.FALSE.				!INIT EOF FLAG
20	CALL TAPEIO(1,LUNIN,ISTAT,BUFFIN,ISIZE)	!READ RECORD
	IF(FORMIN.EQ.'A'.AND.FORMOT.EQ.'A')
	1CALL EXCHNG(BUFFOT,BUFFIN,BUFSIZ)	!NO CONVERT
	IF(FORMIN.EQ.'E'.AND.FORMOT.EQ.'E')
	1CALL EXCHNG(BUFFOT,BUFFIN,BUFSIZ)	!NO CONVERT
	IF(FORMIN.EQ.'E'.AND.FORMOT.EQ.'A')
	1CALL EBTASC(BUFFIN,BUFFOT,BUFSIZ)	!CONVERT E TO A
	IF(FORMIN.EQ.'A'.AND.FORMOT.EQ.'E')
	1CALL ASCTEB(BUFFIN,BUFFOT,BUFSIZ)	!CONVERT A TO E
	IF(ISTAT(1).NE.1)GO TO 500		!IF ERROR GO TO ERROR TRAP
	IF(ISTAT(2).GT.BUFSIZ)GO TO 500		!IF OVERFLOW GO TO E.T.
	IF(ISTAT(2).EQ.0)GO TO 20		!IF NOTHING READ DO AGAIN
	ISIZE=ISTAT(2)				!SET SIZE FOR OUTP
	CALL CKARRA(BUFFIN,ISIZE,MT)
	IF(MT)GO TO 500				!IF EMPTY GO ERROR
	IF(.NOT.SWBYTE)GOTO 31			!RAC001  SKIP IF NO BYTE REV.
	DO 30 I=1,ISIZE,2			!RAC001  DO REVERSAL:
	BYTE=BUFFTB(I)				!RAC001
	BUFFTB(I)=BUFFTB(I+1)			!RAC001
	BUFFTB(I+1)=BYTE			!RAC001
30	CONTINUE				!RAC001
31	CONTINUE				!RAC001
	CALL TAPEIO(2,LUNOUT,ISTAT,BUFFOT,ISIZE)!OUTPUT RECORD
	ISIZE=BUFSIZ				!RESET BUFFER SIZE
	IF(ISTAT(1).NE.1)GO TO 500		!IF ERR GO TO E. T.
	GO TO 20				!DO AGAIN
500	IF(ISTAT(1).EQ.EOF.OR.ISTAT(1).EQ.EOV)GO TO 510!CHECK FOR NON ERROR
	IF(MT)WRITE(3,10002)
	WRITE(3,101)ISTAT			!INFORM USER OF ERROR
	GO TO 900				!TELL HIM MORE IF WE KNOW
510	ISIZE=ISTAT(2)				!GET SIZE RETURNED
	STATUS=ISTAT(1)				!GET STATUS RETURNED
	IF(ISIZE.NE.0)CALL TAPEIO(2,LUNOUT,ISTAT,BUFFOT,ISIZE)!FINISH OUT BLOCK
D	WRITE(3,*)'EOF FOUND'			!DEBUG INFORMATION
	CALL TAPEIO(5,LUNOUT,ISTAT)		!WRITE EOF MARKER
D	IF(STATUS.EQ.EOV)WRITE(3,*)'EOV FOUND'	!DEBUG INFORMATION
D	IF((STATUS.EQ.EOF)  .AND.
D	1  (ISIZE .EQ. 0 )  .AND.
D	2  END)				GOTO 600!WE ARE FINISHED
	IF((STATUS.EQ.EOF)  .AND.
	1  (ISIZE .NE. 0 )  .AND.
	2  END)				GOTO 19	!GOT SOME SO NOT FINISHED
	ISIZE=BUFSIZ				!REESTABLISH BUFFER SIZE
	IF(STATUS.EQ.EOF)END=.TRUE.		!IF EOF, SET EOF FLAG
	IF(STATUS.NE.EOV)GO TO 20		!MORE IF MORE TO DO
C
C	WE GOT END OF TAPE (TWO EOF MARKERS IN A ROW)
C
600	WRITE(3,201)				!TELL USER WE ARE FINIT
	CALL TAPEIO(3,LUNIN,ISTAT)		!REWIND INP
	CALL TAPEIO(3,LUNOUT,ISTAT)		!REWIND OUTP
	GO TO 1000
C
C	ERRORS TRAP TO HERE		E. T.
C
900	IF(ISTAT(1).EQ."374)WRITE(3,102)
	IF(ISTAT(1).EQ."364)WRITE(3,103)
	IF(ISTAT(1).EQ."363)WRITE(3,104)
	IF(ISTAT(1).EQ."360)WRITE(3,105)
	IF(ISTAT(1).EQ."330)WRITE(3,106)
	IF(ISTAT(1).EQ."302)WRITE(3,107)
	IF(ISTAT(1).EQ."276)WRITE(3,108)
	IF(ISTAT(1).EQ."264)WRITE(3,109)
	IF(ISTAT(1).EQ."375)WRITE(3,110)
	WRITE(3,230)				!RAC002  CONTINUE?
	READ(3,207)ANS				!RAC002  GET REPLY
	IF(ANS.EQ.'Y')GOTO 20			!RAC002
1000	CALL EXIT
100	FORMAT(1X,'INPUT TAPE IS 1600 bpi')
101	FORMAT(1X,'STATUS=',O3,2X,'BYTE COUNT=',I4)
102	FORMAT(1X,'PARITY ERROR')
103	FORMAT(1X,'WRITE LOCKED')
104	FORMAT(1X,'DATA OVERRUN')
105	FORMAT(1X,'PRIVILEGE VIOLATION')
106	FORMAT(1X,'ILLEGAL RECORD SIZE')
107	FORMAT(1X,'END OF TAPE FOUND')
108	FORMAT(1X,'CRC ERROR')
109	FORMAT(1X,'BAD TAPE FORMAT')
110	FORMAT(1X,'DEVICE NOT READY')
200	FORMAT('$','UNIT IN,UNIT OUT: ')
201	FORMAT(1X,'TAPCPY -- DONE')
202	FORMAT('$','FORM INPUT,FORM OUTPUT (A/E): ')
203	FORMAT(A1,1X,A1)
204	FORMAT('$','DENSITY INPUT, DENSITY OUTPUT (800/1600): ')
205	FORMAT(1X,'INPUT TAPE IS 800 bpi')
206	FORMAT('$','DENSITY IN .NE. DENSITY OUT',
	1', MAKE EQUAL? (Y/N): ')
207	FORMAT(A1)
220	FORMAT('$REWIND TAPES? [Y/N] ')
225	FORMAT('$USE BYTE REVERSAL? [Y/N] ')
230	FORMAT('$CONTINUE? [Y/N] ')
10002	FORMAT(' BUFFER EMPTY')
	END
	SUBROUTINE CKARRA(A,N,EMPTY)
	LOGICAL*1 EMPTY
	BYTE A(N)
	MT=.FALSE.
	DO 10,I=1,N
	IF(A(I).NE.0.OR.A(I).NE.255)RETURN
10	CONTINUE
	MT=.TRUE.
	RETURN
	END
	SUBROUTINE EXCHNG(BUFFOT,BUFFIN,BUFSIZ)
	INTEGER BUFFOT,BUFFIN,BUFSIZ
	DIMENSION BUFFOT(BUFSIZ/2),BUFFIN(BUFSIZ/2)
	DO 10,I=1,BUFSIZ/2
	BUFFOT(I)=BUFFIN(I)
10	CONTINUE
	RETURN
	END