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$
                                                                              