FTN4,L
C*********************************************************************
C 
C     DISC LIBRARY
C 
C*********************************************************************
C     NAME:   DKLIB 
C     SOURCE: 92070-18089 
C     RELOC:  92070-16089 
C     PGMR:   WWL 
C 
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 PROGRAM LANGUAGE WITHOUT * 
C  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.        * 
C  **************************************************************** 
C 
C 
C 
      SUBROUTINE XDSJ (LU,DVID,DSJ),  92070-16089  REV.1941  790920 
      IMPLICIT INTEGER (A-Z)
      INTEGER IARY(5) 
      DATA DSJ2/160B/ 
      CALL EXEC (1,120100B+LU,DSJ,-1,DSJ2,0)
      RETURN
      END 
C 
      SUBROUTINE XFMSK (LU,DVID,MSK,IER)
      IMPLICIT INTEGER (A-Z)
      INTEGER IARY(5) 
      DATA SGC/150B/,FMOP/7400B/
      CMD=IOR(FMOP,MSK) 
      CALL EXEC (2,120100B+LU,CMD,-2,SGC,0) 
      CALL RMPAR (IARY) 
      IER=0 
      IF (IAND(IARY(1),77B) .NE. 0) IER=1 
      IF (IAND(IARY(1),77B) .EQ. 3) IER=4 
      RETURN
      END 
C 
      SUBROUTINE XSTAT (LU,DVID,S1,S2,IER)
      IMPLICIT INTEGER (A-Z)
      INTEGER IARY(5),BUF(2)
      DATA STOP/1400B/,STAT2/150B/
      BUF(1)=IOR(STOP,IAND(DVID,177400B)/256) 
      CALL EXEC (2,120100B+LU,BUF,-2,STAT2,0) 
      CALL EXEC (1,120100B+LU,BUF,-4,STAT2,0) 
      CALL RMPAR (IARY) 
      IER=0 
      ERCODE=IAND(IARY(1),77B)
      IF (ERCODE .EQ. 3) IER=4
      S1=BUF(1) 
      S2=BUF(2) 
      RETURN
      END 
C 
      SUBROUTINE XSEEK (LU,DVID,CYL,HEAD,SECTR,S1,S2,IER) 
      IMPLICIT INTEGER (A-Z)
      INTEGER BUF(3),IARY(5)
      DATA SEKOP/1000B/,SGC/150B/,DSJ2/160B/
      BUF(1)=IOR(SEKOP,IAND(DVID,177400B)/256)
      BUF(2)=CYL
      BUF(3)=IOR(HEAD*256,SECTR)
      CALL EXEC (2,120100B+LU,BUF,-6,SGC,0) 
      CALL EXEC (1,120100B+LU,DSJ,-1,DSJ2,0)
      CALL RMPAR (IARY) 
      ERCODE=IAND(IARY(1),77B)
      IER=4 
      IF (ERCODE .EQ. 3) RETURN 
      IF (DSJ .NE. 0) GO TO 20
      S1=0
      S2=0
      GO TO 50
   20 CALL XSTAT (LU,DVID,S1,S2,IR) 
   50 IER=IAND(DSJ,177400B)/256 
      RETURN
      END 
C 
      SUBROUTINE XDRED (LU,DVID,BUF,LEN,S1,S2,IER)
      IMPLICIT INTEGER (A-Z)
      INTEGER IARY(5),BUF(144)
      DATA SGC/150B/,SRD/140B/,DSJ2/160B/,RDOP/2400B/ 
      CMD=IOR(RDOP,IAND(DVID,177400B)/256)
      CALL EXEC (2,120100B+LU,CMD,-2,SGC,0) 
      CALL EXEC (1,120100B+LU,BUF(17),LEN,SRD,0)
      CNT=10
   10 CALL EXEC (1,120100B+LU,DSJ,-1,DSJ2,0)
      CALL RMPAR (IARY) 
      ERCODE=IAND(IARY(1),77B)
      IF (ERCODE .NE. 3) GO TO 50 
      CNT=CNT-1 
      IF (CNT .GT. 0) GO TO 10
      IER=4 
      S1=0
      S2=0
      RETURN
   50 CALL XSTAT (LU,DVID,S1,S2,IR) 
      IER=IAND(DSJ,177400B)/256 
      RETURN
      END 
C 
      SUBROUTINE XRDFS (LU,DVID,BUF,LEN,S1,S2,IER)
      IMPLICIT INTEGER (A-Z)
      INTEGER BUF(154),IARY(5)
      DATA SGC/150B/,SRD/140B/,RFSOP/3000B/,DSJ2/160B/
      CMD=IOR(RFSOP,IAND(DVID,177400B)/256) 
      CALL EXEC (2,120100B+LU,CMD,-2,SGC,0) 
      CALL EXEC (1,120100B+LU,BUF(17),LEN,SRD,0)
      CNT=10
   10 CALL EXEC (1,120100B+LU,DSJ,-1,DSJ2,0)
      CALL RMPAR (IARY) 
      ERCODE=IAND(IARY(1),77B)
      IF (ERCODE .NE. 3) GO TO 50 
      CNT=CNT-1 
      IF (CNT .GT. 0) GO TO 10
      IER=4 
      S1=0
      S2=0
      RETURN
   50 CALL XSTAT (LU,DVID,S1,S2,IR) 
      IER=IAND(DSJ,177400B)/256 
      RETURN
      END 
C 
      SUBROUTINE XRDOF (LU,DVID,BUF,LEN,OFSET,S1,S2,IER)
      IMPLICIT INTEGER (A-Z)
      INTEGER CMD(2),IARY(5),BUF(144) 
      DATA SGC/150B/,SRD/140B/,RDOP/7000B/,DSJ2/160B/ 
      CMD(1)=RDOP 
      CMD(2)=OFSET
      CALL EXEC (2,120100B+LU,CMD,-4,SGC,0) 
      CALL EXEC (1,120100B+LU,BUF(17),LEN,SRD,0)
      CNT=10
   10 CALL EXEC (1,120100B+LU,DSJ,-1,DSJ2,0)
      CALL RMPAR (IARY) 
      ERCODE=IAND(IARY(1),77B)
      IF (ERCODE .NE. 3) GO TO 50 
      CNT=CNT-1 
      IF (CNT .GT. 0) GO TO 10
      IER=4 
      S1=0
      S2=0
      RETURN
   50 CALL XSTAT (LU,DVID,S1,S2,IR) 
      IER=IAND(DSJ,177400B)/256 
      RETURN
      END 
C 
      SUBROUTINE XRDNV (LU,DVID,BUF,LEN,S1,S2,IER)
      IMPLICIT INTEGER (A-Z)
      INTEGER IARY(5),BUF(128)
      DATA SGC/150B/,SRD/140B/,DSJ2/160B/,RNVOP/11000B/ 
      CMD=IOR(RNVOP,IAND(DVID,177400B)/256) 
      CALL EXEC (2,120100B+LU,CMD,-2,SGC,0) 
      CALL EXEC (1,120100B+LU,BUF(17),LEN,SRD,0)
      CNT=10
   10 CALL EXEC (1,120100B+LU,DSJ,-1,DSJ2,0)
      CALL RMPAR (IARY) 
      ERCODE=IAND(IARY(1),77B)
      IF (ERCODE .NE. 3) GO TO 50 
      CNT=CNT-1 
      IF (CNT .GT. 0) GO TO 10
      IER=4 
      S1=0
      S2=0
      RETURN
   50 CALL XSTAT (LU,DVID,S1,S2,IR) 
      IER=IAND(DSJ,177400B)/256 
      RETURN
      END 
C 
      SUBROUTINE XVRFY (LU,DVID,SCNT,S1,S2,IER) 
      IMPLICIT INTEGER (A-Z)
      INTEGER BUF(2),IARY(5)
      DATA VFYOP/3400B/,SGC/150B/,DSJ2/160B/
      BUF(1)=IOR(VFYOP,IAND(DVID,177400B)/256)
      BUF(2)=SCNT 
      CALL EXEC (2,120100B+LU,BUF,-4,SGC,0) 
      CALL EXEC (1,120100B+LU,DSJ,-1,DSJ2,0)
      CALL RMPAR (IARY) 
      ERCODE=IAND(IARY(1),77B)
      IF (ERCODE .NE. 3) GO TO 50 
      IER=4 
      S1=0
      S2=0
      RETURN
   50 CALL XSTAT (LU,DVID,S1,S2,IR) 
      IER=IAND(DSJ,177400B)/256 
      RETURN
      END 
C 
      SUBROUTINE XRCAL (LU,DVID,IER)
      IMPLICIT INTEGER (A-Z)
      INTEGER IARY(5) 
      DATA SGC/150B/,RCLOP/400B/
      CALL EXEC (2,120100B+LU,RCLOP,-2,SGC,0) 
      CALL RMPAR (IARY) 
      IER=0 
      IF (IAND(IARY(1),77B) .NE. 0) IER=1 
      IF (IAND(IARY(1),77B) .EQ. 3) IER=4 
      RETURN
      END 
C 
      SUBROUTINE XDWRT (LU,DVID,BUF,LEN,S1,S2,IER)
      IMPLICIT INTEGER (A-Z)
      INTEGER IARY(5),BUF(144)
      DATA SGC/150B/,SWD/140B/,WROP/4000B/,DSJ2/160B/ 
      CMD=IOR(WROP,IAND(DVID,177400B)/256)
      CALL EXEC (2,120100B+LU,CMD,-2,SGC,0) 
      CALL EXEC (2,120100B+LU,BUF(17),LEN,SWD,0)
      CNT=10
   10 CALL EXEC (1,120100B+LU,DSJ,-1,DSJ2,0)
      CALL RMPAR (IARY) 
      ERCODE=IAND(IARY(1),77B)
      IF (ERCODE .NE. 3) GO TO 50 
      CNT=CNT-1 
      IF (CNT .GT. 0) GO TO 10
      IER=4 
      S1=0
      S2=0
      RETURN
   50 CALL XSTAT (LU,DVID,S1,S2,IR) 
      IER=IAND(DSJ,177400B)/256 
      RETURN
      END 
C 
      SUBROUTINE XFRMT (LU,DVID,PATRN,TYPE,STAGR,IER) 
      IMPLICIT INTEGER (A-Z)
      INTEGER IARY(5),BUF(3)
      DATA FMTOP/14000B/,FMT2/154B/,DSJ2/160B/
      BUF(1)=IOR(FMTOP,IAND(DVID,177400B)/256)
      BUF(2)=(TYPE*256)+STAGR 
      BUF(3)=PATRN
      CALL EXEC (2,120100B+LU,BUF,-5,FMT2,0)
      CALL EXEC (1,120100B+LU,DSJ,-1,DSJ2,0)
      CALL RMPAR (IARY) 
      IF (IAND(IARY(1),77B) .NE. 3) GO TO 50
      IER=4 
      RETURN
   50 IER=IAND(DSJ,177400B)/256 
      RETURN
      END 
C 
      SUBROUTINE XINIT (LU,DVID,BUF,LEN,SPD,S1,S2,IER)
      IMPLICIT INTEGER (A-Z)
      INTEGER IARY(5),BUF(144)
      DATA INTOP/5400B/,SGC/150B/,SWD/140B/,DSJ2/160B/
      DMY=IOR(INTOP,IAND(DVID,177400B)/256) 
      DMY=IOR(SPD*8192,DMY) 
      CALL EXEC (2,120100B+LU,DMY,-2,SGC,0) 
      CALL EXEC (2,120100B+LU,BUF(17),LEN,SWD,0)
      CALL EXEC (1,120100B+LU,DSJ,-1,DSJ2,0)
      CALL RMPAR (IARY) 
      ERCODE=IAND(IARY(1),77B)
      IF (ERCODE .NE. 3) GO TO 50 
      IER=4 
      S1=0
      S2=0
      RETURN
   50 CALL XSTAT (LU,DVID,S1,S2,IR) 
      IER=IAND(DSJ,177400B)/256 
      RETURN
      END 
C 
      SUBROUTINE XWRFS (LU,DVID,BUF,LEN,S1,S2,IER)
      IMPLICIT INTEGER (A-Z)
      INTEGER BUF(154),IARY(5)
      DATA SGC/150B/,SWD/140B/,WFSOP/4400B/,DSJ2/160B/
      CMD=IOR(WFSOP,IAND(DVID,177400B)/256) 
      CALL EXEC (2,120100B+LU,CMD,-2,SGC,0) 
      CALL EXEC (2,120100B+LU,BUF(17),LEN,SWD,0)
      CNT=10
   10 CALL EXEC (1,120100B+LU,DSJ,-1,DSJ2,0)
      CALL RMPAR (IARY) 
      ERCODE=IAND(IARY(1),77B)
      IF (ERCODE .NE. 3) GO TO 50 
      CNT=CNT-1 
      IF (CNT .GT. 0) GO TO 10
      IER=4 
      S1=0
      S2=0
      RETURN
   50 CALL XSTAT (LU,DVID,S1,S2,IR) 
      IER=IAND(DSJ,177400B)/256 
      RETURN
      END 
C 
      SUBROUTINE XPHAD (LU,DVID,CYL,HEAD,SECTR,IER) 
      IMPLICIT INTEGER (A-Z)
      INTEGER BUF(2),IARY(5)
      DATA PADOP/12000B/,CMD2/150B/,RD2/150B/ 
      BUF(1)=PADOP
      BUF(2)=0
      CALL EXEC (2,120100B+LU,BUF,-2,CMD2,0)
      CALL EXEC (1,120100B+LU,BUF,-4,RD2,0) 
      CALL RMPAR (IARY) 
      ERCODE=IAND(IARY(1),77B)
      IER=4 
      IF (ERCODE .EQ. 3) RETURN 
      CYL=BUF(1)
      HEAD=BUF(2)/256 
      SECTR=IAND(BUF(2),377B) 
      IER=0 
      RETURN
      END 
C 
      SUBROUTINE XADRC (LU,DVID,CYL,HEAD,SECTR,IER) 
      IMPLICIT INTEGER (A-Z)
      INTEGER IARY(5),BUF(3)
      DATA ADRC2/150B/,ADROP/6000B/ 
      BUF(1)=ADROP
      BUF(2)=CYL
      BUF(3)=IOR(HEAD*256,SECTR)
      CALL EXEC (2,120100B+LU,BUF,-6,ADRC2,0) 
      CALL RMPAR (IARY) 
      ERCODE=IAND(IARY(1),77B)
      IER=0 
      IF (ERCODE .EQ. 3) IER=4
      RETURN
      END 
C 
      SUBROUTINE XLGAD (LU,DVID,CYL,HEAD,SECTR,IER) 
      IMPLICIT INTEGER (A-Z)
      INTEGER IARY(5),BUF(3)
      DATA GTAD2/150B/,LADOP/12000B/
      BUF(1)=LADOP
      CALL EXEC (2,120100B+LU,BUF,-2,GTAD2,0) 
      CALL EXEC (1,120100B+LU,BUF,-4,GTAD2,0) 
      CALL RMPAR (IARY) 
      IF (IAND(IARY(1),77B) .EQ. 3) GO TO 10
      IER=0 
      CYL=BUF(1)
      HEAD=IAND(BUF(2),17400B)/256
      SECTR=IAND(BUF(2),377B) 
      RETURN
   10 IER=4 
      RETURN
      END 
C 
      SUBROUTINE XIDEN (LU,DVID,ID) 
      IMPLICIT INTEGER (A-Z)
      RETURN
      END 
C 
      SUBROUTINE XEND (LU,DVID) 
      IMPLICIT INTEGER (A-Z)
      DATA SGC/150B/,ENDOP/12400B/
      CALL EXEC (2,120100B+LU,ENDOP,-2,SGC,0) 
      RETURN
      END 
C 
      SUBROUTINE XSPAR (LU,STRAK,IER) 
      IMPLICIT INTEGER (A-Z)
      INTEGER DP(8),BUF(17) 
      CALL EXEC (13,10000B+LU,P1,P2,DP,8) 
      NSPARS=DP(5)
      IF (NSPARS .EQ. 0) GO TO 50 
      CNT=0 
      STRAK=DP(6) 
   10 CALL XGTAD (LU,DVID,STRAK,SECT,CYL,HEAD,SECT) 
      CALL XSEEK (LU,DVID,CYL,HEAD,SECT,S1,S2,IER)
      IF (IER .EQ. 4) RETURN
      CALL XDRED (LU,DVID,BUF(1),1,S1,S2,IER) 
      IF (IER .EQ. 4) RETURN
      IDCST=IAND(S1,17400B)/256 
      IF (IDCST .EQ. 20B) GO TO 30
      IDCST=IAND(S1,120000B)
      IF (IDCST .EQ. 0) RETURN
   30 CNT=CNT+1 
      STRAK=STRAK+1 
      IF (CNT .LT. NSPARS)  GO TO 10
   50 IER=1 
      RETURN
      END 
C 
      SUBROUTINE XGTAD (LU,DVID,TRACK,SECT1,CYL,HEAD,SECT2) 
      IMPLICIT INTEGER (A-Z)
      INTEGER DP(8) 
      EQUIVALENCE (DVAD,DP(1)),(UNIT,DP(2)),(SHED,DP(3)),(SCYL,DP(4)) 
      EQUIVALENCE (NHEDS,DP(8)) 
      CALL XTTBL (LU,DP)
      HEAD=SHED+MOD(TRACK,NHEDS)
      CYL=(TRACK/NHEDS)+SCYL
      DVID=(UNIT*256)+DVAD
      SECT2=SECT1/2 
      RETURN
      END 
C 
      SUBROUTINE XTTBL (LU,DP)
      IMPLICIT INTEGER (A-Z)
      INTEGER DP(8) 
C 
C     THIS SUBROUTINE RETURNS DISC DRIVER PARAMETERS AS FOLLOWS:
C 
C     DP(1) = HP-IB ADDRESS 
C     DP(2) = UNIT NUMBER 
C     DP(3) = STARTING HEAD 
C     DP(4) = STARTING CYLINDER 
C     DP(5) = NUMBER OF SPARES THIS LU
C     DP(6) = NUMBER OF TRACKS THIS LU
C     DP(7) = NUMBER OF SECTORS/TRACK 
C     DP(8) = NUMBER OF SURFACES (OR HEADS) 
C 
      CALL EXEC (13,10000B+LU,P1,P2,DP,8) 
      RETURN
      END 
      END$