FTN4 SUBROUTINE XADRC(LU,IDVID,ICYL,IHD,ISEC,IER X ),92067-1X529 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: XADRC C SOURCE: 92067-18529 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IBUF(10) C C C ADDRESS RECORD C ID=IAND(IDVID,7B) C C C C C IF(IFDVR(LU).EQ.0) GO TO 500 1 IBUF(1)=440B+IDVID CALL XPRTY(IBUF(1)) IBUF(2)=550B C C OP CODE C IBUF(3)=14B IBUF(4)=0 IBUF(5)=IAND(ICYL,177400B)/256 IBUF(6)=IAND(ICYL,377B) IBUF(7)=IHD IBUF(8)=ISEC+1000B IBUF(9)=100677B C C 100 CALL ZCTRL(LU,IBUF) CALL XDSJ(LU,IDVID,IER) RETURN 500 IBUF(1)=ID IBUF(2)=-3 IBUF(3)=106000B IBUF(4)=ICYL IBUF(5)=IHD*256+ISEC GO TO 100 END END$