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$