Subroutine Rdblock(Block,Data)
C
C	ORIGINAL CODE BY RAY STONE - SPRING 82 VAX SIG TAPE
C
C	BLOCKED READ ADDED BY T MAHANEY  3/84
C
c ...... This program reads block number BLOCK into DATA
C
      IMPLICIT INTEGER*4 (A-Z)
C
	PARAMETER NBLKS_R = 32			! NUMBER OF BLOCKS TO READ
C
	BYTE	BBUF(NBLKS_R * 512)
C
C	JUNK FOR GETDVI TO GET DISK SIZE
C
	PARAMETER DVI$_MAXBLOCK = 26
C
	INTEGER * 4 IT_LIST(4)
	INTEGER * 2 WD_IT_LIST (8)
	EQUIVALENCE (IT_LIST,WD_IT_LIST)
C
	INTEGER * 4 MAX_BLOCKS
C
	DATA WD_IT_LIST / 4 , DVI$_MAXBLOCK , 0 , 0 , 0 , 0,
     1			  0 , 0 /

	Byte Data(512)
      INTEGER*2 STATUS(4)
      INTEGER*4 DEVDEPINF
      INTEGER*2 NUMBYTES, QIOSTAT
      EQUIVALENCE (STATUS(1),QIOSTAT)
      EQUIVALENCE (STATUS(2),NUMBYTES)
      EQUIVALENCE (STATUS(3),DEVDEPINF)
	Data First /0/
C
	If (First .eq. 0) Then
 	  SUCC = SYS$ASSIGN('WIPED',CHAN,,)
          IF(FAILURE(SUCC,'ASSIGN FAILURE'))WRITE (5,*)CHAN
	  IF ( .NOT. SUCC ) STOP
C
	  IT_LIST(2) = %LOC(MAX_BLOCKS)
	  SUCC = SYS$GETDVI(%VAL(1),%VAL(CHAN),,IT_LIST,STATUS,,,)
          IF ( FAILURE(SUCC,'GETDVI FAILURE') ) STOP
C
	WRITE (5,2) MAX_BLOCKS
2	FORMAT (' MAX-BLOCKS: 'I10)
	  F_BLOCK = -1
	  L_BLOCK = -1
	  First = 1
	End if
C
C	SEE IF DESIRED BLOCK ALREADY IN OUR BUFFER
C
	IF (BLOCK .LT. F_BLOCK .OR. BLOCK .GT. L_BLOCK) THEN
	  F_BLOCK = BLOCK
	  L_BLOCK = F_BLOCK + NBLKS_R - 1
	  IF (L_BLOCK .GE. MAX_BLOCKS) L_BLOCK = MAX_BLOCKS - 1
	  BYTES_R = ( L_BLOCK - F_BLOCK + 1 ) * 512

          SUCC = SYS$QIOW(%VAL(1),%VAL(CHAN),%VAL(33),STATUS,,,
     +    BBUF,%VAL(BYTES_R),%VAL(F_BLOCK),,,)
          IF(FAILURE(SUCC,'QIO FAILURE'))WRITE (5,*) CHAN
C
C         WRITE(6,10001)QIOSTAT, NUMBYTES, DEVDEPINF
C0001     FORMAT(1X,'QIOSTAT IS',Z4,'NUMBYTES IS ',I4,
C    +    'DEVDEPINF IS',Z8)
C
	END IF
C
C	MOVE THE DESIRED BLOCK TO CALLER'S BUFFER
C
	S_LOC = (BLOCK - F_BLOCK) * 512
	DO 100 I = 1 , 512
	DATA(I) = BBUF( I + S_LOC)
100	CONTINUE
C
	Return
      END