FTN4,L
      PROGRAM TXIB0(3,89),91711-16017  REV 1926  790428 
      DIMENSION IBUF(5) 
C 
C LGLU=LOG DEVICE LU, DEFAULT=TERMINAL LU IF SPECIFIED PARAMETER IS <=0.  
C LU=TEST DEVICE LU, MUST BE LU # OF BUS,SUBCHANNEL ZERO
C IERR=NUMBER OF ERRORS THAT OCCURRED DURING TEST 
C 
C RETRIEVE RUN PARAMETERS 
C 
      CALL RMPAR(IBUF)
      LGLU=IBUF 
      IF(IBUF.LE.0)LGLU=LOGLU(LGLU) 
      IF(IBUF(2).LE.0)GOTO 400
      LU=IBUF(2)
      IERR=0
C 
C GET STATUS OF TEST DEVICE LU
C 
      CALL EXEC(13,LU,ISTA1,ISTA2,ISTA3)
C 
C CHECK CHANNEL# IN STATUS WORD TWO, IF NON-ZERO THEN LU IS ENABLED 
C 
      ICHAN=IAND(ISTA2,77B) 
      IF(ICHAN.EQ.0)410,10
C 
C TEST DEVICE LU IS ENABLED 
C 
C INSURE THAT DEVICE TYPE IS 37 
C 
   10 ITYPE=IAND(ISTA1,37400B)
      IF(ITYPE.EQ.17400B)15,420 
C 
C CHECK SUBCHANNEL NUMBER IN STATUS WORD 3
C IF ZERO THEN IT IS A BUS LU # 
C 
   15 ISUB=IAND(ISTA3,37B)
      IF(ISUB.EQ.0)20,420 
C 
C CHECK IF BUS LU IS DOWN 
C 
   20 ISTAT=IAND(ISTA3,100000B) 
C 
C CHECK IF BUS EQT IS DOWN
C 
   25 IEQT=IAND(ISTA1,140000B)
      IF((IEQT.EQ.0).AND.(ISTAT.EQ.0)) 28,430 
C 
C BEGIN HP-IB TEST
C 
   28 WRITE(LGLU,29)LU  
   29 FORMAT(/"  TXIB0 - LU#",I3,":  HP-IB TEST RUNNING") 
C 
C GET BUS STATUS
C 
   30 CALL STATS(LU,ISTAT)
C 
C MASK 'REN' LINE TO DETERMINE INITIAL STATE
C 
      ISTAT=IAND(ISTAT,20B) 
      IF(ISTAT.EQ.0)35,40 
C 
C SET 'REN' LINE TRUE 
C 
   35 CALL RMOTE(LU)
C 
C GET STATUS WORD AND INSURE THAT 'REN' LINE WAS SET
C 
      CALL STATS(LU,ISTA1)
      ISTA2=IAND(ISTA1,20B) 
      IF(ISTA2.EQ.20B)40,450
C 
C SET 'REN' LINE FALSE
C 
   40 CALL LOCL(LU) 
C 
C GET STATUS WORD AND INSURE THAT 'REN' LINE WAS RESET
C 
      CALL STATS(LU,ISTA1)
      ISTA2=IAND(ISTA1,20B) 
      IF(ISTA2.EQ.0)45,460
C 
C SET 'REN' LINE TRUE 
C 
   45 IF(ISTAT.EQ.0)55,50 
   50 CALL RMOTE(LU)
C 
C GET STATUS WORD AND INSURE THAT 'REN' LINE WAS SET
C 
      CALL STATS(LU,ISTA1)
      ISTA2=IAND(ISTA1,20B) 
      IF(ISTA2.EQ.20B)55,450
C 
C COMPLETION MESSAGE
C 
   55 WRITE(LGLU,60)LU,IERR 
   60 FORMAT(/"  TXIB0 - LU#",I3,":  HP-IB TEST FINISHED   ",I2,
     1" ERRORS"/) 
      GOTO 1000 
C 
C ERROR MESSAGES
C 
  400 WRITE(LGLU,405) 
  405 FORMAT(/"  TXIB0 - LU# SPECIFIED FOR HP-IB INTERFACE" 
     1" IS ILLEGAL."/"          RERUN TEST SPECIFYING AN INTEGER >0"
     2" AND <64 FOR LU#.")
      GOTO 500
C 
  410 WRITE(LGLU,415)LU 
  415 FORMAT(/"  TXIB0 - LU#",I3,": NOT ASSIGNED, NOT TESTED!"/)
      GOTO 1000 
C 
  420 WRITE(LGLU,425)LU 
  425 FORMAT(/"  TXIB0 - LU#",I3," SPECIFIED FOR HP-IB INTERFACE" 
     1" IS NOT ASSIGNED"/"          TO SUBCHANNEL 0. RERUN TEST"
     2" SPECIFYING CORRECT LU#.") 
      GOTO 500
C 
  430 WRITE(LGLU,435)LU 
  435 FORMAT(/"  TXIB0 - LU#",I3,": EQT OR LU FOR TEST HP-IB" 
     1" IS DOWN."/"          UP EQT AND RERUN TEST.") 
      GOTO 500
C 
  450 WRITE(LGLU,455)LU 
  455 FORMAT(/"  TXIB0 - LU#",I3,": 'REN' CONTROL LINE WAS NOT SET.") 
      IERR=IERR+1 
      GOTO 55 
C 
  460 WRITE(LGLU,465)LU 
  465 FORMAT(/"  TXIB0 - LU#",I3,": 'REN' CONTROL LINE WAS NOT RESET.") 
      IERR=IERR+1 
      GOTO 55 
  500 WRITE(LGLU,505)LU 
  505 FORMAT(/"  TXIB0 - LU#",I3,":  HP-IB TEST ABORTED!"/) 
 1000 END 
      END$
                                                                                                                                                                                                                                              