FTN4,L
      PROGRAM IBCFE(3,99),92425-16041 REV.1940 790612 
C***************************************************************
C 
C   SOURCE       92425-18041
C   RELOCATABLE  92425-16041
C 
C   VINCE POVIO  ?????? 
C   BOB RICHARDS 790612 
C 
C 
C 
C 
C     THIS PROGRAM CONFIGIURES THE HPIB DRIVER TO ALLOW ERRORS FOR
C     FOR SELECTED DEVICES TO BE HANDLED BY THE APPLICATION PROGRAM.
C 
C     "WELCOM" FILE INSTRUMENT ENTRIES MUST BE AS FOLLOWS.  FOR 
C     EACH HP-IB CARD AND EACH HP-IB INSTRUMENT THAT ERRORS ARE 
C     GOING TO BE HANDLED BY THE DEVICE SUBROUTINE, THE CHAR.S "IB" 
C     ARE TO BE IN COLUMNS 47 AND 48 WITH ONLY SPACES BETWEEN "IB"
C     AND THE DEVICE TYPE AND AT LEAST ONE SPACE AFTER "IB".
C 
C:*   STATION   LUN   DEVICE #    DEV. TYPE     NAME
C:*                                              (FOR IBCFE, THE 'IB' 
C:*                                               MUST START IN COL.47)!! 
C:* 
C:* #    1       1       1             1         2645 CRT 
C:* #    1       30      1             9       IB HPIB CARD 
C:* #    1       31      1            48       IB 8165A 
C:* #    2       9       1             1         2644 CRT 
C 
C********************************************************************** 
C 
      DIMENSION IDCB(150),NAME(3),ITOKN(30) 
      DIMENSION ISTNS(20),IPRAM(5),IBUF(50) 
      DATA NAME /2HWE,2HLC,2HOM/
      DATA ISTNS/0,0,-1,0,-1,2,-1,3,-1,4,-1,5,-1,6,-1,7/
C 
C 
C 
      CALL RMPAR(IPRAM) 
      LUOP=IPRAM(1) 
      IF(LUOP .EQ. 0) LUOP=1
C 
C 
C 
200   CALL OPEN(IDCB,IERR,NAME,1) 
      IF(IERR .LT. 0) GOTO 900
4001  CALL READF(IDCB,IERR,IBUF(2),50,LEN)
      IF(LEN .LT. 0) GOTO 4099
      IBUF(1)=2*LEN 
      IF(LEN .LT. 2) GOTO 4001
      IF(IBUF(2) .NE. 2H:*) GOTO 4001 
      IF(IBUF(3) .NE. 2H #) GOTO 4001 
      IF(IBUF(25) .NE. 2HIB) GOTO 4001
C 
C 
C 
      NTOKN=5 
      CALL SCAN(IBUF,ITOKN,NTOKN,IQT) 
      ISTN=INTV(ITOKN,IERR) 
      IF(IERR .NE. 0) GOTO 800
C 
C 
C 
C 
      CALL SCAN(IBUF,ITOKN,NTOKN,IERR)
      ILU=INTV(ITOKN,IERR)
      IF(IERR .NE. 0) GOTO 800
C 
C 
C 
      IPRAM=17400B
      CALL EXEC(3,2500B+ILU,IPRAM)
      GOTO 4001 
4099  CALL CLOSE(IDCB)
      GOTO 900
C 
C 
C 
800   WRITE(LUOP,8001)
8001  FORMAT("*** CONVERSION ERROR IN SETTING DRTXX TABLE") 
      WRITE(LUOP,8002)(IBUF(J),J=2,LEN+1) 
8002  FORMAT(40A2)
      GOTO 4001 
900   CALL EXEC(6)
      END 
      END$
                                                                                      