FTN4,Q,C
C 
      SUBROUTINE XINIT(LU,IDVID,IBUF,LEN,ISPD,IS1,IS2, IER),92067-1X524 
     XREV.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:  XINIT
C   SOURCE:  92067-18524
C    RELOC:  PART OF 92067-12002
C     PGMR:  J.S.W
C 
      DIMENSION IBUF(1) 
C 
C  SAVE SPD 
      ISPD2=ISPD
C     INITIALIZE WITH S,P,D BIT 
C 
C 
      IUNIT=IAND(IDVID,177400B)/256 
      ID=IAND(IDVID,7B) 
C 
C 
      IF(IFDVR(LU).EQ.0) GO TO 500
1     ISPD2=IAND(ISPD,377B)*32
C 
      CALL XDSJ(LU,IDVID,IER) 
      IF(IER.EQ.2.OR.IER.EQ.4) RETURN 
C 
      IBUF(1)=440B+ID 
      CALL XPRTY(IBUF(1)) 
      IBUF(2)=550B
      IBUF(3)=13B+ISPD2 
      IBUF(4)=1000B+IUNIT 
      IBUF(5)=677B
      IBUF(6)=440B+ID 
      CALL XPRTY(IBUF(6)) 
      IBUF(7)=100740B 
C 
C 
C 
C 
200   CALL ZWRIT(LU,IBUF,LEN) 
      CALL XDSJ(LU,IDVID,IER) 
      CALL XSTAT(LU,IDVID,IS1,IS2,IXX)
C 
C 
      RETURN
C 
C 
500   IBUF(1)=ID
      IBUF(2)=-1
      ISPD2=ISHL(ISPD2,13)
      IBUF(3)=ISPD2+5600B+ID
      REG=EXEC(1,LU+2200B,IBUF,LEN,4,0) 
      IS1=IBUF(2) 
      IS2=IBUF(3) 
C 
      RETURN
      END 
      END$
                                              