C       COPYI.FTN        04-11-79  MRF     RSX11M
	PROGRAM COPYI
C       FAST COPY BLOCK IO  PROGRAM TO DEMONSTRATE THE USE OF
C       PARSE  TO PARSE FILE NAME INTO FILE DESCRIPTOR BLOCK
C       FIND   TO FIND A FILE AND FETCH FILE ID. IF IT EXITS
C       OFNB   TO OPEN A FILE BY FILE NAME BLOCK
C       OFID   TO OPEN A FILE BY FILE ID.
C       DABRD  TO READ A FILE USING BLOCK I/O FIVE BLOCKS AT A TIME.
C       DABWT  TO WRITE A FILE USING BLOCK I/O FIVE BLOCKS AT A TIME.
C       COPY A FILE FROM SOURCE TO DESTINATION WHERE DESTINATION'S SUPERCEEDED
C       NAME & NAMED ARE ASCII FILE NAMES TERMINATED BY A ZERO.
	LOGICAL*1 PAGE(2560),IN(2),OUT(2),NAME(30),NAMED(30)
	LOGICAL*1 FDBIN(128),FDBOUT(128)
	EQUIVALENCE(IVER,FDBOUT(81))    !FILE VERSION   N.FVER
	EQUIVALENCE(SIZEI,FDBIN(11))    !F.EFBK,F.FFBY FOR INPUT
	EQUIVALENCE(SIZEO,FDBOUT(11))   !F.EFBK,F.FFBY FOR OUTPUT
	COMMON/MYFDB/FDBIN,FDBOUT
	COMMON/VABORT/IABORT
	COMMON/PAGES/PAGE
	WRITE(5,101)
101     FORMAT(' ENTER SOURCE FILE NAME')
	READ(5,102)NC,NAME
102     FORMAT(Q,30A1)
	NAME(NC+1)=0
	WRITE(5,103)
103     FORMAT(' ENTER DESTINATION FILE NAME')
	READ(5,102)NC,NAMED
	NAMED(NC+1)=0
	CALL INIT(FDBIN)
	CALL INIT(FDBOUT)
C       SET UP FACC & RACC FOR INPUT FILE
	IN(1)=1 !FA.RD  READ ONLY
	IN(2)=1 !FD.RWM BLOCK MODE
C       SET UP FACC & RACC FOR OUTPUT FILE
	OUT(1)="16      !FA.CRE!FA.WRT!FA.EXT
	OUT(2)=1        !FD.RWM BLOCK MODE
	CALL OFNB(FDBIN,IN,1,NAME,IER)          !OPEN SOURCE FILE ON UNIT 1
	IF(IER.EQ.0)GO TO 1000
	FDBOUT(1)=2     !R.VAR
	FDBOUT(2)=2     !FD.CR
	CALL PARSE(FDBOUT,NAMED,2)      !DOES FILE ALREADY EXIST
	IER=0
	CALL FIND(FDBOUT,IER)   !FIND FILE
	IF(IER.LT.0)GO TO 15    !NO=CREATE FILE
	OUT(1)="6       !FA.WRT!FA.EXT
	CALL OFID(FDBOUT,OUT,2,IER)
	IF(IER.LT.0)GO TO 2000          !COPY OPEN ERROR
	GO TO 20
15      CALL OFNB(FDBOUT,OUT,2,NAMED,IER)       !OPEN DESTINATION FILE ON UNIT 2
	IF(IER.LT.0)GO TO 2000          !COPY OPEN ERROR
20      IBLK=1
10      CALL DABRD(FDBIN,PAGE,5*512,IBLK,NBT,IER)
	IF(IER.LE.0)GO TO 100   !EOF
	CALL DABWT(FDBOUT,PAGE,NBT,IBLK,NB,IER)
	IF(IER.LE.0)GO TO 2000  !COPY DESTINATION ERROR
	IBLK=IBLK+5
	GO TO 10
100     CALL CLOS(FDBIN)
C       COPY NUMBER OF BLOCKS WRITTEN AND NUMBER OF BYTES IN LAST BLOCK
	SIZEO=SIZEI     !PRESERVE F.EFBK & F.FFBY FROM SOURCE.
	CALL CLOS(FDBOUT)
1000    CALL EXIT
2000    WRITE(5,104)IER
104     FORMAT(' COPY ERROR=',I6)
	CALL CLOS(FDBIN)
	CALL CLOS(FDBOUT)
	CALL EXIT
	END