FTN4,Q,C SUBROUTINE XRDOF(LU,IDVID,IBUF,LEN,IOFSET,IS1,IS2,IER X ),92067-1X533 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XRDOF C SOURCE: 92067-18533 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IBUF(1) C C C IUNIT=IAND(IDVID,177400B)/256 ID=IAND(IDVID,7B) C C IF(IFDVR(LU).EQ.0) GO TO 500 CALL XDSJ(LU,IDVID,IER) IF(IER.EQ.2.OR.IER.EQ.4) RETURN IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) IBUF(2)=550B IBUF(3)=16B IBUF(4)=0 IBUF(5)=0 IBUF(6)=IOFSET+1000B IBUF(7)=677B IBUF(8)=500B+ID CALL XPRTY(IBUF(8)) IBUF(9)=100740B CALL ZREAD(LU,IBUF,LEN) CALL XDSJ(LU,IDVID,IER) CALL XSTAT(LU,IDVID,IS1,IS2,IXX) C C RETURN C C 500 IBUF(1)=ID+100000B IBUF(2)=-2 IBUF(3)=107200B+ID IBUF(4)=IOFSET REG=EXEC(1,LU+2200B,IBUF,LEN,3,0) IS1=IBUF(2) IS2=IBUF(3) RETURN END END$