FTN4
      INTEGER FUNCTION ICRLU(NUMB),. 92080-1X015 REV.2026  800515 
C 
C     SOURCE 92080-18015
C 
C 
C 
C     **************************************************************
C     * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    *
C     * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C     * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C     * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
C     **************************************************************
C 
C 
C     **************************************************************
C     *                                                            *
C     *      THIS FUNCTION RETURNS THE FOLLOWING VALUES:           *
C     *                                                            *
C     * IF NUMB = -(DISC LU)   -----> ICRLU = CARTRIDGE #          *
C     * IF NUMB = CARTRIDGE #  -----> ICRLU = DISC LU              *
C     * IF NUMB = 0            -----> ICRLU = 1ST CARTRIDGE #      *
C     * IF ANY ERROR (UNDEF..) -----> ICRLU = -1 (IF NOT MOUNTED)  *
C     *                               ICRLU = -2 (IF CR LOCKED,    *
C     *                                       LOCK NOT 0 OR 77777B)*
C     *                                                            *
C     **************************************************************
C 
C 
      DIMENSION IDCB(128),IREG(2) 
      INTEGER AREG,BREG 
      EQUIVALENCE (REG,IREG,AREG),(IREG(2),BREG)
      LOGICAL ISBTW 
C 
C-----IF NUMB NEGATIVE #, 1 < -(NUMB) < 64 ?
C 
      IF(NUMB.GE.0) GOTO 100
      IF(ISBTW(-NUMB,2,63)) GOTO 300
C 
C-----READ CARTRIDGES DIRECTORY TABLE 
C 
  100 CALL FSTAT(IDCB)
      IF(NUMB.GT.0) GOTO 400
      IF(NUMB.NE.0) GOTO 150
      I=1 
      GOTO 160
C 
C-----SEARCH A CARTRIDGE NUMBER FROM A LU NUMBER
C 
150   DO 200 I=1,121,4
      IF(IDCB(I).EQ.0) GOTO 300 
      IF(IDCB(I).NE.-NUMB) GOTO 200 
  160 ICRLU=IDCB(I+2) 
  180 IF( IDCB(I+3).NE.0 .AND. IDCB(I+3).NE.77777B ) GOTO 350 
      RETURN
200   CONTINUE
C-----ERROR = -1, CARTRIDGE NOT MOUNTED 
300   ICRLU=-1
      RETURN
C-----ERROR = -2, CARTRIDGE LOCKED
350   ICRLU=-2
      RETURN
C 
C-----SEARCH AN LU NUMBER FROM A CR NUMBER
C 
400   DO 500 I=1,121,4
      IF(IDCB(I).EQ.0) GOTO 300 
      IF(IDCB(I+2).EQ.NUMB) GOTO 600
500   CONTINUE
      GOTO 300
600   ICRLU=IDCB(I) 
      GOTO 180
      END 
      END$
                                                                                                    