ASMB,R,L,C
      NAM IBLU0,7  09580-16138  REV.A  770401 
* 
*---------------------------------------------------------------
* 
*     RELOC.     09580-16138
*     SOURCE     09580-18138
* 
*     L.DWYER       REV.A   770401
* 
*     HP 92425A TEST SYSTEM SOFTWARE IS THE PROPRIETARY 
*     MATERIAL OF THE HEWLETT-PACKARD COMPANY.  USE AND 
*     DISCLOSURE THEREOF ARE RESTRICTED BY WRITTEN AGREEMENT. 
* 
*     (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. 
*     ALL RIGHTS RESERVED.  NO PART OF THIS PROGRAM 
*     MAY BE PHOTOCOPIED, REPRODUCED OR TRANSLATED
*     TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR 
*     WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. 
* 
*---------------------------------------------------------------
* 
* 
* 
* DESCRIPTION:
* 
* THIS IS A FORTRAN CALLABLE INTEGER FUNCTION USED TO RETURN THE LU NUMBER
* ASSIGNED TO EQT SUBCHANNEL 0 FOR ANY OTHER LU NUMBER ON THE SAME EQT. 
* 
* IT'S USE COULD BE TO FIND THE LU NUMBER OF AN HPIB CONTROL CARD 
* SO A REMOTE ENABLE CONTROL CALL COULD BE ISSUED TO THAT CARD. 
* 
* 
* PARAMETERS: 
* 
* THERE IS ONE INTEGER PARAMETER PASSED TO THE FUNCTION.
*    THIS PARAMETER IS THE AUTO-ADDRESS LU NUMBER OF AN HPIB DEVICE.
* THERE IS ONE INTEGER PARAMETER RETURNED BY THE FUNCTION.
*    THIS PARAMETER IS THE LU NUMBER FOR SUBCHANNEL 0 OF THE
*    EQT OF THE AUTO-ADDRESSED LU NUMBER. 
* 
* 
* ERRORS: 
* 
* THIS FUNCTION HAS ONE ERROR RETURN.  IF NO LU IS FOUND CORRESPONDING TO 
* SUBCHANNEL-0 OF THE EQT, OR THE PARAMETER LU IS OUTSIDE THE DRT RANGE,
* ZERO IS RETURNED. 
* 
* 
* 
* CALLING SEQUENCE: 
* 
*     FORTRAN CALLING SEQUENCE: 
*         . 
*         . 
*         . 
*C     SET THE LU NUMBER OF AN HPIB AUTO-ADDRESS DEVICE 
*      LU1=33 
*C     GET THE NON-AUTO-ADDRESS LU NUMBER 
*C
*      LU0=IBLU0(LU1) 
*C
*C     CHECK FOR ERROR
*      IF(LU0.EQ.0) GOTO 900
*C     DO AN HPIB REMOTE ENABLE 
*      CALL EXEC(100003B,1600B+LU0) 
*C     ERROR RETURN 
*      GOTO 900 
*C     NORMAL RETURN
*        .
*        .
*        .
* 
* 
      HED IBLU0 
*     ASSEMBLER CALLING SEQUENCE: 
*         . 
*         . 
*      EXT IBLU0,EXEC 
*         . 
*      LDA =D33      GET THE AUTO-ADDRESS LU NUMBER 
*      STA LUNUM     SAVE IT. 
*      JSB IBLU0     JUMP SUB TO FUNCTION.
*      DEF *+2
*      DEF LUNUM     AUTO-ADDRESS LU NUMBER.
*      SZA,RSS       ERROR? 
*      JMP ERPNT     YES, PROCESS ERROR 
*      ADA =B1600    NO, ADD THE REMOTE ENABLE COMMAND. 
*      STA LUN00     SAVE THE SUBCHAN-0 LU NUMBER.
*      JSB EXEC 
*      DEF *+3
*      DEF CNWRD
*      DEF LUN00
*      JMP ERPNT     ERROR RETURN.
**                   NORMAL RETURN. 
*         . 
*         . 
*LUN00 NOP           TEMP STORAGE FOR HPIB LU NUMBER
*CNWRD OCT 100003    EXEC CONTROL COMMAND 
*LUNUM NOP           TEMP STORAGE FOR AUTO-ADDRESS DEVICE LU NUM
* 
      SKP 
      ENT IBLU0 
      EXT .ENTR 
      SPC 1 
LU    NOP 
IBLU0 NOP 
      JSB .ENTR 
      DEF LU
      LDB LU,I      GET THE LU NUMBER 
      SSB           NEGATIVE? 
      JMP ERR         YES 
      SZB,RSS       ZERO? 
      JMP ERR         YES 
      LDA 1653B     GET THE DRT TABLE LENGTH
      CMA,INA        NEGATE 
      STA LUMAX       AND SAVE IT.
      ADB =D-1      CHECK FOR LU
      ADA B          OUTSIDE OF RANGE.
      SSA,RSS       OUT?
      JMP ERR         YES 
      LDA 1652B     GET THE DRT POINTER 
      STA DRT        AND SAVE IT. 
      ADB A          POINT TO DRT ENTRY OF LU 
      LDA B,I         AND GET THE ENTRY.
      AND =B77      MASK FOR EQT
      SZA,RSS       EQT ASSIGNED? 
      JMP ERR         NOPE. 
      STA EQT       THEN SAVE IT. 
      CLB,INB       B-REG HAS CURRENT LU NUMB.
      SPC 1 
AGAIN LDA DRT,I     GET THE NEXT DRT ENTRY. 
      AND =B174077  MASK FOR EQT. 
      CPA EQT       EQT'S MATCH?
      JMP BINGO       YES 
      ISZ DRT       BUMP LU POINTER,
      ISZ B          LU COUNTER,
      ISZ LUMAX       AND END OF LIST COUNT. SKIP ON END. 
      JMP AGAIN     ELSE...TRY, TRY AGAIN.
      SPC 1 
ERR   CLB           OOPS...ERROR RETURN.
BINGO LDA B         RETURN THE
      JMP IBLU0,I    FOUND LU NUMBER. 
      SPC 2 
LUMAX NOP 
DRT   NOP 
EQT   NOP 
A     EQU 0 
B     EQU 1 
      END 
      