FTN4,B,L
      PROGRAM TXDS0(3,89),91711-16016  REV 1926  790427 
      DIMENSION IBUF(5),ITIM1(5),ITIM2(5),ITIM3(5),ITIM4(5) 
C 
C 
C*********************************************
C* TXDS0                                     *
C* PRIMARY SYSTEM DS/1000 TEST               *
C* RELOC.: 91711-16016 REV 1926              *
C* SOURCE: 91711-18016 REV 1926              *
C*********************************************
C 
C 
C LGLU=LOG DEVICE LU, DEFAULT=1 IF SPECIFIED PARAMETER IS .LE. 0  
C LU=TEST DEVICE LU, MUST BE LU# OF DS/1000 INTERFACE IN LOCAL CPU
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 65 
C 
   10 ITYPE=IAND(ISTA1,37400B)
      IF(ITYPE.EQ.32400B)15,420 
C 
C CHECK SUBCHANNEL NUMBER IN STATUS WORD 3
C ODD S.C. MEANS CLOSED LOOP, EVEN S.C. MEANS OPEN LOOP.
C 
   15 ISUB=IAND(ISTA3,1)
C 
C CHECK IF COMMUNICATION LINK LU IS DOWN
C 
   20 ISTAT=IAND(ISTA3,100000B) 
C 
C CHECK IF COMMUNICATION LINK EQT IS DOWN 
C 
   25 IEQT=IAND(ISTA1,140000B)
      IF((IEQT.EQ.0).AND.(ISTAT.EQ.0))30,440
C 
C CHECK IF NODE NUMBER OF REMOTE SYSTEM WAS SPECIFIED AT RUN TIME 
C 
   30 IF((IBUF(3).GT.0).AND.(IBUF(3).LE.32767))GOTO 70
      IF(ISUB.EQ.0)GOTO 45
   35 WRITE(LGLU,40)LU,LU 
   40 FORMAT(/"  TXDS0 - LU#",I3,": BE SURE THAT THE REMOTE SYSTEM" 
     1" TO BE TESTED"/"          HAS BEEN INITIALIZED AND IS" 
     2" CONNECTED TO THE HARDWIRE"/"          INTERFACE CONFIGURED" 
     3" TO LU#",I3," IN THIS LOCAL SYSTEM.")
      GOTO 55 
   45 WRITE(LGLU,50)LU,LU 
   50 FORMAT(/"  TXDS0 - LU#",I3,": BE SURE THAT THE REMOTE SYSTEM" 
     1" TO BE TESTED"/"          HAS BEEN INITIALIZED AND IS" 
     2" CONNECTED TO THE MODEM"/"          INTERFACE CONFIGURED"
     3" TO LU#",I3," IN THIS LOCAL SYSTEM.")
   55 WRITE(LGLU,60) LU 
   60 FORMAT(/"  TXDS0 - LU#",I3,": ENTER A NODE NUMBER BETWEEN 1 AND"
     1" 32767"/"          FOR THE REMOTE SYSTEM TO BE TESTED OR TYPE" 
     2"  /A  TO ABORT"/"          THIS TEST: _")
C 
      CALL EXEC(1,LGLU+400B,IBUF,3) 
      IF(IBUF.EQ.2H/A) GOTO 500 
      CALL CODE(5)
      READ(IBUF,*)INODE 
      IF((INODE.GT.0).AND.(INODE.LE.32767)) GOTO 75 
      WRITE(LGLU,65)LU,INODE  
   65 FORMAT(/"  TXDS0 - LU#",I3,": ",I5," IS AN ILLEGAL NODE NUMBER.") 
      GOTO 55 
   70 INODE=IBUF(3) 
C 
C BEGIN DS/1000 TEST
C 
   75 WRITE(LGLU,80)LU,INODE  
   80 FORMAT(/"  TXDS0 - LU#",I3,":  DS/1000 TEST RUNNING ON NODE#" 
     1,I5)
C 
C GET REMOTE SYSTEM TIME
C 
  270 CALL DEXEC(INODE,11,ITIM1)
C 
C PREVENT INVALID TEST DUE TO SECONDS CHANGING FROM 59 TO 0 
C 
      IF(ITIM1(2).GE.58) 270,280
C 
C GET LOCAL SYSTEM TIME 
C 
  280 CALL EXEC(11,ITIM3) 
C 
C PREVENT INVALID TEST DUE TO SECONDS CHANGING FROM 59 TO 0 
C 
      IF(ITIM3(2).GE.58) 270,290
C 
C CONVERT PORTION OF LOCAL TIME TO TENS OF MILLISECONDS 
C 
  290 MS3=(100*ITIM3(2))+ITIM3(1) 
C 
C COMPUTE LOCAL TIME NECESSARY TO INDICATE ELAPSE OF ON SECOND
C 
      MS3A=MS3+100
C 
C GET LOCAL SYSTEM TIME AGAIN 
C 
  300 CALL EXEC(11,ITIM4) 
C 
C CONVERT PORTION OF NEW LOCAL TIME TO TENS OF MILLISECONDS 
C 
      MS4=(100*ITIM4(2)+ITIM4(1)) 
C 
C LOOP UNTIL ONE SECOND HAS ELAPSED 
C 
      IF (MS4.LE.MS3A) 300,310
C 
C GET REMOTE SYSTEM TIME AGAIN
C 
  310 CALL DEXEC(INODE,11,ITIM2)
C 
C INSURE THAT REMOTE NODE SYSTEM TIME WAS INCREMENTED 
C 
      IF(ITIM2(2).LE.ITIM1(2))450,85
C 
C COMPLETION MESSAGE
C 
   85 WRITE(LGLU,90)LU,INODE,IERR 
   90 FORMAT(/"  TXDS0 - LU#",I3,":  DS/1000 TEST FINISHED ON NODE#"
     1,I5,"   ",I1," ERRORS"/)
      GOTO 1000 
C 
C ERROR MESSAGES
C 
  400 WRITE(LGLU,405) 
  405 FORMAT(/"  TXDS0 - LU# SPECIFIED FOR DS/1000 LINK IS" 
     1" ILLEGAL."/"          RERUN TEST SPECIFYING AN INTEGER >0 AND" 
     2" <64 FOR LU#.")
      GOTO 500
C 
  410 WRITE(LGLU,415)LU 
  415 FORMAT(/"  TXDS0 - LU#",I3,": NOT ASSIGNED, NOT TESTED!"/)
      GOTO 1000 
C 
  420 WRITE(LGLU,425)LU 
  425 FORMAT(/"  TXDS0 - LU#",I3," IS NOT ASSIGNED TO A DS/1000 LINK."/ 
     1"          RERUN TEST SPECIFYING CORRECT LU#.") 
      GOTO 500
C 
  440 WRITE(LGLU,445)LU 
  445 FORMAT(/"  TXDS0 - LU#",I3,": EQT OR LU FOR DS/1000 LINK IS"
     1" DOWN."/"          UP EQT AND RERUN TEST.")
      GOTO 500
C 
  450 WRITE(LGLU,455)LU,INODE 
  455 FORMAT(/"  TXDS0 - LU#",I3,", NODE#",I5,": TIME TEST FAILED!")
      IERR=IERR+1 
      GOTO 85 
  500 WRITE(LGLU,505)LU 
  505 FORMAT(/"  TXDS0 - LU#",I3,":  DS/1000 TEST ABORTED!"/) 
 1000 END 
      END$
                                                                                                                  