FTN4,B,L
      PROGRAM TXD00(3,89),781110  1901
      DIMENSION IBUF(5),ITIM1(5),ITIM2(5),ITIM3(5),ITIM4(5) 
C 
C 
C*********************************************
C* TXD00                                     *
C* PRIMARY SYSTEM DS/1000 TEST               *
C* RELOC.: 02170-16015 REV 1901              *
C* SOURCE: 02170-18085 REV 1901              *
C*********************************************
C 
C 
C LLU=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)
      LLU=IBUF
      IF(IBUF.LE.0)LLU=1
      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.=HARDWIRE, EVEN S.C.=MODEM COMMUNICATION LINK 
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(LLU,40)LU,LU
   40 FORMAT(/"  TXD00 - 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(LLU,50)LU,LU
   50 FORMAT(/"  TXD00 - 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(LLU,60) LU
   60 FORMAT(/"  TXD00 - 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,LLU+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(LLU,65)LU,INODE 
   65 FORMAT(/"  TXD00 - LU#",I3,": ",I5," IS AN ILLEGAL NODE NUMBER.") 
      GOTO 55 
   70 INODE=IBUF(3) 
C 
C BEGIN DS/1000 TEST
C 
   75 WRITE(LLU,80)LU,INODE 
   80 FORMAT(/"  TXD00 - 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(LLU,90)LU,INODE,IERR
   90 FORMAT(/"  TXD00 - LU#",I3,":  DS/1000 TEST FINISHED ON NODE#"
     1,I5,"   ",I1," ERRORS"/)
      GOTO 1000 
C 
C ERROR MESSAGES
C 
  400 WRITE(LLU,405)
  405 FORMAT(/"  TXD00 - 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(LLU,415)LU
  415 FORMAT(/"  TXD00 - LU#",I3,": NOT ASSIGNED, NOT TESTED!"/)
      GOTO 1000 
C 
  420 WRITE(LLU,425)LU
  425 FORMAT(/"  TXD00 - LU#",I3," IS NOT ASSIGNED TO A DS/1000 LINK."/ 
     1"          RERUN TEST SPECIFYING CORRECT LU#.") 
      GOTO 500
C 
  440 WRITE(LLU,445)LU
  445 FORMAT(/"  TXD00 - LU#",I3,": EQT OR LU FOR DS/1000 LINK IS"
     1" DOWN."/"          UP EQT AND RERUN TEST.")
      GOTO 500
C 
  450 WRITE(LLU,455)LU,INODE
  455 FORMAT(/"  TXD00 - LU#",I3,", NODE#",I5,": TIME TEST FAILED!")
      IERR=IERR+1 
      GOTO 85 
  500 WRITE(LLU,505)LU
  505 FORMAT(/"  TXD00 - LU#",I3,":  DS/1000 TEST ABORTED!"/) 
 1000 END 
      END$
                                                                                                                                                                            