PROGRAM diskcopy
! quick hack to do a physical (logical block) copy from disk to disk.
! this is to replace a "BACKUP/PHYSICAL", since backup likes only identical disks.
!

	implicit NONE
	INCLUDE '($IODEF)'
	INCLUDE '($SSDEF)'
         Include '($SYSSRVNAM)'

	BYTE		Z(64000)
	BYTE		BELL
	BYTE		FLAG
	INTEGER*4	IOSB$L(2)
	INTEGER*2	IOSB$W(4)
        logical MORE
        integer*2 INCHAN,OUTCHAN
	EQUIVALENCE (IOSB$L(1),IOSB$W(1))

        integer status
        integer numbl,qiobl,nextbl

	BELL=7
        numbl=17783112 !total number of blocks  !should come from command-line
        qiobl=124      !blocks in one QIO        
        nextbl=0       ! next logical block in QIO

! fixed disk names, better take it from command-line
	STATUS = SYS$ASSIGN( 'DISK_IN', INCHAN,, )
	IF(STATUS.NE.SS$_NORMAL)GO TO 9000

	STATUS = SYS$ASSIGN( 'DISK_OUT', OUTCHAN,, )
	IF(STATUS.NE.SS$_NORMAL)GOTO 9000

        MORE=.TRUE.

	DO WHILE (MORE)
	 STATUS = SYS$QIOW(,%VAL(INCHAN),%VAL(IO$_READLBLK),
     1	%REF(IOSB$L),,,%REF(Z),%VAL(qiobl*512),%VAL(nextbl),,,)
	 IF(STATUS.NE.1) CALL LIB$SIGNAL(%VAL(STATUS))
	  IF(IOSB$W(1).NE.1) CALL LIB$SIGNAL(%VAL(IOSB$W(1)))

! could be enhanced to do read after write.
	  STATUS = SYS$QIOW(,%VAL(OUTCHAN),%VAL(IO$_WRITELBLK),
     1		%REF(IOSB$L),,,%REF(Z),%VAL(qiobl*512),%VAL(nextbl),,,)
	  IF(STATUS.NE.1) CALL LIB$SIGNAL(%VAL(STATUS))
	  IF(IOSB$W(1).NE.1) CALL LIB$SIGNAL(%VAL(IOSB$W(1)))

         nextbl=nextbl+qiobl  !next block number
         numbl=numbl-qiobl    ! blocks still to do
         qiobl=MIN(124,numbl)
         if (qiobl.le.0) more=.FALSE.
	END DO

        call EXIT(1)

9000	WRITE(6,9010)BELL
9010	FORMAT(/,1A1,'ERROR - Cannot assign disk'//)
	GOTO 9999
9999	CALL EXIT
	END