FTN4,Q,C SUBROUTINE XSPAR (LU,LASTRK,IER),92067-1X537 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: XSPAR C SOURCE: 92067-18537 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IREG(2),IBUF(20) INTEGER S1 EQUIVALENCE (IA,REG,IREG(1)),(IB,IREG(2)) C C THIS ROUTINE RETURNS THE FIRST AVAILABLE SPARE TRACK # FOR THIS LU C IF IER=1 OUT OF SPARES C C IER=0 C C GET TRACK MAP AND FIND # OF SPARES C CALL ZTMAP(LU,IBUF,5) C C GET # OF SPARES FROM TMT , IF ZERO SET IER=1 AND RETURN C NSPAR=IAND(IBUF(5),377B) IF(NSPAR.EQ.0) GO TO 50 NTRK=0 LASTRK=IBUF(4) 10 CALL XGTAD(LU,IDVID,LASTRK,0,ICYL,IHD,ISEC) CALL XSEEK(LU,IDVID,ICYL,IHD,ISEC,ISTAT1,ISTAT2,IER) CALL XDRED(LU,IDVID,IBUF,1,ISTAT1,ISTAT2,IER) S1=IAND(ISTAT1,17400B)/256 ISP=IAND(ISTAT1,120000B) IF(S1.NEQ.20B.AND.ISP.EQ.0 ) RETURN LASTRK=LASTRK+1 NTRK=NTRK+1 IF(NTRK.LT.NSPAR) GO TO 10 50 IER=1 RETURN END END$