FTN4,L
      SUBROUTINE XXTD3,91711-18032  REV 1926  790906
* 
*     DATE: MARCH 15, 1979
*     NAME: XXTD3 
*     SOURCE: 91711-18032 
*     RELOC:  NONE
*     PGMR:  R.T.A. 
* 
*  *******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS         *
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,          *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT    *
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.           *
*  *******************************************************************
* 
* 
* 
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE DNMPL(ILU,ILLU,
     +IARAY),91711-1X032  REV 1926  790906
C     23.07.79
C     THIS SUBROUTINE REMOVES A MULTIPOINT LINE.
C     LINES ARE REMOVED WHEN PRESENTLY INITIALIZED.  IF A LINE IS 
C     DORMANT A WARNING MESSAGE IS OUTPUT AND NO ATTEMPT TO REMOVE
C     THE LINE IS MADE. 
C 
C     ILU  = CONSOLE LU 
C     ILLU = LIST LU
C 
C     CALLS:  LUCHK  DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, 
C                    RETURN A COMPLETION CODE TO THE CALLER.
C     CALLS:  ILINE  SHOW MULTIPOINT LINE ASSIGNMENT TABLE. 
C 
      DIMENSION IREG(2),ICWORD(2),IARAY(3)
      EQUIVALENCE (IREG(1),REG,IA),(IREG(2),IB) 
      DATA ICWORD/0,2100B/
      DATA ICCC/7/
5     CALL IMSG6(ILLU,0,0,0,IARAY,6,11) 
C 
C     ENTER THE LINE CONTROL INFORMATION.  IF NO MORE LINES, ENTER
C     0 TO STOP.
15    CALL IMSG7(ILU,INLU,IARAY,1,11) 
      IF(INLU.EQ.0) GO TO 900 
C 
C     CHECK LU FOR MULTIPOINT LINE ASSIGNMENT 
C     SHOW NO MESSAGE IF IERCD = 7
      CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC)
      IF(IERCD.NE.7) GO TO 15 
      CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) 
C 
C   REMOVE THE LINE 
      ICW=IOR(100000B,LINE) 
      ICWORD(1) = IOR(100000B,INLU) 
      REG = XLUEX(3,ICWORD,ICW) 
C 
45    CALL IMSG6(ILLU,INLU,LINE,0,IARAY,2,11) 
C 
C   SET INLU AND ITLU TO ZERO 
C 
      INLU = 0
      ITLU = 0
C 
C     END MULTIPOINT LINE REMOVAL 
900   RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE VMPLN(ILU,INLU,ILLU, 
     +IARAY,IXLU),91711-1X032  REV 1926  790906 
C     27.08.79
C     THIS SUBROUTINE USES THE MULTIPOINT LINE LU TO FIND THE 
C     TERMINALS TO BE VERIFIED.  ALL ACTIVE TERMINALS ARE FOUND 
C     BY A "WHO ARE YOU" POLL ON THE LINE, THE RESPONDING TERMINAL ID 
C     ARE THEN USED TO FIND THE EQT ASSIGNMENTS AND THE LU NUMBERS. 
C     THOSE ID NOT FOUND IN THE EQT FROM THE WRU RESPONSE ARE FLAGGED 
C     AS OFF-LINE.  THOSE ID FOUND IN THE EQT BUT NOT AMONG THE WRU 
C     RESPONSE ARE FLAGGED AS EQT VERIFY FAILURES.  THE REMAINING LU
C     ARE VERIFIED.  AS EACH LU IS VERIFIED, THOSE LU FAILING THE VERIFY
C     DISPLAYED WITH COMMENTS.  WHEN ALL ACTIVE LU ARE VERIFIED, THE
C     OFF-LINE TERMINALS ARE VERIFIED.
C 
C     ILU  = CONSOLE LU 
C     INLU = LINE LU
C     ILLU = LIST LU
C 
C 
C     CALLS:  LUCHK  DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, 
C                    RETURN A COMPLETION CODE TO THE CALLER.
C 
C 
C 
      DIMENSION IARAY(3),IOFLN(30),IBUFX(28),IGRUP(30)
      ICNT = 0
C 
C   INITIALIZE BUFFERS
C 
      CALL SFILL(IBUFX,1,56,000B) 
      CALL SFILL(IGRUP,1,60,000B) 
      CALL SFILL(IOFLN,1,60,000B) 
C 
C   TXTD1 - VERIFY LINE 
C 
5     CALL IMSG4(ILLU,0,0,0,0,IARAY,11) 
C 
C   IF INLU IS ZERO, GET A LINE LU
C 
      IF(INLU.GT.0) GO TO 20
C 
C   ENTER THE LINE CONTROL INFORMATION.  IF NO MORE LINES, ENTER
C   0 TO STOP.
C 
19    CALL IMSG7(ILU,INLU,IARAY,1,11) 
      IF(INLU.EQ.0) GO TO 900 
C 
C   CHECK LU FOR MULTIPOINT LINE ASSIGNMENT 
C   SHOW ANY MESSAGE
C 
20    CALL IMSG4(ILLU,INLU,0,0,1,IARAY,11)
      ICCC = 11 
      CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC)
C 
C   IF LINE LU INLU IS INITIALIZED, NO TRMLS ASSIGNED, DO OFF LINE
C 
      IF(IERCD.EQ.7) GO TO 29 
      IF(IERCD.NE.9) GO TO 19 
C 
C   SKIP THE LINE LIST IF THE RUN STRING PARAMETERS DIRECT THE
C   LINE VERIFY.
C 
      IF(IXLU) 23,22
C 
C   LINE IS INITIALIZED, TERMINALS ARE ASSIGNED.  SHOW LINE LIST. 
C 
22    CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     DO THE ACTIVE TERMINALS 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
C 
C   TXTD1 - VERIFY ACTIVE TERMINALS 
C 
23    CALL IMSG4(ILLU,0,0,0,3,IARAY,11) 
C 
      L = 1 
      IF(INLU.EQ.0) GO TO 24
      L = INLU - 1
24    L = L+1 
      ICCC = 10 
      CALL LUCHK(ILLU,L,IERCD,IARAY,ICCC) 
C 
      IF(IERCD.EQ.1) GO TO 26 
      IF(IERCD.EQ.3) GO TO 26 
      IF(IERCD.EQ.-2) GO TO 26
      IF(IERCD.EQ.5) GO TO 25 
      IF(IERCD.EQ.6) 26,25
25    IF(L.EQ.99) GO TO 29
      GO TO 24
C 
C 
C 
C 
C 
C 
C 
C   CALL THE TERMINAL VERIFY SUBROUTINE 
C 
C 
C 
C 
26    IXLU = -1 
      CALL VMPTL(ILU,INLU,ILLU,L,IARAY,IXLU)
      GO TO 24
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     DO THE OFF LINE TERMINALS 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
C 
C   TXTD1 - VERIFY OFF LINE TERMINALS 
C 
29    CALL IMSG4(ILLU,0,0,0,2,IARAY,11) 
      ID = 040175B
C 
C 
C 
C 
30    DO 40 J = 1,27
      L = INLU
C 
C   SHOW THE OFF LINE ID
C 
      CALL IWRXX(ILU,INLU,ILLU,ID,IARAY,IBUFX,IOFLN,-1) 
C 
C   ARE THERE OFF LINE TRMLS ?
C 
      IF(IOFLN(1)) 40,33
C 
C   ARE ALL ID IN THIS GROUP UNIQUE ? 
C 
33    IF(IBUFX(2) - 1) 50,51
C 
C   YES, OK TO DEAL WITH THIS GROUP 
C 
50    ICCC = 10 
      CALL LUCHK(ILLU,L,IERCD,IARAY,ICCC) 
C 
C   IS L A DORMANT MULTIPOINT LU ?
C 
      IF(IERCD.EQ.0) 35,34
34    IF(L.EQ.99) GO TO 44
      L = L+1 
      GO TO 33
C 
C   TXTD1 * ab NOT VERIFIED 
C 
51    CALL IMSG3(ILLU,0,0,IBUFX(3),7,IARAY,11)
      ICNT = ICNT + 1 
      GO TO 40
C 
C   DORMANT TRML LU HERE
C 
35    CALL ILINA(INLU,LINE,IE16,IE11) 
      I4LIN = LINE*10000B 
      KK = 1
      IDCT = 0
      ITLU = L
C 
C   FOR EACH VALID ID, INITIALIZE, VERIFY, AND REMOVE THE TERMINAL
C 
      DO 36 K = 2,IOFLN(1)
      IYLU = 0
      KGID = IOR(IAND(IOFLN(K),057400B),40B)
357   ICWG = IAND(IOFLN(K),37400B)/4B 
      ICWD = IAND(IOFLN(K),077B)
      ICW  = IOR((IOR(I4LIN,ICWG)),(ICWD))
C 
C   INITIALIZE TRML, VERIFY TERMINAL
C 
      CALL UPMPT(ILU,INLU,ILLU,ITLU,ICW,IYLU,IARAY) 
      IF(IYLU.GT.0) GO TO 41
C 
C   TXTD1 - VERIFY MULTIPOINT TRML LU MMAB PASS 
C 
      CALL IMSG4(ILLU,ITLU,0,IOFLN(K),5,IARAY,11) 
C 
C   *LN R TL MM   PASS* 
C 
C     CALL IMSG3(ILLU,LINE,ITLU,IOFLN(K),IARAY,3,11)
      GO TO 43
C 
C   TXTD1 - VERIFY MULTIPOINT TRML LU MMAB FAIL 
C 
41    CALL IMSG4(ILLU,ITLU,0,IOFLN(K),9,IARAY,11) 
C 
C   REMOVE TRML 
C 
43    CALL DNMPT(ILU,ILLU,ITLU,IARAY) 
      ICNT = ICNT+1 
36    CONTINUE
      GO TO 40
C 
C 
C   TXTD1 * AB NOT VERIFIED 
C 
44    DO 45 K = 2,IOFLN(1)
45    CALL IMSG3(ILLU,0,0,IOFLN(K),IARAY,7,11)
      ICNT = ICNT+1 
C 
C   UPDATE THE GROUP UNDER TEST 
C 
40    ID = ID + 400B
C 
C 
C 
C 
C 
      IF(ICNT-1) 42,900 
C 
C   TXTD1 - NO OFF LINE TERMINALS PRESENT 
42    CALL IMSG4(ILLU,0,0,0,4,IARAY,11) 
C 
C   END MULTIPOINT VERIFY 
C 
900   RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE VMPTL(ILU,INLU,ILLU,ITLU,IARAY,
     +IXLU),91711-1X032  REV 1926  790906 
C     06.11.79
C     THIS SUBROUTINE VALIDATES THE MULTIPOINT LINE LU AND TERMINAL 
C     LU BEFORE VERIFYING THE TERMINAL LU.
C     IF INLU OR ITLU POINTS TO EQT = 0, NO VERIFY IS MADE. 
C     FOR NEGATIVE IXLU, INTERACTIVE PROMPTS ARE INHIBITED. 
C     FOR INLU NOT USEABLE, NO VERIFY IS MADE.
C     FOR ITLU HAVING ITS ASSIGNED EQT DOWN, AN ATTEMPT IS
C     MADE TO UP THE EQT.  THE TRML LU IS VERIFIED, THEN IF 
C     THIS LU HAD ITS EQT UPPED BEFORE BEING VERIFIED, THE
C     EQT IS DOWNED.
C 
C 
C     ILU  = CONSOLE LU 
C     INLU = LINE LU
C     ILLU = LIST LU
C     ITLU = TERMINAL LU
C 
C     CALLS:  LUCHK  DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, 
C                    RETURN A COMPLETION CODE TO THE CALLER.
C 
C 
C 
      DIMENSION IGRUP(30),IARAY(3),IOFLN(30)
C 
C   INITIALIZE BUFFERS
C 
      CALL SFILL(IGRUP,1,60,000B) 
      CALL SFILL(IOFLN,1,60,000B) 
C 
C   TXTD1 - VERIFY A TERMINAL 
C 
5     CALL IMSG6(ILLU,0,0,0,IARAY,7,11) 
C 
C   IF INLU IS ZERO, GET A LINE LU
C 
      IF(INLU.GT.0) GO TO 20
C 
C   ENTER THE LINE CONTROL INFORMATION.  IF NO MORE LINES, ENTER
C   0 TO STOP.
C 
15    CALL IMSG7(ILU,INLU,IARAY,1,11) 
      IF(INLU.EQ.0) GO TO 900 
C 
C   CHECK LU FOR MULTIPOINT LINE ASSIGNMENT 
C   SHOW ANY MESSAGE
C 
20    ICCC = 9
      CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC)
      IF(IERCD.EQ.5) GO TO 900
      IF(IERCD.EQ.7) GO TO 19 
      IF(IERCD.NE.9) GO TO 15 
C 
C 
19    IF(IXLU) 24,21
C 
C   SHOW THE LINE 
C 
21    CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) 
C 
C   IF ITLU IS ZERO, GET A TERMINAL LU.  CHECK THAT THE TERMINAL LU 
C   IS NOT THE SAME AS THE LINE LU. 
C 
24    IF(ITLU.GT.0) GO TO 27
C 
      IF(INLU.EQ.ITLU) GO TO 30 
C 
C   GET A TRML LU 
C 
26    CALL IMSG7(ILU,ITLU,IARAY,3,11) 
C 
      IF(ITLU.EQ.0) GO TO 15
C 
C   CHECK THE LU
C 
      GO TO 27
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C   GET THE TERMINAL EQT NUMBER AND TRY TO UP THE EQT 
C   THE VALUE OF ICCC RETURNED BY LUCHK FOR IERCD = 3 IS
C   THE INTEGER EQT NUMBER FOR THE TERMINAL LU. 
C 
22    IUPDN = ICCC
      CALL IMSG3(ILLU,ICCC,IX,0,IARAY,9,11) 
C 
C   IX IS THE COMPLETION CODE RETURNED BY THE ATTEMPT TO UP AN EQT. 
C   IF IX IS NEGATIVE, THE ATTEMPT HAS FAILED.
C   GO VERIFY THE TERMINAL ANYWAY, REPORT THE EQT STRUCTURE.
C 
      ICCC = 10 
      CALL LUCHK(ILLU,ITLU,IERCD,IARAY,ICCC)
C 
      IF(IERCD.EQ.6) GO TO 28 
C 
C  THIS EQT CANNOT BE VERIFIED. 
C  TXTD1 * LN E TL AB** NOT VERIFIED
C 
18    CALL IMSG3(ILLU,LINE,ITLU,025052B,IARAY,0,11) 
      GO TO 900 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
C 
C   CHECK TERMINAL ASSIGNMENT 
C 
27    ICCC = 6
      IUPDN = -1
      CALL LUCHK(ILLU,ITLU,IERCD,IARAY,ICCC)
      IF(IERCD.EQ.3) GO TO 29 
      IF(IERCD.EQ.5) GO TO 900
      IF(IERCD.EQ.6) GO TO 29 
      IF(IERCD.EQ.-2) GO TO 29
C 
C   THERE'S SOMETHING WRONG WITH USING THIS LU THAT AN :UP,EQT
C   WON'T FIX.  IF THIS IS A VERIFY SPECIFIED TO RUN TO COMPLETION
C   BY THE RUN PARAMETERS, SHOW A NOT VERIFIED MESSAGE.  OTHERWISE
C   ASK THE OPERATOR FOR ANOTHER LU.
C 
      IF(IXLU) 18,26
C 
C 
C 
C 
C 
C   GET THE TERMINAL ID CHARACTERS FROM THE EQT 
C 
29    CALL ILINA(ITLU,LINE,ITID,IE11) 
      KGID = IOR(IAND(ITID,057400B),40B)
      ID = IOR(KGID,175B) 
C 
C   IF THE TERMINAL LU OR EQT IS DOWN, TRY TO UP THE EQT BEFORE 
C   VERIFYING THE TERMINAL LU.
C 
31    IF(IERCD.EQ.3) GO TO 22 
      IF(IERCD.EQ.-2) GO TO 22
C 
C   VERIFY THE TERMINAL 
C 
28    IXLU = 0
      CALL LUVFY(INLU,ILLU,ITLU,IGRUP,IOFLN,ID,KGID,5,IXLU,IARAY) 
      IF(IXLU.GT.0) GO TO 30
C 
C   TXTD1 - VERIFY MULTIPOINT TRML LU NNAB PASS 
C 
      CALL IMSG4(ILLU,ITLU,0,ITID,5,IARAY,11) 
C 
C   *LN L TL NN  PASS*
C 
C     CALL IMSG3(ILLU,LINE,ITLU,ITID,IARAY,3,11)
      GO TO 40
C 
C   TXTD1 - VERIFY MULTIPOINT TRML LU NNAB FAIL 
C 
30    CALL IMSG4(ILLU,ITLU,0,ITID,9,IARAY,11) 
C 
C   DOWN THE EQT IF THE EQT WAS UPPED BEFORE VERIFICATON. 
C 
40    IF(IUPDN) 900,41
C 
C   DOWN THE EQT = IUPDN
C 
41    CALL IMSG3(ILLU,IUPDN,IX,0,IARAY,2,11)
C 
C   IX IS THE COMPLETION CODE RETURNED BY THE ATTEMPT TO DOWN THE 
C   EQT.  IF IX IS NEGATIVE, THE ATTEMPT HAS FAILED.
C 
C 
C 
900   RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE UPMPL(ILU,INLU,ILLU, 
     +IARAY),91711-1X032  REV 1926  790906
C     23.07.79
C     THIS SUBROUTINE INITIALIZES A MULTIPOINT LINE.
C     LINES  THAT ARE ALREADY INITIALIZED WILL NOT BE RE-INITIALIZED AND
C     A WARNING MESSAGE IS OUTPUT.
C 
C     ILU  = CONSOLE LU 
C     ILLU = LIST LU
C 
C     CALLS:  LUCHK   DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT,
C                     RETURN A COMPLETION CODE TO THE CALLER. 
C     CALLS:  ILINE   SHOW MULTIPOINT LINE ASSIGNMENT TABLE.
C 
C 
C 
      DIMENSION IREG(2),ICWORD(2),IARAY(3),IMESS1(1)
      EQUIVALENCE (IREG(1),REG,IA),(IREG(2),IB) 
      DATA IMESS1/15505B/ 
      DATA ICWORD/0,0/
      DATA IFUN/2000B/
      DATA ICCC/4/
C 
C  TXTD1 - INITIALIZE A LINE
C 
5     CALL IMSG6(ILLU,0,0,0,IARAY,8,11) 
C 
C     ENTER THE LINE CONTROL INFORMATION.  IF NO MORE LINES, ENTER
C     0 TO STOP.
C 
15    CALL IMSG7(ILU,INLU,IARAY,0,11) 
      IF(INLU.EQ.0) GO TO 9999
C 
C     CHECK LU FOR MULTIPOINT LINE ASSIGNMENT 
C     SHOW NO MESSAGE IF IERCD = 4
C 
      CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC)
      IF(IERCD.EQ.4) GO TO 25 
      IF(IERCD.EQ.7) GO TO 60 
      IF(IERCD.EQ.9) GO TO 60 
      GO TO 15
C 
C     ENTER TIMEOUT AND LINE NUMBER DATA
C 
25    CALL IMSG7(ILU,ITOV,IARAY,8,11) 
35    CALL IMSG7(ILU,ILNN,IARAY,9,11) 
C 
C     INITIALIZE THE LINE 
C 
      ICW=IOR(IOR(100000B,(ITOV*1000B)),ILNN) 
      ICWORD(1) = IOR(100000B,INLU) 
      ICWORD(2) = IFUN
      REG = XLUEX(3,ICWORD,ICW) 
      ID = 17776B 
      ICWORD(2) = 400B
      REG = XLUEX(2,ICWORD,IMESS1,1,ID) 
C 
C   TXTD1 - LINE LU N INITIALIZED.  ASSIGNED LINE NO. M.
C 
45    CALL IMSG6(ILLU,INLU,ILNN,0,IARAY,1,11) 
      GO TO 9999
C 
C   SHOW LINE NUMBER AND TERMINAL LU NUMBER(S) ASSIGNED TO THIS LINE
60    CONTINUE
      CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) 
C   INUM = 0  NO MULTIPOINT DEVICES ASSIGNED
C   INUM = 1  LINE IS ASSIGNED
C   INUM > 1  LINE AND TERMINALS ASSIGNED 
63    GO TO 15
9999  CONTINUE
C 
C     END MULTIPOINT LINE INITIALIZATION
C 
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE OFFLN(ILU,INLU,ILLU, 
     +IARAY),91711-1X032  REV 1926  790906
C     27.06.79
C     THIS SUBROUTINE SHOWS OFF LINE MULTIPOINT TERMINAL ID 
C     FOR ALL GROUPS.  ONLY THOSE TERMINAL ID WHICH ARE CLEAR FOR 
C     VERIFICATON ARE SHOWN.
C     NO PARAMETERS IN THE CALL STRING ARE MODIFIED.
C     THIS SUBROUTINE IS CALLED BY TXTD3. 
C 
C     ILLU = LIST LU
C     INLU = LINE LU
C 
      DIMENSION IREG(2),IOFLN(30),IBUFX(28),IARAY(3)
      EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) 
C 
      CALL SFILL(IBUFX,1,56,000B) 
      CALL SFILL(IOFLN,1,60,000B) 
C 
C 
C   SKIP THE LINE LU ENTRY IF THE CURRENT INLU IS VALID.
C 
      IF(INLU.EQ.0) GO TO 11
      ICNT = 0
10    ICCC = 11 
      CALL LUCHK(ILLU,INLU,IERXX,IARAY,ICCC)
      IF(IERXX.EQ.7) GO TO 15 
      IF(IERXX.EQ.9) GO TO 15 
C 
C   ENTER THE LINE LU.  ENTER 0 TO ABORT
C 
11    CALL IMSG7(ILU,INLU,IARAY,1,11) 
      IF(INLU.EQ.0) GO TO 900 
      GO TO 10
C 
C 
C 
15    ID = 040175B
      DO 60 J = 1,27
C   SHOW THE OFF LINE ID
      CALL IWRXX(ILU,INLU,ILLU,ID,IARAY,IBUFX,IOFLN,1)
      IF(IOFLN(1)) 60,20
20    ICNT = ICNT+1 
60    ID = ID + 400B
C 
C 
      IF(ICNT-1) 61,900 
C   TXTD1 - NO MULTIPOINT TERMINALS PRESENT 
61    CALL IMSG4(ILLU,0,0,0,4,IARAY,11) 
C 
900   RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE IMPXX(ITLU,ILLU,INLU,IARAY,
     +IFFF),91711-1X032  REV 1926  790906 
C     10.29.79
C     THIS SUBROUTINE DISPLAYS THE MULTIPOINT LINE AND TERMINAL 
C     CONFIGURATION FOR THE 3075A, 3076A, 3077A TERMINALS.
C     ITLU, ILLU, INLU, IARAY, IFFF ARE PASSED TO IMPXX IN ALL CASES. 
C     INLU AND IFFF ARE REDEFINED IN THE FOLLOWING WAY: 
C 
C     ITLU = MULTIPOINT LU
C     ILLU = LIST LU
C     INLU = LINE LU
C            IF ITLU IS A LINE LU, THEN INLU = ITLU.  THIS WORKS FOR
C            A LINE LU BEING THE NUMERICALLY SMALLEST NUMBER AND THEREFORE
C            THE FIRST TYPE 7 EQT AS THE DRT IS SEARCHED IN ASCENDING 
C            NUMERICAL ORDER. IF A SECOND LINE LU IS DEFINED, INLU WILL 
C            BE REDEFINED AS THE CURRENT LINE LU.  GENERATION OF TWO LINES
C            IN A SYSTEM MUST GROUP INTENDED LU TO BE ATTACHED TO EACH
C            LINE IN NUMERICAL ORDER BY LINE LU. (I.E., INLUA, ITLUA1,
C            ITLUA2, ITLUA3,...,INLUB, INLUB1, INLUB2, INLUB3,...)
C     IFFF = MESSAGE FORMAT CONTROL ON ENTRY, ITLU CONDITION CODE ON EXIT 
C          = -1, SURVEY MESSAGE ON ENTRY, OTHERWISE VERIFY MESSAGE
C          = -2, ITLU IS NOT AVAILABLE FOR VERIFICATION ON EXIT 
C 
C     CALLS:  X13    ASSEMBLY ROUTINE FOR STATUS REQUEST ON 
C                    SYSTEM LU. 
C     CALLS:  SHFT   ASSEMBLY ROUTINE MOVES UPPER BYTE TO LOWER BYTE
C                    FILLING ZEROS IN UPPER BYTE. 
C     CALLS:  SHF14  ASSEMBLY ROUTINE MOVES UPPER TWO BITS TO LOWER 
C                    TWO BITS OF THE WORD.  BITS 15-2 ARE ZEROS.
C     CALLS:  SHF15  ASSEMBLY ROUTINE MOVES BIT 15 TO BIT 0,
C                    BITS 14-1 ARE ZEROS. 
C     CALLS:  LUCHK  DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, 
C                    RETURN A COMPLETION CODE TO THE CALLER.
C     CALLS:  ITSTA  GET MULTIPOINT TERMINAL STATUS FROM ACTIVE 
C                    MULTIOINT TERMINAL.
C 
C 
C 
C 
      DIMENSION IREG(2),IBUFR(128),IMDL5(3),IMDL6(3),IMDL7(3),
     +IBT41(1),IBT42(1),IBT43(1),IBT44(1),IBT51(1),IBT52(1),IBT53(2), 
     +IMESS1(2),IMESS2(2),IMESS3(2),IMESS4(3),IMESSA(2),IMESSB(2),
     +IMESSC(3),IBT45(1),IBT46(1),IBT47(3), 
     +XGRUP(30),IBUFS(28),IBUFV(60),
     +ICWORD(2),IBUFX(28),IBT48(3),IBT49(1),IMESSD(3) 
      EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) 
      INTEGER XGRUP 
      DATA IMDL5/2H30,2H75,2HA /
      DATA IMDL6/2H30,2H76,2HA /
      DATA IMDL7/2H30,2H77,2HA /
      DATA IBT41/2H P/
      DATA IBT42/2H M/
      DATA IBT43/2H V/
      DATA IBT44/2H -/
      DATA IBT45/2H */
      DATA IBT46/2H**/
      DATA IBT47/2H**,2H**,2H* /
      DATA IBT48/2H*2,2H64,2HX /
      DATA IBT49/2H*S/
      DATA IBT51/2H N/
      DATA IBT52/2H A/
      DATA IBT53/2H -,2H- / 
      DATA IMESS1/2HLI,2HNE/
      DATA IMESS2/2HTR,2HML/
      DATA IMESS3/2HDO,2HWN/
      DATA IMESS4/2H  ,2H  ,2H  / 
      DATA ICCC/10/ 
      DATA ICWORD/0,0/
      DATA IMESSD/2H  ,2H: ,2H  / 
      DATA IMESSC/2H  ,2H  ,2H  / 
      DATA IMESSA/2H  ,2H  /
      DATA IMESSB/2H  ,2H  /
      ISINT = 0 
      ISPR = 0
      ISRM = 0
      ISLM = 0
      ISMDL = 0 
      ISDSY = 0 
      ISKY = 0
      IFBIT = 0 
      ISCOD = 0 
C 
      IDRT= IGET(1652B) 
      IEQTA=IGET(1650B) 
C 
      IVAL =IGET(IDRT+ITLU-1) 
      IEQQ = IAND(IVAL,077B)
C 
C   STATUS REQUEST ON ITLU.   X13 SETS BYPASS CONDITION.
      CALL X13(ITLU,IEQT5,IEQT4,IEQTST) 
C 
C  CHECK FOR TYPE 7 DEVICE AT THIS LU 
C 
      IDVC7 = IAND(IEQT5,037400B) 
      CALL SHFT(IDVC7)
C  IDVC7 HAS LOWER 8 BITS CONTAINING INFORMATION
      IF(IDVC7.NE.7) GO TO 900
C  IF LU IS POINTED TO EQT 0, SHOW THE LU 
      IF(IEQQ.EQ.0) GO TO 12
C  CHECK FOR NONZERO SELECT CODE ASSIGNMENT 
      ISCOD =IAND(IEQT4,077B) 
      IF(ISCOD.EQ.0) GO TO 900
C 
C 
C  DETERMINE IF LU IS DOWN, AND AVAILABILITY OF EQT 
      IAV = IEQT5 
      CALL SHF14(IAV) 
      IFBIT=IEQTST
      CALL SHF15(IFBIT) 
      IEQ5S=IAND(IEQT5,377B)
C  DETERMINE IF LU IS LINE OR TERMINAL
      IETBL=(IEQQ-1)*15+IEQTA 
      IE11 = IGET(IETBL+10) 
      IEQX = IGET(IETBL+12) 
      IE16 =IGET(IEQX)
      IE17 =IGET(IEQX+1)
      LBIT=IE16 
      CALL SHF15(LBIT)
      LINE = IAND(IE17,03400B)
      CALL SHFT(LINE) 
C   INITIALIZE VARIABLES FOR LISTING
12    ILLP=0
      ILNN=55B
      CALL SFILL(IMESSC,1,6,040B) 
      IKY=40B 
      IDSY=40B
      ILM =40B
      IRM =40B
      INT =20040B 
      IPR =40B
      IHRS=20040B 
      IMIN=20040B 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C  DETERMINE IF TERMINAL IS INITIALIZED, SHOW NO MESSAGE
C 
C     WRITE(ILLU,110) INLU,ITLU 
110   FORMAT(2X"IMPXX N:",I2X,"T:",I2)
      ICCC = 10 
20    CALL LUCHK(ILLU,ITLU,IERCD,IARAY,ICCC)
C 
C 
      IF(IERCD.EQ.-1)GO TO 29 
      IF(IERCD.EQ.-2)GO TO 29 
      IF(IERCD.EQ.0) GO TO 21 
      IF(IERCD.EQ.1) GO TO 30 
      IF(IERCD.EQ.2) GO TO 40 
      IF(IERCD.EQ.3) GO TO 30 
      IF(IERCD.EQ.4) GO TO 23 
      IF(IERCD.EQ.5) GO TO 40 
      IF(IERCD.EQ.6) GO TO 25 
      IF(IERCD.EQ.7) GO TO 27 
      IF(IERCD.EQ.8) GO TO 10 
      IF(IERCD.EQ.9) GO TO 27 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C  DORMANT MULTIPOINT TERMINAL
C 
21    DO 22 J=1,2 
      IMESSA(J)=IMESS2(J) 
      IMESSB(J)=IMESS4(J) 
22    CONTINUE
      GO TO 10
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C  DORMANT MULTIPOINT LINE
C 
23    DO 24 J=1,2 
      IMESSA(J)=IMESS1(J) 
      IMESSB(J)=IMESS4(J) 
24    CONTINUE
      GO TO 10
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C   NONZERO SUBCHANNEL
C 
29    IMESSA(1) = IBT49 
      IMESSA(2) = KCVT(IAND(IEQTST,17B))
      CALL SFILL(IMESSB,1,4,0040B)
C 
C  IF THIS LU SHARES AN EQT, THEN THE EQT MAY HAVE A LINE NUMBER. 
C 
      IF(IE11.NE.0) ILNN = KCVT(LINE) 
C 
C  IF THIS LU IS UNAVAILABLE AS WELL, GO FILL IN THE DOWN MESSAGE 
C 
      IF(IERCD.EQ.-2) GO TO 291 
      GO TO 10
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C*********************************************************************
C 
C  ACTIVE MULTIPOINT TERMINAL 
C 
25    IMESSA(1)=IE16
      IMESSA(2)=020040B 
      DO 26 J=1,2 
      IMESSB(J)=IMESS4(J) 
26    CONTINUE
      ILNN = KCVT(LINE) 
C 
C   FOR INLU = 0, COMPLETE IMMEDIATELY
C 
      IF(INLU.EQ.0) GO TO 10
C 
C   GET TERMINAL CONFIGURATION DATA 
C 
C************************************************************** 
C 
C  INITIALIZE BUFFERS 
C 
13    CALL SFILL(XGRUP,1,60,000B) 
      CALL SFILL(IBUFS,1,56,000B) 
      CALL SFILL(IBUFX,1,56,000B) 
      IBUFL = 128 
      CALL SFILL(IBUFR,1,256,000B)
      IF(IE11.NE.0) ILLP = 1
C 
C 
132   CALL LUCHK(ILLU,INLU,IERXX,IARAY,ICCC)
C 
C 
      IF(IERXX.EQ.9) GO TO 133
      GO TO 10
C 
C   GET THE GROUP ID FOR ITLU 
133   CALL ILINA(ITLU,ILXX,IE16,IE11) 
      KGID = IOR(IAND(IE16,057400B),40B)
C 
C   GET ALL TERMINALS IN CURRENT GROUP WITH WRU 
      CALL IGRID(INLU,KGID,XGRUP) 
      IF(XGRUP(1)) 608,137
C 
C   CHECK XGRUP FOR DUPLICATE ID.  ANY DUPLICATES ARE PUT IN IBUFX. 
137   CALL IXBUF(XGRUP,IBUFX) 
C 
C   GET ALL LU IN CURRENT GROUP RETURNED IN IBUFS 
C   IBUFS(1) = INLU ,  IBUFS(2) = NUMBER OF NONZERO WORDS IN IBUFS
C   IBUFS(3) = ITLU1,  IBUFS(4) = ITLU2, IBUFS(5) = ITLU3  ...
608   CALL ILINB(ILLU,INLU,KGID,IBUFS,INAT,ITMCT) 
C   WERE ANY LU IN CURRENT GROUP ? IBUFS(2) WILL BE 3 OR GREATER. 
      IF(IBUFS(2) - 3) 165,139
C 
C************************************************************ 
C   THERE ARE LU IN THE CURRENT GROUP.  SORT IT OUT.
C 
139   IDVCT = 0 
      KK = 1
      CALL SFILL(IBUFV,1,120,000B)
      IBUFV(1) = -1 
C 
C   EACH LU IN IBUFS HAS AN ID IN CURRENT GROUP.  IF MATCH IS NOT 
C   ONE-ONE SAVE THE DATA.
C 
      DO 145 J = 3,IBUFS(2) 
      IDCT = -1 
C 
      DO 143 K = 2,XGRUP(1) 
C   COUNT HOW MANY TRML ID ARE IN WRU LIST
      IF(XGRUP(K).NE.IE16) 143,142
142   IDCT = IDCT+1 
      IDVCT = IDVCT+1 
143   CONTINUE
C 
C   IDCT = HOW MANY SIMILAR ID WERE FOUND IN THE CURRENT GROUP
C   IDCT = 0 IF ONE MATCH WAS FOUND.
C 
      IF(IDCT) 144,145,144
C   IF MATCH IS NOT ONE-ONE, SAVE THE DATA IN IBUFV 
144   CALL IVBUF(IDCT,IE16,IBUFS(J),IBUFV)
145   CONTINUE
C 
C   FOR A RESPONSE TO WRU IN THIS GROUP, INAT > 0. FOR THE EXPECTED 
C   ONE-ONE MATCH BETWEEN ID'S IN EQT AND ID'S IN WRU RESPONSES,
C   AND INAT > 0, SET IDCT = 0. 
      IF((INAT.EQ.IDVCT).AND.(INAT.GT.0)) IDCT = 0
C 
C************************************************************ 
C 
C   IF IBUFV HAS ANY DATA ALL IS NOT WELL 
      IF(IBUFV(1).GT.0) IERCT = IERCT+1 
C 
C   FIND ID IN WRU LIST ? 
      IF(IDCT) 146,41 
C 
C 
C   NO ID IN WRU LIST.  IS THIS A SURVEY OR VERIFY MESSAGE ?
146   IF(IFFF) 164,202
C   SURVEY MESSAGE FOR ID NOT IN WRU
164   WRITE(ILLU,213)ITLU,IFBIT,IEQQ,IAV,IEQ5S,ISCOD,IE17,ILLP,ILNN,
     +IMESSA,IMESSB 
      IFFF = -2 
      GO TO 900 
C 
C   ID FOUND IN WRU LIST
C   CHECK IBUFX FOR DUPLICATE ID IN WRU BEFORE GETTING CONFIGURATION
C   IBUFX(1) = -1 FOR NO DUPLICATE ID IN WRU
41    IF(IBUFX(1)) 147,36 
C 
C 
C   K POINTS TO ID, K-1 POINTS TO HOW MANY THERE ARE IN WRU LIST
36    K = 3 
37    IF(IBUFX(K).EQ.IE16) 39,38
C 
C   HAS THE LAST ID IN IBUFX BEEN CHECKED ? 
38    IF(K.EQ.IBUFX(1)) 147,44
44    K = K+2 
      GO TO 37
C 
C   DUPLICATE ID IN WRU, IS THIS A SURVEY MESSAGE ? 
39    IF(IFFF) 42,43
C 
C   SURVEY MESSAGE FOR DUPLICATE ID IN WRU
42    WRITE(ILLU,214)ITLU,IFBIT,IEQQ,IAV,IEQ5S,ISCOD,IE17,ILLP,ILNN,
     +IMESSA,IMESSB,IBUFX(K),IBUFX(K-1) 
      IFFF = -2 
      GO TO 900 
C 
C   VERIFY MESSAGE FOR DUPLICATE ID IN WRU
43    WRITE(ILLU,220)ITLU,IEQQ,IMESSA,IMESSB,IBUFX(K),IBUFX(K-1)
      IFFF = -2 
      GO TO 900 
C 
C 
C 
147   CONTINUE
165   CONTINUE
163   CONTINUE
C 
C   THE ID ARE DISTINCT.  IF IMPXX WAS CALLED BY ILIND, IFFF = 1. 
      IF(IFFF) 150,150,202
C 
C   IF THE LU OR EQT IS UNAVAILABLE, DO NOT GET THE TRML STATUS.
C   REPORT A DOWN SITUATION AND MARK INITIALIZED TRML WITH ***'S
C 
150   IF(IERCD.EQ.3) GO TO 61 
      IF(IERCD.EQ.1) GO TO 61 
      CONTINUE
C 
C************************************************************** 
C 
11    CALL ITSTA(ILLU,ITLU,IERCD,INT,IPR,IRM,ILM,IMDL,IDSY,IKY, 
     +IHRS,IMIN,IARAY)
C   SAVE TERMINAL CONFIGURATION DATA
      ISINT = INT 
      ISPR = IPR
      ISRM = IRM
      ISLM = ILM
      ISMDL = IMDL
      ISDSY = IDSY
      ISKY = IKY
C   CHECK ITSTA COMPLETION CODE 
      IF(IERCD.EQ.0)  GO TO 50
      IF(IERCD.EQ.1)  GO TO 69
      IF(IERCD.EQ.2)  GO TO 64
      IF(IERCD.EQ.3)  GO TO 65
      IF(IERCD.EQ.4)  GO TO 66
      IF(IERCD.EQ.5)  GO TO 67
      IF(IERCD.EQ.6)  GO TO 63
      IF(IERCD.EQ.7)  GO TO 70
      IF(IERCD.EQ.-1)  GO TO 60 
C 
C   TERMINAL STATUS AVAILABLE 
C   TERMINAL RIGHT HAND MODULE
50    IF(ISRM.EQ.0) IRM = IBT44 
      IF(ISRM.EQ.1) IRM = IBT41 
      IF(ISRM.EQ.2) IRM = IBT42 
      IF(ISRM.EQ.3) IRM = IBT45 
      IF(ISRM.EQ.4) IRM = IBT43 
      IF(ISRM.EQ.5) IRM = IBT45 
      IF(ISRM.EQ.6) IRM = IBT45 
      IF(ISRM.EQ.7) IRM = IBT45 
C   TERMINAL LEFT HAND MODULE 
      IF(ISLM.EQ.0) ILM = IBT44 
      IF(ISLM.EQ.1) ILM = IBT41 
      IF(ISLM.EQ.2) ILM = IBT42 
      IF(ISLM.EQ.3) ILM = IBT45 
      IF(ISLM.EQ.4) ILM = IBT43 
      IF(ISLM.EQ.5) ILM = IBT45 
      IF(ISLM.EQ.6) ILM = IBT45 
      IF(ISLM.EQ.7) ILM = IBT45 
C   TERMINAL DISPLAY
      IF(ISDSY.EQ.0) 510,511
510   IDSY = IBT51
      GO TO 512 
C 
511   IDSY = IBT52
512   CONTINUE
C 
C   TERMINAL MODEL
      IF(ISMDL.EQ.0) GO TO 52 
      IF(ISMDL.EQ.1) GO TO 54 
      IF(ISMDL.EQ.2) GO TO 56 
      GO TO 58
C 
C   3075A 
52    DO 53 J=1,3 
      IMESSC(J) = IMDL5(J)
53    CONTINUE
      GO TO 501 
C 
C   3076A 
54    DO 55 J=1,3 
      IMESSC(J) = IMDL6(J)
55    CONTINUE
C 
C   CONVERT TO ASCII - PRINTER BUSY STATE 
501   IPR = IOR(ISPR,60B) 
C 
C   TERMINAL INTERRUPT STATE
502   INT = IOR(IOR(ISINT*400B,30000B),102B)
C 
C   TERMINAL KEYBOARD 
C 
503   IF(ISKY.EQ.0) 513,514 
513   IKY = IBT51 
      GO TO 515 
C 
514   IKY = IBT52 
515   CONTINUE
      GO TO 10
C 
C 
C   3077A 
56    DO 57 J=1,3 
      IMESSC(J) = IMDL7(J)
57    CONTINUE
C 
C   SET THE HOURS AND MINUTES IN IMESSD 
      IMESSD(1) = IHRS
C 
      ITMIN = IMIN
C 
      CALL SPUT(IMESSD,3,072B)
C 
      CALL SGET(ITMIN,1,JMT)
      CALL SGET(ITMIN,2,JMU)
      CALL SPUT(IMESSD,4,JMT) 
      CALL SPUT(IMESSD,5,JMU) 
C 
C   THERE'S NO KEYBOARD FOR 3077A 
C 
      IKY = IBT44 
      GO TO 10
C 
C 
C   UNKNOWN TERMINAL
58    DO 59 J=1,3 
      IMESSC(J) = IBT47(J)
59    CONTINUE
      GO TO 10
C 
C 
C 
C  STATUS DATA IS NOT COMPLETE.  ASSEMBLE IMESSA THEN FLAG THE
C  REMAINING FIELDS AS UNAVAILABLE. 
C 
C  TRANSMISSION LOG IS ZERO 
60    IMESSA(2) = 25052B
C  SET UNAVAILABLE FLAG IN REMAINING FIELDS 
61    CONTINUE
      IPR = IBT45 
      INT = IBT46 
      IRM = IBT45 
      ILM = IBT45 
      IDSY= IBT45 
      IKY = IBT45 
C 
      IF(IERCD.EQ.1) 610,612
612   IF(IERCD.EQ.6) 610,620
C 
610   IF(IFFF) 611,615
C   SURVEY
611   IFFF = -2 
      GO TO 10
C 
C   VERIFY
615   IFFF = -2 
      GO TO 201 
C 
620   DO 62 J=1,3 
      IMESSC(J)=IBT47(J)
62    CONTINUE
      GO TO 10
C 
C  TRANSMISSION LOG IS 5, 264X TERMINAL 
63    IMESSA(2) = 25052B
      DO 68 J = 1,3 
68    IMESSC(J) = IBT48(J)
      GO TO 61
C 
C  BYTE 6 IS NOT CR (15B) 
64    IMESSA(2) = 25066B
      GO TO 61
C 
C 
C  BIT 7 IN BYTE 3 IS CLEAR, SHOULD BE SET
65    IMESSA(2) = 25063B
      GO TO 61
C 
C  BIT 7 IN BYTE 4 IS CLEAR, SHOULD BE SET
66    IMESSA(2) = 25064B
      GO TO 61
C 
C  BIT 7 IN BYTE 5 IS CLEAR, SHOULD BE SET
67    IMESSA(2) = 25065B
      GO TO 61
C 
C   TRANSMISSION LOG IS NOT 3 OR 5, OR WORD 1 IS NOT RIGHT
69    IMESSA(2) = 25061B
      GO TO 61
C 
C  TRANSMISSION LOG IS 4, UNKNOWN TERMINAL
70    IMESSA(2) = 25067B
      GO TO 61
C 
C 
C 
C*********************************************************************
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C  ACTIVE LINE, FILL IMESSA, IMESSB, AND ILNN FIELDS
27    DO 28 J=1,2 
      IMESSA(J)=IMESS1(J) 
      IMESSB(J)=IMESS4(J) 
28    CONTINUE
      ILNN = KCVT(LINE) 
      INLU = ITLU 
      GO TO 10
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C  A MULTIPOINT DEVICE EQT OR LU IS DOWN.  IERCD VALUES 5,1,2,3 
C  ARE TESTED AS SHOWN IN ORDERED LIST. 
30    IF(LBIT.EQ.0) GO TO 32
C  LINE HERE
      DO 31 J=1,2 
      IMESSA(J)=IMESS1(J) 
      IMESSB(J)=IMESS3(J) 
31    CONTINUE
      ILNN = KCVT(LINE) 
      INLU = ITLU 
      GO TO 10
C 
C 
C  SIGN BIT IS CLEAR, DEVICE IS A TERMINAL.  IS IT DORMANT? 
32    IF(IE16.EQ.0) GO TO 34
C  AN ACTIVE MULTIPOINT TERMINAL HERE.
      IMESSA(1) = IE16
      IMESSA(2) = 020040B 
      ILNN = KCVT(LINE) 
C 
C   ENTER HERE FROM NONZERO SUBCHANNEL IF IERCD = -2
C 
291   DO 33 J=1,2 
      IMESSB(J)=IMESS3(J) 
33    CONTINUE
C 
C  IF THIS LU HAS A SUBCHANNEL AND IS UNAVAILABLE, DON'T GET STATUS 
C 
      IF(IERCD.EQ.-2) GO TO 10
C 
C  IF INLU = 0, WE CAN'T DO ANY LINE OPERATIONS FOR THIS ACTIVE LU. 
C  COMPLETE IMMEDIATELY.
C 
      IF(INLU.EQ.0) GO TO 10
C 
C  THE ONLY OTHER WAY TO GET THIS FAR WAS BY STATEMENT 20 
C 
C  SET UNAVAILABLE FLAG IN REMAINING FIELDS IF EQT IS IN LINKED LIST
C 
      IF(IE11.NE.0) GO TO 13
      GO TO 10
C 
C 
C  DORMANT MULTIPOINT TERMINAL HERE.
34    DO 35 J=1,2 
      IMESSA(J)=IMESS2(J) 
      IMESSB(J)=IMESS3(J) 
35    CONTINUE
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C  CHECK LINKED LIST POINTER
10    IF(IE11.EQ.0) GO TO 45
      ILLP = 1
C 
C 
C 
C 
C 
C  SEND A SURVEY OR VERIFY MESSAGE
C 
C  IS THIS TERMINAL 3077A ? 
C 
45    IF(ISMDL.EQ.2) 46,40
C 
C  USE STATEMENT 47, 48  IF THIS IS SURVEY FORMAT AND 3077A TERMINAL
C 
46    IF(IFFF) 47,48,202
C 
C  3077A SURVEY MESSAGE 
C 
47    WRITE(ILLU,204)ITLU,IFBIT,IEQQ,IAV,IEQ5S,ISCOD,IE17,ILLP, 
     +ILNN,IMESSA,IMESSB,IMESSC,IKY,IDSY,ILM,IRM,IMESSD 
      GO TO 900 
C 
C  3077A VERIFY MESSAGE 
C 
48    WRITE(ILLU,205)ITLU,IEQQ,IMESSA,IMESSB,IMESSC,IKY,IDSY,ILM, 
     +IRM,IMESSD
      GO TO 900 
C 
C  STATEMENTS 200, 201 USED FOR 3075A, 3076A TERMINALS. 
C  IF IFFF = -1, SHOW SURVEY MESSAGE.  OTHERWISE SHOW VERIFY MESSAGE. 
C 
40    IF(IFFF)200,201,202 
C 
C   SURVEY MESSAGE
C 
200   WRITE(ILLU,210)ITLU,IFBIT,IEQQ,IAV,IEQ5S,ISCOD, 
     +IE17,ILLP,ILNN,IMESSA,IMESSB, 
     +IMESSC,IKY,IDSY,ILM,IRM,INT,IPR 
C 
C  CHECK IF THIS TERMINAL IS DOWN, SET IFFF = -2 IF IT IS.
C 
      IF(IERCD.EQ.-2) IFFF = -2 
      GO TO 900 
C 
C   VERIFY MESSAGE
C 
201   WRITE(ILLU,211)ITLU,IEQQ,IMESSA,IMESSB,IMESSC,IKY,IDSY,ILM,IRM, 
     +INT,IPR 
C 
C   INHIBIT ANY MESSAGES TO THE TERMINAL LU IF ITLU OR THE EQT IS DOWN
C 
      IF(IERCD.EQ.3) IFFF = -2
      GO TO 900 
C 
C   VERIFY MESSAGE FOR ID NOT IN WRU
C 
202   WRITE(ILLU,212)ITLU,IEQQ,IMESSA,IMESSB
      IFFF = -2 
      GO TO 900 
C 
C 
C 
C 
C 
C 
C   3077A SURVEY
204   FORMAT(I4,I4,I4,I3,2XK3"B",1XK2"B",1XK6"B",1XI1,2XR1,1X2A2, 
     +1X2A2,1X3A2,R1,1XR1,1XR1,2XR1,2X3A2)
C   3077A VERIFY
205   FORMAT(18XI3,I3,2X2A2,1X2A2,1X3A2,R1,1XR1,1XR1,2XR1,2X3A2)
C 
C   3075A,3076A SURVEY
210   FORMAT(I4,I4,I4,I3,2XK3"B",1XK2"B",1XK6"B", 
     +1XI1,2XR1,1X2A2,1X2A2,1X3A2,R1,1XR1,1XR1,2XR1,2XA2,2XR1)
C   3075A, 3076A VERIFY 
211   FORMAT(18XI3,I3,2X2A2,1X2A2,1X3A2,R1,1XR1,1XR1,2XR1,2XA2,2XR1)
212   FORMAT(18XI3,I3,2X2A2,1X2A2,1X"ID NOT IN WRU LIST") 
213   FORMAT(I4,I4,I4,I3,2X@3,"B",1X@2,"B",1X@6,"B",1XI1,2XR1,2(1X2A2), 
     +1X"ID NOT IN WRU LIST") 
214   FORMAT(I4,I4,I4,I3,2X@3,"B",1X@2,"B",1X@6,"B",1XI1,2XR1,2(1X2A2), 
     +1XA2" APPEARS",I2" TIMES IN WRU") 
220   FORMAT(18XI3,I3,2X2A2,1X2A2,1XA2" APPEARS",I2" TIMES IN WRU") 
C 
900   IF(IERCD.EQ.6) IFFF = -3
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE ITSTA(ILLU,ITLU,IERCD,IB31,IB32,IB41,IB42,IB51,
     +IB52,IB53,IHRS,IMIN,IARAY),91711-1X032  REV 1926  790906
C     23.07.79
C     THIS SUBROUTINE GETS THE MULTIPOINT TERMINAL STATUS (6 BYTES) 
C     FROM ACTIVE 3075A, 3076A, 3077A TERMINALS.  THE CALLING PROGRAM 
C     SHOULD CHECK ITLU BEFORE CALLING THIS SUBROUTINE. 
C 
C     ILLU  = LIST LU 
C     ITLU  = LU UNDER TEST 
C     IERCD = COMPLETION CODE 
C           = -1 TRANSMISSION LOG IS ZERO 
C           = 0  TERMINAL STATUS AVAILABLE
C           = 1  WORD 1 IS NOT RIGHT OR TRANSMISSION LOG IS NOT 3 OR 5
C           = 2  BYTE 6 IS NOT CR (15B) 
C           = 3  BIT 7 IN BYTE 3 IS CLEAR, SHOULD BE SET
C           = 4  BIT 7 IN BYTE 4 IS CLEAR, SHOULD BE SET
C           = 5  BIT 7 IN BYTE 5 IS CLEAR, SHOULD BE SET
C           = 6  TRANSMISSION LOG IS 5, 264X TERMINAL 
C           = 7  TRANSMISSION LOG IS 4, UNKNOWN TERMINAL
C 
C     IB31  = OCTAL DIGIT INTERRUPT STATUS
C     IB32  = PRINTER BUSY FLAG.  1-BUSY.  0-NOT BUSY 
C     IB41  = TERMINAL RIGHT HAND MODULE OCTAL CODE 
C     IB42  = TERMINAL LEFT HAND MODULE OCTAL CODE
C     IB51  = TERMINAL MODEL NUMBER 
C     IB52  = DISPLAY FLAG.  1-ALPHA   0-NUMERIC
C     IB53  = KEYBOARD FLAG. 1-ALPHA   0-NUMERIC
C     IHRS  = 3077 HOURS
C     IMIN  = 3077 MINUTES
C 
C     CALLS:  SHFT  ASSEMBLY ROUTINE MOVES UPPER BYTE TO LOWER BYTE 
C                   FILLING ZEROS IN UPPER BYTE.
C 
      DIMENSION IREG(2),IBUFR(8),IBUFL(1),IMESS1(1),ICWORD(2),
     +IMESS3(1),IARAY(3)
      EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) 
      DATA IMESS1/15536B/ 
      DATA IBY3/0/
      DATA IBY4/0/
      DATA IBY5/0/
      DATA IBY6/0/
      DATA ICWORD/0,0/
      DATA IBBB/100000B/
      IBUFL = 0 
      IHRS = 0
      IMIN = 0
5     CALL SFILL(IBUFR,1,16,000B) 
      CALL EM(1,ITLU,ILLU,IARAY,IBBB) 
C   STATUS REQUEST FROM THE TERMINAL
      ICWORD(1) = IOR(100000B,ITLU) 
      CALL XLUEX(2,ICWORD,IMESS1,1) 
C   STRIP RECORD SEPARATORS, CR-LF CHARACTERS  WHEN POLLING TERMINAL
      REG = XLUEX(1,ICWORD,IBUFR,8) 
      IBUFL = IB
C   IF IB = 0 THERE IS NO RESPONSE FROM TERMINAL. 
      IF(IBUFL.EQ.0) GO TO 10 
      IF(IBUFL.EQ.1) GO TO 50 
      IF(IBUFL.EQ.3) GO TO 15 
      IF(IBUFL.EQ.4) GO TO 56 
      IF(IBUFL.EQ.5) GO TO 16 
      GO TO 50
C   TRANSMISSION LOG IS ZERO
10    IERCD=-1
100   CALL IMSG6(ILLU,ITLU,0,0,IARAY,0,11)
      GO TO 998 
C   3075A AND 3076A TERMINAL STATUS 
15    IERCD=0 
      IF(IBUFR(1).NE.15534B) GO TO 50 
C 
      IBY3 = IBUFR(2) 
      CALL SHFT(IBY3) 
      IBY4 = IAND(IBUFR(2),377B)
      IBY5 = IBUFR(3) 
      CALL SHFT(IBY5) 
      IBY6 = IAND(IBUFR(3),377B)
C 
20    IF(IBY6.NE.15B) GO TO 51
      IF(IBY3.LT.100B) GO TO 52 
      IF(IBY4.LT.100B) GO TO 53 
      IF(IBY5.LT.100B) GO TO 54 
C 
      IF(IBUFL.EQ.5) 22,21
C 
21    IB31=IAND(IBY3,7B)
      IB32=(IAND(IBY3,40B))/40B 
      GO TO 23
22    IB31 = 0
      IB32 = 0
23    IB41=IAND(IBY4,7B)
      IB42=(IAND(IBY4,70B))/10B 
      IB51=IAND(IBY5,7B)
      IB52=IAND(IBY5,20B) 
      IB52 = IB52/20B 
      IB53=IAND(IBY5,40B) 
      IB53 = IB53/40B 
      GO TO 998 
C   3077A TERMINAL STATUS OR 264X STATUS ?
16    IERCD=0 
      IF(IBUFR(1).NE.15534B) GO TO 50 
      I77A = IAND(IBUFR(4),177400B) 
      IF(I77A.NE.040000B) GO TO 55
C 
C   3077A STATUS
      IBY6 = IAND(IBUFR(5),377B)
      IBY5 = IBUFR(5) 
      CALL SHFT(IBY5) 
C 
      IBY4 = IAND(IBUFR(4),377B)
      IBY3 = IBUFR(4) 
      CALL SHFT(IBY3) 
C 
      IHRS = IBUFR(2) 
      IMIN = IBUFR(3) 
      GO TO 20
C   TRANSMISSION LOG LENGTH IS NOT RIGHT
50    IERCD=1 
      GO TO 998 
C   TRANSMISSION LOG TERMINATION BYTE IS NOT CR (15B) 
51    IERCD=2 
      GO TO 998 
C   BIT 7 IN BYTE 3 IS ZERO 
52    IERCD=3 
      GO TO 998 
C   BIT 7 IN BYTE 4 IS ZERO 
53    IERCD=4 
      GO TO 998 
C   BIT 7 IN BYTE 5 IS ZERO 
54    IERCD=5 
      GO TO 998 
C   264X TERMINAL ENABLE ROUTINE POLLING
55    IERCD = 6 
      CALL EM(1,ITLU,ILLU,IARAY,1401B)
      GO TO 999 
C   UNKNOWN TERMINAL, LEAVE IT WITH ROUTINE POLLING DISABLED
56    IERCD = 7 
      GO TO 999 
C 
C   DATACAP TERMINALS NEED THIS 
998   CALL EM(1,ITLU,ILLU,IARAY,101000B)
C 
C 
999   RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE LUCHK(ILLU,ITLU,IERCD,IARAY, 
     +ICCC),91711-1X032  REV 1926  790906 
C     10.26.79
C     THIS SUBROUTINE CHECKS FOR MULTIPOINT LU ASSIGNMENTS RETURNING
C     TO THE CALLING PROGRAM A COMPLETION CODE (IERCD)
C 
C     ILLU = LIST LU
C     ITLU = LU UNDER TEST
C     IERCD= COMPLETION CODE RETURNED TO CALLER 
C          = 1 : LU IS DOWN 
C          = 2 : LU IS NOT DEVICE TYPE 7
C          = 3 : EQT IS DOWN OR EQT STATE IS NOT CLEAR (IE17) 
C          = 4 : LU IS ASSIGNED TO A DORMANT MULTIPOINT LINE
C          = 5 : LU HAS NO EQT ASSIGNMENT 
C          = 6 : LU IS ASSIGNED TO AN INITIALIZED MULTIPOINT TERMINAL 
C          = 7 : LU IS ACTIVE LINE WITH NO TERMINALS ASSIGNED 
C          = 8 : LU IS NOT IN A LINKED LIST 
C          = 9 : LU IS ACTIVE LINE WITH TERMINALS ASSIGNED
C          = 0 : LU IS ASSIGNED TO A DORMANT MULTIPOINT TERMINAL
C          =-1 : LU HAS NONZERO SUBCHANNEL
C          =-2 : LU HAS NONZERO SUBCHANNEL AND THE LU OR EQT OR BOTH
C                ARE UNAVAILABLE
C 
C     ICCC = INTEGER PASSED TO IMSG1
C     ICCC = RETURNS INTEGER EQT NUMBER FOR UNAVAILABLE LU NUMBERS
C            (IERCD = 3,-2) 
C 
C     CALLS: X13     ASSEMBLY ROUTINE FOR STATUS REQUEST ON 
C                    SYSTEM LU. 
C     CALLS: SHFT    ASSEMBLY ROUTINE MOVES UPPER BYTE TO LOWER BYTE
C                    FILLING ZEROS IN UPPER BYTE. 
C     CALLS: SHF14   ASSEMBLY ROUTINE MOVES UPPER TWO BITS TO LOWERE
C                    TWO BITS OF THE WORD.  BITS 15-2 ARE ZEROS.
C     CALLS: SHF15   ASSEMBLY ROUTINE MOVES BIT15 TO BIT 0, 
C                    BITS 14-1 ARE ZEROS. 
C     CALLS: IMSG1   SHOW A MESSAGE ASSOCIATED WITH IERCD 
C 
C 
      DIMENSION IERCD(1),ITLU(1),IARAY(3),ICCC(1) 
C 
C 
C   THERE'S NO EQT ASSIGNMENT FOR ITLU = 0
C 
      IF(ITLU.EQ.0) GO TO 85
      IEQTA = IGET(1650B) 
      IDRT  = IGET(1652B) 
      ILUMAX= IGET(1653B) 
      IINTBA= IGET(1654B) 
      IINTLG= IGET(1655B) 
C   CHECK EQT ASSIGNMENT FOR THIS LU
      IVAL =IGET(IDRT+ITLU-1) 
      IEQTQ=IAND(IVAL,077B) 
      IF(IVAL.NE.0) GO TO 10
      GO TO 85
C   STATUS REQUEST ON ITLU.   X13 SETS BYPASS CONDITION.
10    CONTINUE
      CALL X13(ITLU,IEQT5,IEQT4,IEQST)
C   CHECK SELECT CODE ASSIGNMENT OF EQT 
      ISCOD=IAND(IEQT4,077B)
      IF(ISCOD.NE.O) GO TO 20 
      GO TO 81
C   CHECK DEVICE TYPE.  MUST BE TYPE 7
20    IDTYPE=IAND(IEQT5,037400B)
      CALL SHFT(IDTYPE) 
C   IDTYPE HAS LOWER 8 BITS CONTAINING INFORMATION
      IF(IDTYPE.EQ.07) GO TO 30 
      GO TO 82
30    IAV=IEQT5 
      CALL SHF14(IAV) 
      IFBIT=IEQST 
      CALL SHF15(IFBIT) 
C   CHECK FOR NONZERO SUBCHANNEL
      ISBCH = IAND(IEQST,17B) 
      IF(ISBCH.NE.0) GO TO 90 
C   CHECK IF LU IS DOWN AND AVAILABILITY OF EQT 
      IF((IAV.NE.01).AND.(IFBIT.EQ.0)) GO TO 40 
      IF(IFBIT.EQ.1) GO TO 81 
      GO TO 83
40    CONTINUE
C   GET EQT DATA
      IETBL = (IEQTQ-1)*15+IEQTA
      IE11  = IGET(IETBL+10)
      IEQX  = IGET(IETBL+12)
      IE16  = IGET(IEQX)
      IE17  = IGET(IEQX+1)
      LBIT  = IE16
      CALL SHF15(LBIT)
      IF(LBIT.EQ.1) GO TO 50
C   DETERMINE IF THIS IS A DORMANT TERMINAL OR LINE.  LBIT = 0
      IF(IAND((IOR(IE11,IE16).EQ.0),(ISCOD.GT.025B))) GO TO 60
C   LBIT=0 AND IE16 AND IE11 ARE NOT ZERO. LU IS AN INITIALIZED 
C   TERMINAL
C   NO CHECK ON STATE 
      IF((IE11.NE.0).AND.(IE16.LT.100000B).AND.(IE16.NE.0)) GO TO 86
C   IE16 AND IE11 ARE ZERO AND (SELECT CODE) < 26B.  DORMANT TERMINAL 
      IF(((IE16.OR.IE11).EQ.0).AND.(ISCOD.LT.026B)) GO TO 80
      GO TO 60
C 
C   LBIT=1  DETERMINE IF LINE LU IS DORMANT 
C 
C   ***PROGRAM PRMPT ADDITION TO SYSTEM****09.04.79**** 
50    CONTINUE
      IF((IE16.EQ.100000B).AND.(IE11.EQ.0)) GO TO 51
      IF((IE16.GT.100000B).AND.(IE11.EQ.0)) GO TO 52
C   THERE SHOULD BE A POINTER IN IE11 
      IF(IE11.EQ.0) GO TO 88
C   LINE IS INTIALIZED.  CHECK FOR CLEAR STATE
      ISTAT = IAND(IE17,377B) 
      IF(ISTAT.NE.0) GO TO 83 
C   STATE IS CLEAR.  CHECK FOR ASSIGNED TERMINALS 
      IF(IE11.EQ.IETBL) GO TO 87
      GO TO 89
C   LBIT=1  LINE IS DORMANT.  CHECK IF SELECT CODE < 26B
51    IF(ISCOD.GT.025B) GO TO 83
C   LINE LU IS DORMANT.  CHECK FOR CLEAR EQT STATE
      ISTAT = IAND(IE17,377B) 
      IF(ISTAT.NE.0) GO TO 83 
C   STATE IS CLEAR. 
      GO TO 84
C   LINE LU IS DORMANT.  CHECK FOR CLEAR EQT STATE. IE16=ID SEGMT 
52    CONTINUE
      GO TO 51
C 
C   TERMINAL LU IS  DORMANT.  CHECK FOR CLEAR EQT STATE 
C 
60    CONTINUE
      ISTAT = IAND(IE17,377B) 
      IF(ISTAT.NE.0) GO TO 83 
C   STATE IS CLEAR. 
      CONTINUE
C     ******* 
C     ******* 
C   DORMANT TERMINAL RETURN 
80    IERCD = 0 
      GO TO 9999
C   LU IS DOWN
81    IERCD = 1 
      GO TO 9999
C   LU IS NOT ASSIGNED TO A TYPE 7 DEVICE 
82    IERCD = 2 
      GO TO 9999
C   EQT IS DOWN OR EQT STATE IS NOT CLEAR 
C   RETURN THE EQT NUMBER IN PARAMETER ICCC, BUT BEFORE MAKING
C   THIS ASSIGNMENT, OUTPUT A MESSAGE.
83    IERCD = 3 
      GO TO 9999
C   DORMANT LINE RETURN 
84    IERCD = 4 
      GO TO 9999
C   LU NOT ASSIGNED (NO EQT)
85    IERCD = 5 
      GO TO 9999
C   INITIALIZED TERMINAL RETURN 
86    IERCD = 6 
      GO TO 9999
C   INTIALIZED LINE WITH NO TERMINALS ASSIGNED
87    IERCD = 7 
      GO TO 9999
C   TYPE 7 EQT IS NOT IN A LINKED LIST (SERIOUS ERROR)
88    IERCD = 8 
      GO TO 9999
C   INITIALIZED LINE WITH TERMINALS ASSIGNED
89    IERCD = 9 
      GO TO 9999
C   NONZERO SUBCHANNEL ASSIGNMENT 
90    IERCD = -1
C 
C  CHECK IF LU IS DOWN OR EQT IS UNAVAILABLE. 
C 
      IF((IAV.NE.01).AND.(IFBIT.EQ.0)) GO TO 9999 
C 
C  THIS LU HAS A SUBCHANNEL ASSIGNMENT AND IS UNAVAILABLE.
C 
      IERCD = -2
C 
C 
9999  CONTINUE
      CALL IMSG1(ILLU,ITLU,IARAY,IERCD,ICCC,IEQTQ)
      ICCC = IEQTQ
C 
C     WRITE(ILLU,710)ITLU,IERCD 
710   FORMAT(2X"LUCHK ITLU:",I2X"IERCD:",I2)
      RETURN
      END 
C     END$
CFTN4,Q,C 
      SUBROUTINE LINK(INLU,ITLU,LLINK,
     +ITMCT),91711-1X032  REV 1926  790906
C     17.10.79
C     THIS SUBROUTINE GETS A LIST OF LU NUMBERS OF TERMINALS ON THE 
C     LINE BY SEARCHING THE EQT LINKED LIST.
C     ITLU PASSED IS CHECKED FOR LINE MEMBERSHIP, ITMCT INDICATES IF
C     THE TRML LU WAS FOUND.
C 
C     NOTE: NO CHECK IS MADE HERE FOR DRIVER TYPE 7 OR IF INLU IS 
C     A LINE LU.  USE LUCHK BEFORE CALLING LINK.
C 
C     ILLU = LIST LU
C     INLU = LINE LU
C     ITLU = TERMINAL LU
C     LLINK = LLINK(1) IS LINE LU NUMBER, LLINK(2) IS IBUFL, THEN 
C             TERMINAL LU NUMBERS.
C             THE NUMBERS ARE SYSTEM LU NUMBERS IN INTEGER FORMAT 
C     IBUFL = NUMBER OF TERMINAL LU IN LLINK, ONE WORD PER TERMINAL, PLUS 
C             ONE (FOR THE LINE LU).
C           = 0  LINE NOT PRESENT IN INLU EQT 
C           = 1  LINE IS INITIALIZED WITH NO ASSIGNED TERMINALS.
C           > 1  LINE IS INITIALIZED WITH (IBUFL-1) ASSIGNED TERMINALS. 
C 
C     ITMCT = 0  TRML LU WAS NOT FOUND ASSIGNED TO LINKED LIST
C           = -1 TRML LU WAS FOUND ON THIS LINKED LIST
C 
C 
C     CALLS:  ILINA  GET THE LINE NUMBER, LIST POINTER
C     CALLS:  LDARG  ASSEMBLY ROUTINE TO CALL TRMLU 
C 
C     SOURCE TERM :  LLINK  LIST OF TERMINAL LU ON ASSIGNED LINKED LIST 
C                    ITMCT  VERIFY ITLU COMPLETION CODE 
C 
      DIMENSION LLINK(28) 
      KK = 2
      ITMCT = 0 
      DO 1 J=1,28 
1     LLINK(J) = 0
      LLINK(2) = -1 
C 
C   GET THE LINE WORD 11 AND WORD 16
      CALL ILINA(INLU,ILNN,IE16,IE11) 
C 
C   DON'T GO ON IF LIST LINK POINTER IS ZERO. THERE IS NO LINE
      IF(IE11.EQ.0) 901,3 
C   DON'T GO ON IF THE LINE IS DORMANT
3     IF(IE16.EQ.100000B) 901,4 
C 
C   PUT THE LINE LU NUMBER INTO THE FIRST WORD OF LLINK.
C   STARTING WITH THE LINE EQT, IT11 POINTS TO WORD ONE OF THE
C   NEXT EQT IN THE LIST.  GET THAT LU NUMBER, THEN USE IT TO GET THE 
C   EQT WORD 11 AND 16 DATA CONTAINING LIST POINTER AND LINE NUMBER.
C   CHECK ITLU AGAINST EACH TERMINAL LU NUMBER RETURNED BY LDARG
C   FOR IDENTITY, SET ITMCT = -1 IF THEY ARE THE SAME.
C   PUT ALL TERMINAL LU FOUND ON THIS LINKED LIST INTO LLINK. 
C   ENTER THE LU NUMBER INTO THE NEXT WORD OF LLINK AND INCREMENT KK. 
C   USING THE TERMINAL EQT WORD 11, CHECK IF IT POINTS
C   TO THE LINE EQT.  IF IT DOES, THE LINE  SEARCH IS COMPLETE. 
C   EVENTUALLY THE UPDATED LIST POINTER WILL POINT TO THE LINE LU, THEN 
C   A NORMAL EXIT IS TAKEN. 
C 
4     LLINK(1) = INLU 
      IT11 = IE11 
      IDRT = IGET(1652B)
C 
C   DOES THIS LINE LU POINT TO A TERMINAL ? 
C 
5     IF(IE11.NE.(IE11-10)) 51,900
C 
C   YES, SO ADJUST IT4 TO POINT TO WORD 4 AND GET THE SYSTEM LU 
C 
51    IT4 = IT11+3
C 
C   FIRST PUT IT4 INTO THE B-REGISTER 
C 
      CALL LDARG(IT4,ITT) 
C 
C   GET SYSTEM LU OF THIS EQT.  IT4 AND A-REGISTER ARE INTEGER FORMAT 
C   ITT AND B-REGISTER ARE ASCII FORMAT.
C   CHECK ITLU AGAINST IT4 FOR IDENTITY 
C 
      IF(IT4.EQ.ITLU) ITMCT = -1
C 
C   MAKE SURE WE'RE NOT DEALING WITH THE LINE LU AGAIN
C 
52    IF(IT4.NE.INLU) 54,900
C 
C   PUT IT4 INTO LLINK
C 
54    KK = KK+1 
      LLINK(KK) = IT4 
C 
C   SEARCH NO MORE IF THE LINK POINTER IS THE LINE EQT. 
C 
55    IF(IT11.NE.IE11) 51,900 
C 
C   KK = THE NUMBER OF TERMINALS ON THIS LINE 
C   ITMCT = -1 ITLU WAS FOUND AMONG THIS LINKED LIST
C         = 0  ITLU WAS NOT FOUND AMONG THIS LINKED LIST
C 
900   LLINK(2) = KK 
901   RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE IMSG1(ILLU,ITLU,IARAY,INUM,
     +IAAA,IEQTQ),91711-1X032  REV 1926  790906 
C     31.08.79
C 
C 
C     ILLU  =  LIST LU
C     ITLU   =  LU NUMBER TO SHOW IN A MESSAGE
C     INUM  =  MESSAGE SELECTION
C     IAAA  =  0-9, -1, SKIP THE SPECIFIED NUMBERED MESSAGE 
C           =  10  SHOW NO MESSAGE
C           =  11  SHOW ANY MESSAGE 
C 
C 
C 
      DIMENSION IARAY(3)
      DATA IBBB/100000B/
      IF(IAAA.EQ.11) 7,5
5     IF(IAAA-10) 6,900 
6     IF(INUM.EQ.IAAA) GO TO 900
7     IF(INUM.EQ.0) GO TO 20
      IF(INUM.EQ.1) GO TO 21
      IF(INUM.EQ.2) GO TO 22
      IF(INUM.EQ.3) GO TO 23
      IF(INUM.EQ.4) GO TO 24
      IF(INUM.EQ.5) GO TO 25
      IF(INUM.EQ.6) GO TO 26
      IF(INUM.EQ.7) GO TO 27
      IF(INUM.EQ.8) GO TO 28
      IF(INUM.EQ.9) GO TO 29
      IF(INUM.EQ.-1)GO TO 40
      IF(INUM.EQ.-2)GO TO 40
      GO TO 900 
C 
C  TXTD1 - LU MM IS ASSIGNED TO A DORMANT MULTIPOINT TERMINAL 
20    WRITE(ILLU,30)IARAY,ITLU
30    FORMAT(2X3A2"- LU ",I2X"ASSIGNED TO A DORMANT MULTIPOINT",
     +" TERMINAL")
      GO TO 900 
C 
C  TXTD1 - LU MM IS DOWN
21    WRITE(ILLU,31)IARAY,ITLU
31    FORMAT(2X3A2"- LU ",I2X"IS DOWN") 
      GO TO 900 
C 
C  TXTD1 - LU MM IS NOT ASSIGNED TO A DEVICE
C 
22    WRITE(ILLU,32)IARAY,ITLU
32    FORMAT(2X3A2"- LU ",I2X"IS NOT ASSIGNED TO A DEVICE") 
      GO TO 900 
C 
C  TXTD1 - EQT ZZ IS DOWN 
23    WRITE(ILLU,33)IARAY,IEQTQ 
33    FORMAT(2X3A2"- EQT ",I2X"IS DOWN")
      GO TO 900 
C 
C  TXTD1 - LU MM IS ASSIGNED TO A DORMANT MULTIPOINT LINE 
24    WRITE(ILLU,34)IARAY,ITLU
34    FORMAT(2X3A2"- LU ",I2X"IS ASSIGNED TO A DORMANT MULTIPOINT", 
     +" LINE")
      GO TO 900 
C 
C  TXTD1 - LU MM NOT ASSIGNED, NOT TESTED 
25    WRITE(ILLU,35)IARAY,ITLU
35    FORMAT(2X3A2"- LU ",I2X"NOT ASSIGNED, NOT TESTED")
      GO TO 900 
C 
C  TXTD1 - LU MM IS AN INITIALIZED MULTIPOINT TERMINAL
26    WRITE(ILLU,36)IARAY,ITLU
36    FORMAT(2X3A2"- LU ",I2X"IS AN INITIALIZED MULTIPOINT TERMINAL") 
      GO TO 900 
C 
C  TXTD1 - LINE LU MM IS INITIALIZED, NO TERMINALS ASSIGNED 
27    WRITE(ILLU,37)IARAY,ITLU
37    FORMAT(2X3A2"- LINE LU ",I2X"IS INITIALIZED, NO TERMINALS", 
     +" ASSIGNED")
      GO TO 900 
C 
C  TXTD1 - LU MM IS NOT IN LINKED LIST
28    WRITE(ILLU,38)IARAY,ITLU
38    FORMAT(2X3A2"- LU ",I2X"IS NOT IN A LINKED LIST") 
      GO TO 900 
C 
C  TXTD1 - LINE LU MM IS INITIALIZED, TERMINALS ARE ASSIGNED
29    WRITE(ILLU,39)IARAY,ITLU
39    FORMAT(2X3A2"- LINE LU ",I2X"IS INITIALIZED, TERMINALS ARE",
     +" ASSIGNED")
      GO TO 900 
C 
C   TXTD1 - LU MM HAS NONZERO SUBCHANNEL ASSIGNMENT 
40    WRITE(ILLU,50)IARAY,ITLU
50    FORMAT(2X3A2"- LU",XI2X"HAS NONZERO SUBCHANNEL ASSIGNMENT") 
      GO TO 900 
C 
C 
900   CONTINUE
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE UPMPT(ILU,INLU,ILLU,ITLU,IGGG,IXLU,
     +IARAY),91711-1X032  REV 1926  790906
C     26.09.79
C     THIS SUBROUTINE INITIALIZES A MULTIPOINT TERMINAL.
C     TERMINALS THAT ARE INITIALIZED WILL NOT BE RE-INITIALIZED 
C     AND A WARNING MESSAGE IS OUTPUT.
C 
C     ILU  = CONSOLE LU 
C     INLU = LINE LU
C     ILLU = LIST LU
C     ITLU = TERMINAL LU
C     IGGG = -1 DIAGNOSTIC.  CALLED BY TXTD2. 
C          > 0  VERIFY. IGGG IS ICW FOR INITIALIZING A TERMINAL.
C 
C 
C     CALLS:  LUCHK  DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, 
C                    RETURN A COMPLETION CODE TO THE CALLER.
C     CALLS:  ILINE  SHOW MULTIPOINT LINE ASSIGNMENT TABLE. 
C     CALLS:  LUVFY  VERIFY TERMINAL LU = ITLU ON LINE LU = INLU
C                    WHICH HAS A SPECIFIED ID FOUND IN THE EQT
C     CALLS:  IXGID  GET THE GROUP CHARACTER OR DEVICE CHARACTER
C     CALLS:  ILINA  GET THE LINE NUMBER, ID FOR AN LU FROM THE EQT 
C     CALLS:  IGRID  GET THE GROUP RESPONSE FOR THE SPECIFIED GROUP 
C                    CHARACTER ON THE SPECIFIED LINE LU 
C 
C 
C 
      DIMENSION IREG(2),IBUFR(128),ICWORD(2),IOFLN(30),IGRUP(30), 
     +IARAY(3),IMESS1(1)
      EQUIVALENCE (IREG(1),REG,IA),(IREG(2),IB) 
      IXLU = 0
      DATA ICWORD/0,2000B/
      DATA IMESS1/15505B/ 
      IF(IGGG.EQ.-1) 5,71 
5     CALL IMSG8(ILLU,IARAY,1,11) 
      CALL SFILL(IGRUP,1,60,000B) 
      CALL SFILL(IOFLN,1,60,000B) 
C 
C   IF INLU IS ZERO, GET A LINE LU
      IF(INLU.GT.0) GO TO 30
C 
C     ENTER THE LINE CONTROL INFORMATION.  IF NO MORE LINES, ENTER
C     0 TO STOP.
C 
15    CALL IMSG7(ILU,INLU,IARAY,1,11) 
      IF(INLU.EQ.0) GO TO 900 
C 
C     CHECK LU FOR MULTIPOINT LINE ASSIGNMENT 
C     SHOW ANY MESSAGE
C 
30    ICCC = 9
      CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC)
      IF(IERCD.EQ.7) GO TO 25 
      IF(IERCD.EQ.9) GO TO 25 
      GO TO 15
C 
C   SHOW LINE NUMBER AND TERMINAL LU NUMBER(S) ASSIGNED 
C   TO THIS LINE LU.
C 
25    CONTINUE
      CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) 
      I4LIN = LINE*10000B 
C 
C   GET GROUP ID
C 
28    INUM = 0
      CALL IXGID(ILU,IGID,KGID,IARAY,INUM)
      IF(IGID.EQ.20040B) GO TO 15 
C 
C   GET ALL RESPONSES TO GROUP KGID ON LINE LU = INLU, PU THE 
C   ID COLLECTED IN BUFFER IGRUP
C 
      CALL IGRID(INLU,KGID,IGRUP) 
C 
C   SHOW THE RESPONDING TERMINALS 
C 
      IF(IGRUP(1)) 27,26
26    INAT = IGRUP(1) - 1 
      CALL IMSG2(ILLU,INAT,KGID,2,IARAY,11) 
      DO 27 K = 2,IGRUP(1)
      CALL IMSG2(ILLU,0,IGRUP(K),3,IARAY,11)
27    CONTINUE
C 
C   ENTER TERMINAL LU.  IF NO MORE TERMINALS ON THIS LINE, ENTER
C   0 TO STOP 
C 
16    CALL IMSG7(ILU,ITLU,IARAY,2,11) 
      IF(ITLU.EQ.0) GO TO 15
C 
C   CHECK LU FOR MULTIPOINT LINE ASSIGNMENT 
C   SHOW NO MESSAGE FOR IERCD = 0 
C 
36    ICCC = 0
      CALL LUCHK(ILLU,ITLU,IERCD,IARAY,ICCC)
      IF(IERCD.EQ.0) GO TO 70 
      IF(IERCD.EQ.-1) GO TO 70
      GO TO 16
C 
C   GET THE DEVICE ID 
C 
70    INUM = 1
      CALL IXGID(ILU,IDID,IXXX,IARAY,INUM)
      IF(IDID.EQ.020040B) GO TO 16
C 
C   INITIALIZE THE TERMINAL 
C 
      ICWG = IAND(IGID,37400B)/4B 
      ICWD = IAND(IDID,077B)
      ICW=IOR((IOR(I4LIN,ICWG)),(ICWD)) 
      GO TO 72
C 
C   IF THIS WAS CALLED WITH ICW DEFINED, ENTER HERE 
C 
71    ICW = IGGG
72    ICWORD(1) = IOR(100000B,ITLU) 
C 
C   SINCE DATACAP TERMINALS CAN'T HAVE ROUTINE POLLING, SET IT OFF
C 
      CALL EM(1,ITLU,ILLU,IARAY,101000B)
      CALL XLUEX(3,ICWORD,ICW)
C 
C   TXTD1 - TRML LU MMAB INITIALIZED, ASSIGNED LINE NO. L 
C 
      CALL ILINA(ITLU,LINE,ITID,IE11) 
      KGID = IOR(IAND(ITID,057400B),40B)
      ID = IOR(KGID,175B) 
      CALL IMSG4(ILLU,ITLU,LINE,ITID,8,IARAY,11)
C 
C   VERIFY TERMINAL ID ON THIS LINE AND GROUP 
C 
74    CALL LUVFY(INLU,ILLU,ITLU,IGRUP,IOFLN,ID,KGID,0,IXLU,IARAY) 
C 
900   CONTINUE
C 
C     END MULTIPOINT TERMINAL INITIALIZATION
C 
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE IXGID(ILU,IGID,KGID,IARAY, 
     +INUM),91711-1X032  REV 1926  790906 
C     79.10.26
C 
C   THIS SUBROUTINE GETS GROUP AND DEVICE CHARACTERS FROM 
C   THE INTERACTIVE LU = ILU.  IGID IS RETURNED WITH A
C   SPACE-SPACE ASCII CODE IF AN OUT OF BOUNDS ENTRY WAS
C   MADE, OR THE ASCII CHARACTER IN THE UPPER BYTE FOR GROUP
C   CHARACTER, ASCII CHARACTER IN THE LOWER BYTE FOR THE
C   DEVICE CHARACTER.  KGID IS RETURNED FOR WITH THE GROUP
C   CHARACTER IN THE UPPER BYTE AND A SPACE CARACTER IN THE 
C   LOWER BYTE. 
C 
      DIMENSION IARAY(3)
C 
      IF(INUM.EQ.0) GO TO 100 
      IF(INUM.EQ.1) GO TO 200 
C 
C 
C   GROUP ID CHARACTER
C   PARAMETER KGID RETURNS THE GROUP CHARACTER IN THE UPPER BYTE, 
C   SPACE CHARACTER IN THE LOWER BYTE.  IGID RETURNS WHATEVER THE 
C   OPERATOR ENTRY IN THE UPPER BYTE. 
C 
100   WRITE(ILU,110)IARAY 
110   FORMAT(/2X3A2"- ENTER GROUP ID CHARACTER             :_") 
      READ(ILU,111)IGID 
111   FORMAT(A1)
      IF(IGID.EQ.020040B) GO TO 900 
      IF(IGID.LT.040000B) GO TO 100 
      IF(IGID.GT.055040B) GO TO 100 
C 
      KGID = IOR(IAND(IGID,057400B),40B)
      GO TO 900 
C 
C 
C   DEVICE ID CHARACTER 
C   PARAMETER KGID IS NOT USED
C   PARAMETER IGID IS USED TO PASS THE DEVICE CHARACTER 
C 
200   WRITE(ILU,210)IARAY 
210   FORMAT(2X3A2"- ENTER DEVICE ID CHARACTER            :_")
      READ(ILU,211)IDID 
211   FORMAT(R1)
      IF(IDID.LT.000100B) GO TO 230 
      IF(IDID.EQ.000040B) GO TO 230 
      IF(IDID.GT.000132B) GO TO 230 
C 
220   IGID = IDID 
      GO TO 900 
C 
230   IGID = 020040B
900   CONTINUE
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE DNMPT(ILU,ILLU,IGGG, 
     +IARAY),91711-1X032  REV 1926  790906
C     20.06.79
C     THIS SUBROUTINE REMOVES A MULTIPOINT TERMINAL.
C     TERMINALS ARE REMOVED WHEN PRESENTLY INITIALIZED.  IF A TERMINAL IS 
C     DORMANT A WARNING MESSAGE IS OUTPUT AND NO ATTEMPT TO REMOVE
C     THE TERMINAL IS MADE. 
C 
C     ILU  = CONSOLE LU 
C     ILLU = LIST LU
C     IGGG = -1 DIAGNOSTIC
C          >  0 VERIFY, ICWORD FOR TERMINAL REMOVAL 
C     ILLU = LIST LU
C 
C 
C     CALLS:  LUCHK  DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, 
C                    RETURN A COMPLETION CODE TO THE CALLER.
C     CALLS:  ILINE  SHOW MULTIPOINT LINE ASSIGNMENT TABLE. 
C 
C 
C 
      DIMENSION IREG(2),ICWORD(2),IARAY(3)
      EQUIVALENCE (IREG(1),REG,IA),(IREG(2),IB) 
      DATA ICWORD/0,2100B/
      DATA ICCC/6/
      IF(IGGG.EQ.-1) 5,61 
5     CALL IMSG8(ILLU,IARAY,0,11) 
C 
C   ENTER THE LINE CONTROL INFORMATION.  IF NO MORE LINES, ENTER
C   0 TO STOP.
15    CALL IMSG7(ILU,ITLU,IARAY,3,11) 
      IF(ITLU.EQ.0) GO TO 9999
      ICWORD(1) = IOR(100000B,ITLU) 
C 
C   CHECK LU FOR MULTIPOINT LINE ASSIGNMENT 
C   SHOW NO MESSAGE FOR IERCD = 6 
      CALL LUCHK(ILLU,ITLU,IERCD,IARAY,ICCC)
      IF(IERCD.EQ.6) GO TO 60 
      GO TO 15
C 
61    ITLU = IGGG 
      ICWORD(1) = IOR(100000B,ITLU) 
60    CALL ILINA(ITLU,LINE,IE16,IE11) 
      CALL IMSG3(ILLU,LINE,ITLU,IE16,IARAY,1,11)
C  REMOVE THE TERMINAL
      ICW = 0 
      REG = XLUEX(3,ICWORD,ICW) 
C 
62    CALL IMSG4(ILLU,ITLU,LINE,IE16,6,IARAY,11)
C 
C   END MULTIPOINT TERMINAL REMOVAL 
9999  CONTINUE
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE IMSG2(ILLU,IPAR1,IPAR2,INUM,IARAY, 
     +IAAA),91711-1X032  REV 1926  790906 
C     24.07.79
C     MESSAGES ASSOCIATED WITH IWRU 
C 
C     ILLU  =  LIST LU
C     IPAR1 =  INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE 
C     IPAR2 =  ASCII (A2 FORMAT) PARAMETER TO SHOW IN A MESSAGE 
C     INUM  =  MESSAGE SELECTION
C     IAAA  =  0-9 SKIP THE SPECIFIED NUMBERED MESSAGE
C           =  10  SHOW NO MESSAGE
C           =  11  SHOW ANY MESSAGE 
C 
C 
C 
      DIMENSION IMESS0(11),IMESS1(11),IMESS2(14),IMESS3(1),IMESS4(4), 
     +IMESS5(13),IMESS6(13),IMESS7(14),ICWORD(2),IREG(2),IMSG(40),
     +IMESS8(13),IARAY(3),IPB1(1) 
      EQUIVALENCE (IREG(1),REG,IA), (IREG(2),IB)
      DATA ICWORD/0,0400B/
      DATA IBBB/100000B/
      DATA IMESS0/2H- ,2HVE,2HRI,2HFY,2H G,2HID,2H  ,2H :,
     +2H P,2HAS,2HS / 
      DATA IMESS1/2H- ,2HVE,2HRI,2HFY,2H G,2HID,2H  ,2H :,
     +2H F,2HAI,2HL / 
      DATA IMESS2/2H- ,2H  ,2H R,2HES,2HPO, 
     +2HNS,2HE(,2HS),2H F,2HRO,2HM ,2HGR,2HOU,2HP / 
      DATA IMESS3/0/
      DATA IMESS4/2HOF,2HF ,2HLI,2HNE/
      DATA IMESS5/2HID,2H A,2HPP,2HEA,2HRS,2H  ,2H  ,2HTI,2HME, 
     +2HS ,2HIN,2H E,2HQT/
      DATA IMESS6/2HGR,2HOU,2HP ,0,2H F,2HAI,2HLS,2H E,2HQT,2H V,2HER,
     +2HIF,2HY /
      DATA IMESS7/2HLU,2H  ,0,2H I,2HD:,0,2H N,2HOT,2H I,2HN ,2HWR, 
     +2HU ,2HLI,2HST/ 
      DATA IMESS8/2HEQ,2HT ,2HFA,2HIL,2HS ,2HGR,2HOU,2HP ,0,2H V, 
     +2HER,2HIF,2HY / 
      CALL SFILL(IMSG,1,80,0040B) 
      IPB1  = KCVT(IPAR1) 
      CALL SGET(IPB1,1,JPB10) 
      CALL SGET(IPB1,2,JPB11) 
      IF(IAAA.EQ.11) 7,5
5     IF(IAAA-10) 6,900 
6     IF(INUM.EQ.IAAA) GO TO 900
7     IF(INUM.EQ.0) GO TO 20
      IF(INUM.EQ.1) GO TO 21
      IF(INUM.EQ.2) GO TO 22
      IF(INUM.EQ.3) GO TO 23
      IF(INUM.EQ.4) GO TO 24
      IF(INUM.EQ.5) GO TO 25
      IF(INUM.EQ.6) GO TO 26
      IF(INUM.EQ.7) GO TO 27
      IF(INUM.EQ.8) GO TO 28
      IF(INUM.EQ.9) GO TO 29
C 
C  TXTD1 - VERIFY GID a : PASS
20    DO 30 J=1,11
30    IMSG(J+4) = IMESS0(J) 
      CALL SHFT(IPAR2)
      IMSG(11) = IOR(020000B,IPAR2) 
      IBUFL = 15
      GO TO 40
C 
C  TXTD1 - VERIFY GID a : FAIL
21    DO 31 J = 1,11
31    IMSG(J+4) = IMESS1(J) 
      CALL SHFT(IPAR2)
      IMSG(11) = IOR(020000B,IPAR2) 
      IBUFL = 16
      GO TO 40
C 
C  TXTD1 - xx RESPONSE(S) FROM GROUP a
22    DO 32 J = 1,14
32    IMSG(J+4) = IMESS2(J) 
      CALL SPUT(IMSG,11,JPB10)
      CALL SPUT(IMSG,12,JPB11)
      IMSG(19) = IPAR2
      IBUFL = 20
      GO TO 40
C 
C  ab 
23    IMSG(19) = IPAR2
      IBUFL = 20
      GO TO 43
C 
C  ab     OFF LINE
24    DO 34 J = 1,4 
34    IMSG(J+18) = IMESS4(J)
      IMSG(14) = IPAR2
      IBUFL = 22
      GO TO 43
C 
25    GO TO 900 
C 
C  GROUP a FAILS EQT VERIFY 
26    DO 36 J = 1,13
36    IMSG(J+20) = IMESS6(J)
      IMSG(24) = IPAR2
      IBUFL = 34
      GO TO 43
C 
C  LU mm ID:ab NOT IN WRU LIST
27    DO 37  J = 1,14 
37    IMSG(J+20) = IMESS7(J)
      IMSG(23) = ITLU 
      IMSG(26) = IPAR2
      IBUFL = 34
      GO TO 43
C 
C  EQT FAILS GROUP a VERIFY 
28    DO 38 J =0 1,13 
38    IMSG(J+20) = IMESS8(J)
      IMSG(29) = IPAR2
      IBUFL = 33
      GO TO 43
C 
C  ab     OFF LINE
29    DO 39 J = 1,4 
39    IMSG(J+25) = IMESS4(J)
      IMSG(21) = IPAR2
      IBUFL = 29
      GO TO 43
C 
40    DO 41 J = 1,3 
41    IMSG(J+1) = IARAY(J)
43    ICWORD(1) = IOR(100000B,ILLU) 
      CALL REIO(2,ICWORD,IMSG,IBUFL)
C 
900   CONTINUE
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE IMSG3(ILLU,IPAR1,IPAR2,IPAR3,IARAY,INUM, 
     +IAAA),91711-1X032  REV 1926  790906 
C     06.11.79
C     THIS SUBROUTINE OUTPUTS A MESSAGE ASSOCIATED WITH CFTML,
C     DNMPT, UPMPT, VMPLN, VMPTL
C 
C     ILLU  =  LIST LU
C     IPAR1 =  INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE 
C     IPAR2 =  INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE 
C     IPAR3 =  ASCII (A2 FORMAT) PARAMETER TO SHOW IN A MESSAGE 
C     INUM  =  MESSAGE SELECTION
C     IAAA  =  0-9 SKIP THE SPECIFIED NUMBERED MESSAGE
C           =  10  SHOW NO MESSAGE
C           =  11  SHOW ANY MESSAGE 
C 
C 
C 
      DIMENSION IMS0(1), IMS1(11), IMS2(2), 
     +IMS4(11),IMS5(11),ICWORD(2), IREG(2), IMSG(12),IARAY(3),
     +IMS6(2),IEQ(1)
      EQUIVALENCE (IREG(1),REG,IA), (IREG(2),IB)
      DATA IMS0/0/
      DATA IMS1/2H*L,2HN ,0,2H T,2HL ,0,0,2H  ,2HOF,2HFL,2HN*/
      DATA IMS2/2HDN,2H, /
      DATA IMS4/2H*L,2HN ,0,2H T,2HL ,0,0,2H V,2HER,2HIF,2HY*/
      DATA IMS5/2H*L,2HN ,0,2H T,2HL ,0,0,2H  ,2H O,2HNL,2HN*/
      DATA IMS6/2HUP,2H, /
      DATA ICWORD/0,0400B/
      DATA IBBB/100000B/
C 
C  INITIALIZE BUFFER IMSG 
C 
      CALL SFILL(IMSG,1,24,040B)
C 
      IF(IAAA.EQ.11) 7,5
C 
5     IF(IAAA-10) 6,900 
C 
6     IF(INUM.EQ.IAAA) GO TO 900
C 
7     IF(INUM.EQ.0) GO TO 20
      IF(INUM.EQ.1) GO TO 21
      IF(INUM.EQ.2) GO TO 22
      IF(INUM.EQ.3) GO TO 900 
      IF(INUM.EQ.4) GO TO 24
      IF(INUM.EQ.5) GO TO 25
      IF(INUM.EQ.6) GO TO 26
      IF(INUM.EQ.7) GO TO 27
      IF(INUM.EQ.8) GO TO 28
      IF(INUM.EQ.9) GO TO 29
C 
C   TXTD1 * LN E TL ABNN NOT VERIFIED 
C 
20    WRITE(ILLU,30)IPAR1,IPAR2,IPAR3 
30    FORMAT(2X"TXTD1 * LINE NO.",I2X"TL ",I2,A2X"NOT VERIFIED")
      GO TO 900 
C 
C  *LN e TL mm   OFFLN* 
21    DO 31 J = 1,11
31    IMSG(J) = IMS1(J) 
      IBUFL = 11
      GO TO 40
C 
C  DOWN THE EQT 
C  FILL IN THE "DN, " THEN GO TO 50 TO PUT IN THE EQT NUMBER
C  IPAR1 IS THE INTEGER EQT NUMBER, IPAR2 IS THE COMPLETION CODE
C 
22    DO 32 J = 1,2 
32    IMSG(J) = IMS2(J) 
      GO TO 50
C 
C 
C  *LN e TL mm  VERIFY* 
24    DO 34 J = 1,11
34    IMSG(J) = IMS4(J) 
      IBUFL = 11
      GO TO 40
C 
C  *LN e TL mm    ONLN* 
25    DO 35 J = 1,11
35    IMSG(J) = IMS5(J) 
      IBUFL = 11
      GO TO 40
C 
C   TXTD1 * ab APPEARS OFF LINE nnn TIMES 
26    WRITE(ILLU,36)IARAY,IPAR3,IPAR1 
36    FORMAT(/2X3A2"* ",A2" APPEARS OFF LINE",I3X"TIMES") 
      GO TO 900 
C 
C   TXTD1 * ab NOT VERIFIED 
27    WRITE(ILLU,37)IARAY,IPAR3 
37    FORMAT(2X3A2"* ",A2X" NOT VERIFIED")
      GO TO 900 
C 
C   TXTD1 * ab APPEARS nnn TIMES IN EQT 
28    WRITE(ILLU,38)IARAY,IPAR3,IPAR1 
38    FORMAT(2X3A2"* ",A2X" APPEARS",I3X"TIMES IN EQT") 
      GO TO 900 
C 
C   UP THE EQT
C   IPAR1 IS THE INTEGER EQT NUMBER, IPAR2 IS THE COMPLETION CODE.
C 
29    DO 39 J = 1,2 
39    IMSG(J) = IMS6(J) 
C 
C 
C   ENTER HERE FROM DOWN AN EQT 
C 
50    IEQ = KCVT(IPAR1) 
      CALL SGET(IEQ,1,JEQ1) 
      CALL SGET(IEQ,2,JEQ2) 
C 
      CALL SPUT(IMSG,4,JEQ1)
      CALL SPUT(IMSG,5,JEQ2)
C 
      REG = MESSS(IMSG,12)
C 
C  FOR ANY MESSAGE RETURNED FROM THE SYSTEM, SET IPAR2 = IA TO
C  LET THE CALLER KNOW THE ATTEMPT TO UP OR DOWN THE EQT HAS FAILED.
C 
      IPAR2 = IA
      GO TO 900 
C 
40    CALL EM(1,IPAR2,ILLU,IARAY,IBBB)
      CALL SPUT(IMSG,5,KCVT(IPAR1)) 
      IMSG(6) = KCVT(IPAR2) 
      IMSG(7) = IPAR3 
      ICWORD(1) = IOR(100000B,IPAR2)
      CALL XLUEX(2,ICWORD,IMSG,IBUFL) 
      CALL EM(1,IPAR2,ILLU,IARAY,1401B) 
C 
900   CONTINUE
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE IMSG4(ILLU,IPAR1,IPAR2,IPAR3,INUM,IARAY, 
     +IAAA),91711-1X032  REV 1926  790906 
C     26.07.79
C     MESSAGES ASSOCIATED WITH IWRU 
C 
C     ILLU  =  LIST LU
C     IPAR1 =  INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE 
C     IPAR2 =  INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE 
C     IPAR3 =  ASCII (A2 FORMAT) PARAMETER TO SHOW IN A MESSAGE 
C     INUM  =  MESSAGE SELECTION
C     IAAA  =  0-9 SKIP THE SPECIFIED NUMBERED MESSAGE
C           =  10  SHOW NO MESSAGE
C           =  11  SHOW ANY MESSAGE 
C 
C 
C 
      DIMENSION IMESS0(7),IMESS1(14),IMESS2(14),IMESS3(13),IMESS4(16),
     +IMESS5(19),IMESS6(17),IMESS7(14),ICWORD(2),IREG(2),IMSG(28),
     +IMESS8(23),IMESS9(19),IARAY(3),IPB1(1),IPB2(1)
      EQUIVALENCE (IREG(1),REG,IA), (IREG(2),IB)
      DATA ICWORD/0,0400B/
      DATA IBBB/100000B/
      DATA IMESS0/2H- ,2HVE,2HRI,2HFY,2H L,2HIN,2HE / 
      DATA IMESS1/2H- ,2HVE,2HRI,2HFY,2H M,2HUL,2HTI,2HPO,
     +2HIN,2HT ,2HLI,2HNE,2H L,2HU /
      DATA IMESS2/2H- ,2HVE,2HRI,2HFY,2H O,2HFF,2H L,2HIN,
     +2HE ,2HTE,2HRM,2HIN,2HAL,2HS /
      DATA IMESS3/2H- ,2HVE,2HRI,2HFY,2H A,2HCT,2HIV,2HE ,
     +2HTE,2HRM,2HIN,2HAL,2HS / 
      DATA IMESS4/2H- ,2HNO,2H O,2HFF,2H L,2HIN,2HE ,2HTE,2HRM, 
     +2HIN,2HAL,2HS ,2HPR,2HES,2HEN,2HT / 
      DATA IMESS5/2H- ,2HVE,2HRI,2HFY,2H M,2HUL,2HTI,2HPO,2HIN, 
     +2HT ,2HTR,2HML,2H L,2HU ,2H  ,2H  ,2H  ,2HPA,2HSS/
      DATA IMESS6/2H- ,2HTR,2HML,2H L,2HU ,2H  ,2H  ,2H  ,2HLI, 
     +2HNE,2H N,2HO.,2H  ,2H R,2HEM,2HOV,2HED/
      DATA IMESS7/2H- ,2HVE,2HRI,2HFY,2H M,2HUL,2HTI,2HPO,
     +2HIN,2HT ,2HTR,2HML,2H L,2HU /
      DATA IMESS8/2H- ,2HTR,2HML,2H L,2HU ,2H  ,2H  ,2H  ,2HIN, 
     +2HIT,2HIA,2HLI,2HZE,2HD.,2H A,2HSS,2HIG,2HNE,2HD ,2HLI,2HNE,
     +2H N,2HO./
      DATA IMESS9/2H- ,2HVE,2HRI,2HFY,2H M,2HUL,2HTI,2HPO,
     +2HIN,2HT ,2HTR,2HML,2H L,2HU ,2H  ,2H  ,2H  ,2HFA,2HIL/ 
C 
      ICRLF = 1 
      CALL SFILL(IMSG,1,56,0040B) 
      IPB1  = KCVT(IPAR1) 
      IPB2  = KCVT(IPAR2) 
      CALL SGET(IPB1,1,JPB10) 
      CALL SGET(IPB1,2,JPB11) 
      CALL SGET(IPB2,1,JPB20) 
      CALL SGET(IPB2,2,JPB21) 
      IF(IAAA.EQ.11) 7,5
5     IF(IAAA-10) 6,900 
6     IF(INUM.EQ.IAAA) GO TO 900
7     IF(INUM.EQ.0) GO TO 20
      IF(INUM.EQ.1) GO TO 21
      IF(INUM.EQ.2) GO TO 22
      IF(INUM.EQ.3) GO TO 23
      IF(INUM.EQ.4) GO TO 24
      IF(INUM.EQ.5) GO TO 25
      IF(INUM.EQ.6) GO TO 26
      IF(INUM.EQ.7) GO TO 27
      IF(INUM.EQ.8) GO TO 28
      IF(INUM.EQ.9) GO TO 29
C 
C  TXTD1 - VERIFY LINE
20    DO 30 J=1,7 
30    IMSG(J+4) = IMESS0(J) 
      IBUFL = 11
      GO TO 40
C 
C  TXTD1 - VERIFY MULTIPOINT LINE LU mm 
21    DO 31 J = 1,14
31    IMSG(J+4) = IMESS1(J) 
      CALL SPUT(IMSG,37,JPB10)
      CALL SPUT(IMSG,38,JPB11)
      IBUFL = 19
C 
C  TXTD1 - VERIFY OFF LINE TERMINALS
      GO TO 40
22    DO 32 J = 1,14
32    IMSG(J+4) = IMESS2(J) 
      IBUFL = 18
      ICRLF = 2 
      GO TO 40
C 
C  TXTD1 - VERIFY ACTIVE TERMINALS
23    DO 33 J = 1,13
33    IMSG(J+4) = IMESS3(J) 
      ICRLF = 2 
      IBUFL = 17
      GO TO 40
C 
C  TXTD1 - NO OFF LINE TERMINALS PRESENT
24    DO 34 J = 1,16
34    IMSG(J+4) = IMESS4(J) 
      IBUFL = 20
      GO TO 40
C 
C  TXTD1 - VERIFY MULTIPOINT TRML LU mm PASS
25    DO 35 J = 1,19
35    IMSG(J+4) = IMESS5(J) 
      CALL SPUT(IMSG,37,JPB10)
      CALL SPUT(IMSG,38,JPB11)
      IMSG(20) = IPAR3
      IBUFL = 23
      ICRLF = 3 
      GO TO 40
C 
C  TXTD1 - TRML LU mm LINE NO. e REMOVED
26    DO 36 J = 1,17
36    IMSG(J+4) = IMESS6(J) 
      CALL SPUT(IMSG,19,JPB10)
      CALL SPUT(IMSG,20,JPB11)
      IMSG(11) = IPAR3
      CALL SPUT(IMSG,34,JPB21)
      IBUFL = 21
      GO TO 40
C 
C  TXTD1 - VERIFY MULTIPOINT TRML LU mm 
27    DO 37  J = 1,14 
37    IMSG(J+4) = IMESS7(J) 
      CALL SPUT(IMSG,37,JPB10)
      CALL SPUT(IMSG,38,JPB11)
      IMSG(20) = IPAR3
      IBUFL = 21
      GO TO 40
C 
C  TXTD1 - TRML LU mm INITIALIZED, ASSIGNED LINE NO. e
28    DO 38 J = 1,23
38    IMSG(J+4) = IMESS8(J) 
      CALL SPUT(IMSG,19,JPB10)
      CALL SPUT(IMSG,20,JPB11)
      IMSG(11) = IPAR3
      CALL SPUT(IMSG,56,JPB21)
      IBUFL = 28
      GO TO 40
C 
C  TXTD1 - VERIFY MULTIPOINT TRML LU mm FAIL
29    DO 39 J = 1,19
39    IMSG(J+4) = IMESS9(J) 
      CALL SPUT(IMSG,37,JPB10)
      CALL SPUT(IMSG,38,JPB11)
      IMSG(20) = IPAR3
      IBUFL = 23
      ICRLF = 3 
C 
40    DO 41 J = 1,3 
41    IMSG(J+1) = IARAY(J)
43    ICWORD(1) = IOR(100000B,ILLU) 
      IF(INUM.EQ.5) GO TO 42
      IF(INUM.EQ.9) GO TO 42
      DO 44 J = 1,ICRLF 
44    WRITE(ILLU,46)
42    CALL REIO(2,ICWORD,IMSG,IBUFL)
      IF(ICRLF.EQ.1) GO TO 900
      DO 45 J = 1,ICRLF 
45    WRITE(ILLU,46)
46    FORMAT(/) 
C 
900   CONTINUE
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE IMSG6(ILLU,IPAR1,IPAR2,IPAR3,IARAY,INUM, 
     +IAAA),91711-1X032  REV 1926  790906 
C     26.07.79
C 
C 
C     ILLU  =  LIST LU
C     IPAR1 =  INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE 
C     IPAR2 =  INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE 
C     IPAR3 =  ASCII (A2 FORMAT) PARAMETER TO SHOW IN A MESSAGE 
C     INUM  =  MESSAGE SELECTION
C     IAAA  =  0-9 SKIP THE SPECIFIED NUMBERED MESSAGE
C           =  10  SHOW NO MESSAGE
C           =  11  SHOW ANY MESSAGE 
C 
C 
C 
      DIMENSION IMES0(14),IMES1(22),IMES2(16),IMES3(3),IMES4(11), 
     +IMES5(5),ICWORD(2),IREG(2),IMSG(28),
     +IPB1(1),IPB2(1),IPB3(1),IARAY(3),IMES6(13)
      EQUIVALENCE (IREG(1),REG,IA), (IREG(2),IB)
      DATA ICWORD/0,0400B/
      DATA IBBB/100000B/
      DATA IMES0/2H- ,2HNO,2H S,2HTA,2HTU,2HS ,2HRE,2HSP,2HON,
     +2HSE,2H F,2HRO,2HM ,2HLU/ 
      DATA IMES1/2H- ,2HLI,2HNE,2H L,2HU ,0,2H I,2HNI,
     +2HTI,2HAL,2HIZ,2HED,2H. ,2H A,2HSS,2HIG,2HNE,2HD ,2HLI,2HNE,
     +2H N,2HO./
      DATA IMES2/2H- ,2HLI,2HNE,2H L,2HU ,0,2H L,2HIN,
     +2HE ,2HNO,2H. ,2H  ,2HRE,2HMO,2HVE,2HD /
      DATA IMES3/2H- ,2HDO,2HNE/
      DATA IMES4/2H- ,2HNO,2H M,2HUL,2HTI,2HPO,2HIN,2HT ,2HSY,
     +2HST,2HEM/
      DATA IMES5/2H- ,2HRU,2HNN,2HIN,2HG /
      DATA IMES6/2H* ,2HCO,2HRR,2HEC,2HTI,2HVE,2H A,2HCT,2HIO,2HN , 
     +2HNE,2HED,2HED/ 
      ICRLF = -1
      CALL SFILL(IMSG,1,56,0040B) 
      IPB1  = KCVT(IPAR1) 
      IPB2  = KCVT(IPAR2) 
C     WRITE(ILLU,110) IPAR1,IPAR2,IPAR3 
110   FORMAT(2X"IMSG6 :",I2X":",I2X":",A2)
      CALL SGET(IPB1,1,JPB10) 
      CALL SGET(IPB1,2,JPB11) 
      CALL SGET(IPB2,1,JPB20) 
      CALL SGET(IPB2,2,JPB21) 
C     WRITE(ILLU,111) JPB10,JPB11,JPB20,JPB21 
111   FORMAT(2X"IMSG6 :"A2X":",A2X":",A2X":",A2)
      IF(IAAA.EQ.11) 7,5
5     IF(IAAA-10) 6,900 
6     IF(INUM.EQ.IAAA) GO TO 900
7     DO 8 J = 1,3
8     IMSG(J+1) = IARAY(J)
      IF(INUM.EQ.0) GO TO 20
      IF(INUM.EQ.1) GO TO 21
      IF(INUM.EQ.2) GO TO 22
      IF(INUM.EQ.3) GO TO 23
      IF(INUM.EQ.4) GO TO 24
      IF(INUM.EQ.5) GO TO 25
      IF(INUM.EQ.6) GO TO 26
      IF(INUM.EQ.7) GO TO 27
      IF(INUM.EQ.8) GO TO 28
      IF(INUM.EQ.9) GO TO 29
C 
C  TXTD1 - NO STATUS RESPONSE FROM LU mm
20    DO 30 J = 1,14
30    IMSG(J+4) = IMES0(J)
      CALL SPUT(IMSG,38,JPB10)
      CALL SPUT(IMSG,39,JPB11)
      IBUFL = 20
      GO TO 40
C 
C  TXTD1 - LINE LU mm INITIALIZED.  ASSIGNED LINE NO. e 
21    DO 31 J = 1,22
31    IMSG(J+4) = IMES1(J)
      CALL SPUT(IMSG,19,JPB10)
      CALL SPUT(IMSG,20,JPB11)
      CALL SPUT(IMSG,54,JPB21)
      IBUFL = 27
      GO TO 40
C 
C  TXTD1 - LINE LU mm LINE NO. e REMOVED
22    DO 32 J = 1,16
32    IMSG(J+4) = IMES2(J)
      CALL SPUT(IMSG,19,JPB10)
      CALL SPUT(IMSG,20,JPB11)
      CALL SPUT(IMSG,31,JPB21)
      IBUFL = 20
      GO TO 40
C 
C  TXTD1 - DONE 
23    DO 33 J = 1,3 
33    IMSG(J+4) = IMES3(J)
      IBUFL = 7 
      ICRLF = 1 
      GO TO 40
C 
C  TXTD1 - NO MULTIPOINT SYSTEM 
24    DO 34 J = 1,11
34    IMSG(J+4) = IMES4(J)
      IBUFL = 16
      GO TO 40
C 
C  TXTD1 - RUNNING
25    DO 35 J = 1,5 
35    IMSG(J+4) = IMES5(J)
      ICRLF = 1 
      IBUFL = 10
      GO TO 40
C 
C   TXTD1 - REMOVE A LINE 
26    WRITE(ILLU,36)IARAY 
36    FORMAT(/2X3A2"- REMOVE A LINE") 
      GO TO 900 
C 
C   TXTD1 - VERIFY A TERMINAL 
27    WRITE(ILLU,37)IARAY 
37    FORMAT(/2X3A2"- VERIFY TERMINAL") 
      GO TO 900 
C 
C   TXTD1 - INITIALIZE A LINE 
28    WRITE(ILLU,38)IARAY 
38    FORMAT(/2X3A2"- INITIALIZE A LINE") 
      GO TO 900 
C 
C   TXTD1 * CORRECTIVE ACTION NEEDED
C 
29    DO 39 J = 1,13
39    IMSG(J+4) = IMES6(J)
      IBUFL = 18
C 
40    ICWORD(1) = IOR(100000B,ILLU) 
      IF(ICRFL) 43,41 
41    DO 42 J = 1,ICRLF 
42    WRITE(ILLU,44)
44    FORMAT(/) 
43    CALL REIO(2,ICWORD,IMSG,IBUFL)
C 
900   CONTINUE
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE IMSG7(ILU, 
     +IPAR1,IARAY,INUM,IAAA),91711-1X032  REV 1926  790906
C     26.07.79
C 
C 
C     ILU  =  LIST LU 
C     IPAR1 =  PARAMETER RETURNED TO CALLER 
C     INUM  =  MESSAGE SELECTION
C     IAAA  =  0-9 SKIP THE SPECIFIED NUMBERED MESSAGE
C           =  10  SHOW NO MESSAGE
C           =  11  SHOW ANY MESSAGE 
C 
C 
C 
      DIMENSION ICWORD(2),IARAY(3)
      DATA ICWORD/0,0400B/
      DATA IBBB/100000B/
      IPAR1 = 0 
      IF(IAAA.EQ.11) 7,5
5     IF(IAAA-10) 6,900 
6     IF(INUM.EQ.IAAA) GO TO 900
7     IF(INUM.EQ.0) GO TO 20
      IF(INUM.EQ.1) GO TO 21
      IF(INUM.EQ.2) GO TO 22
      IF(INUM.EQ.3) GO TO 23
      IF(INUM.EQ.4) GO TO 24
      IF(INUM.EQ.5) GO TO 25
      IF(INUM.EQ.6) GO TO 26
      IF(INUM.EQ.7) GO TO 27
      IF(INUM.EQ.8) GO TO 28
      IF(INUM.EQ.9) GO TO 29
C 
20    WRITE(ILU,111)IARAY 
      GO TO 40
21    WRITE(ILU,112)IARAY 
      GO TO 40
22    WRITE(ILU,113)IARAY 
      GO TO 40
23    WRITE(ILU,114)IARAY 
      GO TO 40
24    WRITE(ILU,115)IARAY 
      GO TO 40
25    WRITE(ILU,116)IARAY 
      GO TO 40
26    WRITE(ILU,117)IARAY 
      GO TO 40
27    WRITE(ILU,118)IARAY 
      GO TO 40
28    WRITE(ILU,119)IARAY 
      GO TO 40
29    WRITE(ILU,120)IARAY 
      GO TO 40
C 
C 
40    READ(ILU,*)IPAR1
C 
111   FORMAT(/2X3A2"- ENTER LINE LU   (SYSTEM)  (0 TO STOP):_") 
112   FORMAT(/2X3A2"- ACTIVE LINE LU  (SYSTEM)  (0 TO STOP):_") 
113   FORMAT(/2X3A2"- ENTER TRML LU   (SYSTEM)  (0 TO STOP):_") 
114   FORMAT(/2X3A2"- ACTIVE TRML LU  (SYSTEM)  (0 TO STOP):_") 
115   FORMAT(2X3A2"- ENTER TRAMSMIT NAK COUNT  (0-15):_") 
116   FORMAT(2X3A2"- ENTER RECEIVE  NAK COUNT  (0-15):_") 
117   FORMAT(2X3A2"- ENTER WACK COUNT          (0-31):_") 
118   FORMAT(2X3A2"- ENTER TRML BLOCK FACTOR    (0-4):_") 
119   FORMAT(/2X3A2"- ENTER TIMEOUT VALUE            (0-30):_") 
120   FORMAT(/2X3A2"- ENTER LINE NUMBER               (0-7):_") 
C 
900   CONTINUE
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE IMSG8(ILLU,IARAY,INUM, 
     +IAAA),91711-1X032  REV 1926  790906 
C     26.07.79
C 
C 
C     ILLU  =  LIST LU
C     INUM  =  MESSAGE SELECTION
C     IAAA  =  0-9 SKIP THE SPECIFIED NUMBERED MESSAGE
C           =  10  SHOW NO MESSAGE
C           =  11  SHOW ANY MESSAGE 
C 
C 
C 
      DIMENSION IARAY(3)
      IF(IAAA.EQ.11) 7,5
5     IF(IAAA-10) 6,900 
6     IF(INUM.EQ.IAAA) GO TO 900
7     IF(INUM.EQ.0) GO TO 20
      IF(INUM.EQ.1) GO TO 21
      IF(INUM.EQ.2) GO TO 22
      IF(INUM.EQ.3) GO TO 23
      IF(INUM.EQ.4) GO TO 900 
      IF(INUM.EQ.5) GO TO 25
      IF(INUM.EQ.6) GO TO 900 
      IF(INUM.EQ.7) GO TO 27
      GO TO 900 
C 
C 
20    WRITE(ILLU,30)IARAY 
30    FORMAT(/2X3A2"- REMOVE A TERMINAL") 
      GO TO 900 
C 
C 
21    WRITE(ILLU,31)IARAY 
31    FORMAT(/2X3A2"- INITIALIZE A TERMINAL") 
      GO TO 900 
C 
C  TXTD1 - SET NAK, WAK, TERMINAL BLOCK SIZE
22    WRITE(ILLU,32)IARAY 
32    FORMAT(/2X3A2"- SET NAK, WAK, TERMINAL BLOCK SIZE") 
      GO TO 900 
C 
C  TXTD1 - SET EDIT MODE AND POLLING GLOBALS
23    WRITE(ILLU,33)IARAY 
33    FORMAT(/2X3A2"- SET EDIT MODE AND POLLING GLOBALS") 
      GO TO 900 
C 
C  TXTD1 - GROUP-LINE SELECT AND SEND A MESSAGE 
25    WRITE(ILLU,35)IARAY 
35    FORMAT(/2X3A2"- GROUP-LINE SELECT AND SEND A MESSAGE")
      GO TO 900 
C 
C   TXTD1 - CONFIGURE A TERMINAL
27    WRITE(ILLU,37)IARAY 
37    FORMAT(/2X3A2"- CONFIGURE A TERMINAL")
      ICRLF = 1 
      GO TO 900 
C 
C 
900   CONTINUE
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE LUVFY(INLU,ILLU,ITLU,IGRUP,IOFLN,ID,KGID,
     +KEY,IXLU,IARAY),91711-1X032  REV 1926  790906 
C     03.10.79
C 
C     THIS SUBROUTINE IS CALLED BY VMPLN, VMPTL, UPMTL TO VERIFY
C     TERMINAL = ITLU ON LINE LU = INLU.  FIRST THE WHO ARE YOU POLL IS 
C     MADE ON THE CURRENT GROUP = ID, THEN THE EQT IS CHECKED FOR 
C     TERMINAL ID MATCHES AGAINST THE WRU LIST IN BUFFER IGRUP. 
C     IBUFS RETURNED FROM ILINB CONTAINS ANY LU FOUND FOR THE GROUP.
C     FOR NO LU IN THE GROUP, MAKE SURE THERE WAS NO WRU RESPONSE,
C     IF THERE WAS, GO ON TO EXAMINE IF THIS IS AN OFF-LINE TERMINAL. 
C     FOR LU RETURNED IN IBUFS, TRY TO MATCH EACH ID FROM THE EQT 
C     TO ONLY ONE ID IN THE WRU, ANY EXTRA ITEMS IN WRU ARE THEN
C     TESTED FOR BEING OFF-LINE.
C 
      DIMENSION IGRUP(30),IBUFS(28) 
      DIMENSION IBUFV(60),IARAY(3),IOFLN(30),IBUFX(28),IBXLU(60)
C 
C   INITIALIZE VARIABLES
      IERCT = 0 
      IXLU = 0
      IBSL = 0
      INAT = 0
C   INITIALIZE BUFFERS
      CALL SFILL(IBXLU,1,120,000B)
      CALL SFILL(IBUFV,1,120,000B)
      CALL SFILL(IGRUP,1,60,000B) 
      CALL SFILL(IOFLN,1,60,000B) 
      IOFLN(1) = -1 
      CALL SFILL(IBUFS,1,56,000B) 
      CALL SFILL(IBUFX,1,56,000B) 
C 
C   IF KEY IS NEGATIVE, GO DIRECTLY TO THE GROUP POLL 
C 
      IF(KEY.EQ.-1) GO TO 10
C 
C   GET THE TERMINAL'S ID CHARACTERS THEN SHOW
C   TXTD1 - VERIFY MULTIPOINT TRML LU MMAB
C 
      CALL ILINA(ITLU,ILNN,ITID,IE11) 
      CALL IMSG4(ILLU,ITLU,0,ITID,7,IARAY,11) 
C 
C   GET THE TERMINALS IN THE CURRENT GROUP ID 
10    CALL IGRID(INLU,ID,IGRUP) 
C   IF IGRUP(1) = -1  THERE IS NO RESPONSE FROM TERMINALS 
      IF(IGRUP(1)) 55,53
C 
C   SHOW THE RESPONDING TERMINALS 
53    INAT = IGRUP(1) - 1 
      CALL IMSG2(ILLU,INAT,KGID,2,IARAY,11) 
C 
      DO 54  K = 2,IGRUP(1) 
103   CALL IMSG2(ILLU,0,IGRUP(K),3,IARAY,11)
54    CONTINUE
C 
C 
C   WHETHER THERE IS OR THERE IS NOT A REPLY IN THE GROUP,
C   GET EQT LIST, THEN COMPARE ID FIELD OF EQT WITH WRU LIST. 
C   IBSL FROM ILINB = (# OF TRML LU IN GROUP KGID) + 1
C 
C 
55    CALL ILINB(ILLU,INLU,KGID,IBUFS,INAT,ITMCT) 
C   WERE ANY LU IN CURRENT GROUP ?
      IF(IBUFS(2) -3) 556,56
C 
C   VERIFY THE EQT LIST AGAINST THE WRU LIST
C 
56    CALL ILIND(ILLU,IGRUP,IBUFS,IBUFV,IDCT,IBXLU,IARAY,KEY) 
C 
C   IS ITLU 264X TERMINAL ? 
C   IBXLU CONTAINS THE LU IN THIS GROUP WHICH FAIL VERIFICATION 
C 
      K = 4 
560   IF(IBXLU(1).GT.1) 561,554 
561   IF(ITLU.EQ.IBXLU(K)) 565,562
562   IF(K.EQ.IBXLU(1)) 554,563 
563   K = K+3 
      GO TO 561 
C 
565   IXLU = IBXLU(K) 
      IERCT = IERCT + 1 
C 
C 
C 
C 
C   IF THERE WAS NO WRU REPLY, EQT TABLE IS NOT CURRENT.  HARD ERROR. 
C   FOR ANY MISSING OR DUPLICATE ID IN EQT IBUFV(1) > 0.
C 
554   IF(IBUFV(1).GT.0) IERCT = IERCT + 1 
C 
C   IF THERE WAS NO WRU REPLY, EQT HAS AN ID THAT DOESN'T ANSWER. 
C 
556   IF(INAT.EQ.0) GO TO 57
C 
C   USING THE WRU AND EQT DATA, COMPARE AND CONTRAST TO FIND ANY
C   OFF-LINE TERMINALS. 
C 
      CALL ILINF(INLU,ILLU,IARAY,IGRUP,IBUFS,IOFLN,IBUFX,IDCT,-1) 
C 
C   HOW MANY ID WERE SIMILAR IN EQT LIST ? ANS. SHOULD BE 1.
C 
558   IF(IDCT-2) 25,26
C 
C   WHEN IBUFX(2) IS ZERO, THERE ARE NO DUPLICATE OFF-LINE ID 
C 
25    IF(IBUFX(2)-1) 57,27
C 
C  DUPLCATE ID IN EQT MESSAGE 
26    IERCT = IERCT+1 
C 
C   IF THERE WERE NO PROBLEMS, SEND PASS MESSAGE
C 
57    IF(IERCT-1) 573,27
C 
C   SEND FAIL MESSAGE 
C   TXTD1 - VERIFY GID AB : FAIL
C 
27    CALL IMSG2(ILLU,0,KGID,1,IARAY,11)
      GO TO 900 
C 
C   SEND PASS MESSAGE 
C   TXTD1 - VERIFY GID AB : PASS
C 
573   CALL IMSG2(ILLU,0,KGID,0,IARAY,11)
C 
900   CONTINUE
C     WRITE(ILLU,110)IXLU,KEY 
110   FORMAT(2X"LUVFY IXLU:",I2X"KEY:",I2)
      END 
C     END$
CFTN4,L 
      SUBROUTINE IXGLS(ILLU,INLU,IBUFR,IBUFL,IGID,
     +ILNN),91711-1X032  REV 1926  790906 
C     25.04.79
C     THIS SUBROUTINE SENDS A GROUP/LINE SELECT AND A MESSAGE 
C     TO THE 3075A, 3076A, 3077A TERMINALS.  CHECK THE BUFFER LENGTH
C     BEFORE CALLING TO ENSURE IT ISN'T ZERO OR TOO BIG.
C     NO CHECK IS MADE FOR GROUP ID PRESENT ON THE LINE, AND ONLY 
C     THE LAST TWO DECIMAL DIGITS APPEAR IN THE TRANSMISSION LOG. 
C     NOTE: IGID IS FORMED IN IOGLS BEFORE CALLINF IXGLS. 
C 
C 
C     ILLU = LIST LU
C     INLU = LINE LU
C     IBUFR = ADDRESS OF BUFFER 
C     IBUFL = BUFFER LENGTH 
C     IGID = GID IN UPPER 8 BITS, ZEROS IN LOWER 8 BITS, GROUP SELECT 
C            OR 177376B, LINE SELECT. 
C     ILNN = INTEGER LINE NUMBER
C 
C     SOURCE TERM : 
C 
      DIMENSION IREG(2),IBUFR(128),ICWORD(2),IMESSA(14),IMSG(24), 
     +IMESS1(3),IMESS2(3) 
      EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) 
      DATA ICWORD/0,400B/ 
      DATA IMESSA/2HME,2HSS,2HAG,2HE ,2H (,0,2H W,2HOR,2HDS,2H) , 
     +2HSE,2HNT,2H T,2HO /
      DATA IMESS1/2HLI,2HNE,2H  / 
      DATA IMESS2/2HGR,2HOU,2HP / 
      CALL SFILL(IMSG,1,48,0040B) 
C 
C   PREPARE BASIC MESSAGE FORMAT
C 
      DO 3 J = 1,14 
3     IMSG(J+1) = IMESSA(J) 
C 
C   CONVERT IBUFL AND LINE NUMBER TO ASCII DIGITS 
C 
      IMSG(7) = KCVT(IBUFL) 
      LINE = KCVT(ILNN) 
C 
C   CHECK FOR GROUP SELECT OR LINE SELECT 
C 
      IF (IGID.EQ.177376B) 5,6
C 
C   MESSAGE TO LINE : FILL IMSG WITH IMESS1 
C 
5     DO 7 J = 1,2
7     IMSG(J+15) = IMESS1(J)
      CALL SPUT(IMSG,37,LINE) 
      GO TO 10
C 
C   MESSAGE TO GROUP : SET ID FOR GROUP SELECT, FILL IMSG WITH IMESS2 
C 
6     ID = IOR(IGID,376B) 
      DO 8 J = 1,3
8     IMSG(J+15) = IMESS2(J)
      IMSG(19) = IGID 
C 
C   SEND THE MESSAGE
C 
10    CONTINUE
100   WRITE(ILLU,110)IMSG 
      ICWORD(1) = IOR(100000B,INLU) 
      REG = XLUEX(2,ICWORD,IBUFR,IBUFL,ID)
      CONTINUE
      IF(IBUFL) 910,910,900 
C   MESSAGE NOT SENT
910   WRITE(ILLU,911)IBUFL
      GO TO 900 
C 
110   FORMAT(19A2)
911   FORMAT(2X"MESSAGE NOT SENT, (",I2," WORDS IN BUFFER)")
C 
900   CONTINUE
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE IOGLS(ILU,ILLU,INLU, 
     +IBUFL,IARAY),91711-1X032  REV 1926  790906
C     28.08.79
C     THIS SUBROUTINE PREPARES A MESSAGE BUFFER AND SENDS 
C     THE MESSAGE TO THE 3075A, 3076A, 3077A TERMINALS. 
C 
C     ILU  = CONSOLE LU 
C     ILLU = LIST LU
C     INLU = LINE LU
C 
C     CALLS:  IXGLS  GROUP OR LINE SELECT AND SEND THE MESSAGE. 
C     CALLS:  ILINA  GET MULTIPOINT LINE NUMBER FOR INLU. 
C 
C 
      DIMENSION IREG(2),IBUFR(128),IMESSA(4),IMESS1(3),IMESS2(3), 
     +ICWORD(2),IARAY(3)
      EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) 
      DATA IMESS1/2HGR,2HOU,2HP / 
      DATA IMESS2/2HLI,2HNE,2H  / 
      DATA IREG/0,0/
      DATA ICWORD/0,2200B/
      IBUFL = 128 
C   INITIALIZE IMESSA 
      CALL SFILL(IMESSA,1,8,0040B)
C   INITIALIZE THE MESSAGE BUFFER 
      CALL SFILL(IBUFR,1,255,0040B) 
C   GET LINE NUMBER FROM LINE EQT 
      CALL ILINA(INLU,ILNN,IE16,IE11) 
      LINE = KCVT(ILNN) 
C   GET GROUP ID
100   WRITE(ILU,110)IARAY,LINE
C   ENTER KEY FOR LINE SELECTION, GID CHARACTER FOR GROUP SELECTION 
101   READ(ILU,111)IGID 
      IF(IGID.EQ.020040B) GO TO 5 
      IF((IGID.GT.37440B).AND.(IGID.LT.55440B)) GO TO 7 
      GO TO 100 
C 
C   DEFAULT ENTERED, IGID SET TO LINE SELECT CODE 
5     IGID = 177376B
C   FILL IN MESSAGE 2 
      DO 3 J = 1,3
3     IMESSA(J) = IMESS2(J) 
      IMESSA(4) = KCVT(ILNN)
      GO TO 9 
C   GROUP ID ENTERED, FILL IN MESSAGE 1 
7     DO 4 J = 1,3
4     IMESSA(J) = IMESS1(J) 
      IMESSA(4) = IGID
C   STRIP SPACE CHARACTER IN LOWER BYTE 
      IGID = IAND(IGID,057400B) 
C 
C   GET A MESSAGE 
9     CONTINUE
102   WRITE(ILU,112)IARAY,IMESSA
      ICW = IOR(400B,ILU) 
103   REG = REIO(1,ICW,IBUFR,IBUFL) 
      IBUFL = IB
C   WRITE THE DATA TO THE PRINTER.  SET V BIT TO WRITE COLUMN 1.
C     ICW = IOR(200B,6) 
C04   REG = EXEC(2,ICW,IBUFR,IBUFL) 
C 
C   DON'T SEND ANYTHING IF IBUFL = 0. 
      IF(IBUFL.EQ.0) GO TO 40 
C   IS THE NUMBER OF WORDS IN THE MESSAGE TOO BIG FOR THE TERMINAL? 
      IF(IBUFL.LT.90) 105,10
C   SET THE TERMINAL BLOCKING FACTOR FOR THE LINE 
C   SET FOR 512 BYTES 
10    ICW = 043146B 
20    ICWORD(1) = IOR(100000B,INLU) 
30    REG = XLUEX(3,ICWORD,ICW) 
      GO TO 105 
C   NO MESSAGE AVAILABLE, DO NOTHING AND RETURN 
40    GO TO 900 
C 
C   SEND THE MESSAGE TO THE TERMINAL. 
105   CALL IXGLS(ILLU,INLU,IBUFR,IBUFL,IGID,ILNN) 
      GO TO 900 
C 
110   FORMAT(/2X3A2"- ENTER GROUP ID CHARACTER (DEFAULT LINE ",R1,")",
     +" :_")
111   FORMAT(A1)
112   FORMAT(2X3A2"- MESSAGE TO ",4A2," :_")
C 
210   FORMAT(2X"IOGLS CHECKPOINT 0  IBUFL = ",I6) 
900   RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE ILINA(ITLU,LINE,IE16,
     +IE11),91711-1X032  REV 1926  790906 
C     25.04.79
C     THIS SUBROUTINE GETS THE LINE NUMBER AND TERMINAL ID FOR ITLU.
C     THE TERMINAL MUST BE INITIALIZED BEFORE CALLING ILINA.
C     NOTE: NO CHECK IS MADE HERE FOR DRIVER TYPE 7 OR IF THIS IS A 
C     TERMINAL.  USE LUCHK BEFORE CALLING ILINA.
C 
C     ITLU = LU UNDER TEST
C     LINE = LINE NUMBER ASSIGNED TO LU UNDER TEST
C     IE16 = TERMINAL ID
C     IE11 = LINK LIST POINTER
C 
C 
C 
C     CALLS:  SHFT   ASSEMBLY ROUTINE MOVES UPPER BYTE TO LOWER BYTE
C                    FILLING ZEROS IN UPPER BYTE. 
C 
C 
C     SOURCE TERM :  LINE  CHARACTER IN LOWER BYTE, ZERO FILLED.
C                    IE16  TERMINAL ID FROM EQT WORD 16.
C                    IE11  LINK LIST POINTER EQT WORD 11. 
C 
C 
      IEQTA = IGET(1650B) 
      IDRT  = IGET(1652B) 
C  EQT ASSIGNMENT FOR THIS LU 
      ITVAL =IGET(IDRT+ITLU-1)
      IEQTT=IAND(ITVAL,077B)
C  EQT DATA 
      ITTBL = (IEQTT-1)*15+IEQTA
      IE11  = IGET(ITTBL+10)
      ITQX  = IGET(ITTBL+12)
      IE16  = IGET(ITQX)
      IT17  = IGET(ITQX+1)
      LINE  = IAND(IT17,03400B) 
      CALL SHFT(LINE) 
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE ILINE(INLU,ILLU,INUM,
     +LINE,IARAY),91711-1X032  REV 1926  790906 
C     08.31.79
C     THIS SUBROUTINE FINDS MULTIPOINT LINE ASSIGNMENTS.
C     A LINE ASSIGNMENT TABLE IS OUTPUT TO ILLU. THE PARAMETER
C     "LINE" IS RETURNED RIGHT ADJUSTED, ZERO FILLED, READY FOR KCVT. 
C 
C     INLU = LINE LU UNDER TEST 
C     ILLU = LIST LU
C     INUM = COMPLETION CODE
C          = 0  NO MULTIPOINT DEVICES ASSIGNED
C          = 1  LINE IS INITIALIZED WITH NO ASSIGNED TERMINALS. 
C          > 1  LINE IS INITIALIZED WITH (INUM-1) ASSIGNED TERMINALS. 
C     LINE = LINE NUMBER ASSIGNED TO LU UNDER TEST
C 
C 
C 
C     CALLS:  X13    ASSEMBLY ROUTINE REQUESTS STATUS ON SYSTEM LU
C                    BYPASSING SWITCH TABLE.
C     CALLS:  SHFT   ASSEMBLY ROUTINE MOVES UPPER BYTE TO LOWER BYTE
C                    FILLING ZEROS IN UPPER BYTE. 
C     CALLS:  SHF14  ASSEMBLY ROUTINE MOVES UPPER TWO BITS TO LOWER 
C                    TWO BITS OF THE WORD.  BITS 15-2 ARE ZEROS.
C     CALLS:  SHF15  ASSEMBLY ROUTINE MOVES BIT 15 TO BIT 0,
C                    BITS 14-1 ARE ZEROS. 
C     CALLS:  LUCHK  DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, 
C                    RETURN A COMPLETION CODE TO THE CALLER.
C     CALLS:  ILINA  GET THE LINE NUMBER FROM EQT.
C 
C     SOURCE TERM :  LINE  CHARACTER IN LOWER BYTE, ZERO FILLED.
C                    INUM  COMPLETION CODE
C 
C 
      DIMENSION IMESS1(3),IMESS2(3),IMESS3(3),
     +IMESS4(2),ICWORD(2),IARAY(3),IMSG(20),IMESS5(15),IMESS6(1)
      DATA IMESS1/2H L,2HIN,2HE / 
      DATA IMESS2/2H T,2HRM,2HL / 
      DATA IMESS3/2HDO,2HWN,2H  / 
      DATA IMESS4/0/
      DATA IMESS5/2HLN,2H  ,2HID,2H  ,2HIN,2H L,2HU ,2HFB,2HIT,2H E,
     +2HQT,2H A,2HV ,2HS.,2HC./ 
      DATA IMESS6/2H*S/ 
      DATA ICWORD/0,400B/ 
      INUM = 0
C 
      IEQTA = IGET(1650B) 
      IDRT  = IGET(1652B) 
      ILUMAX= IGET(1653B) 
      CALL SFILL(IMSG,1,40,0040B) 
C 
C   GET THE LINE NUMBER OF THE LINE LU
      CALL ILINA(INLU,LINE,IT16,IT11) 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C   ITERATE FROM LINE LU = INLU IN ASCENDING NUMERICAL ORDER TO LUMAX 
C   CHECK FOR LU POINTING TO NONZERO EQT
C 
C 
      DO 50 I=INLU,ILUMAX 
      IVAL = IGET(IDRT+INLU-1)
C 
C  IF THE EQT FIELD IS ZERO, GO ON TO THE NEXT LU.
C 
      IEQQ = IAND(IVAL,077B)
      IF(IEQQ.EQ.0) GO TO 50
C 
C   THE LU POINTS TO AN EQT 
C   STATUS REQUEST ON TEST LU.   X13 SETS BYPASS CONDITION. 
C 
      CALL X13(I,IEQT5,IEQT4,IEQST) 
C  GET THE NONZERO SELECT CODE ASSIGNMENT 
      ISCOD = IAND(IEQT4,077B)
C  CHECK FOR TYPE 7 DEVICE AT THIS LU 
      IDVC7 = IAND(IEQT5,037400B) 
      CALL SHFT(IDVC7)
      IF(IDVC7.NE.7) GO TO 50 
C  DETERMINE IF LU IS DOWN, AND AVAILABILITY OF EQT 
      IAV = IEQT5 
      CALL SHF14(IAV) 
      IFBIT = IEQST 
      CALL SHF15(IFBIT) 
C  GET TERMINAL LINE NUMBER, ID, AND LINK POINTER 
      CALL ILINA(I,ILNN,IE16,IE11)
C 
      LBIT  = IE16
      CALL SHF15(LBIT)
C 
C  IF LINE LU AND TERMINAL LU DON'T HAVE THE SAME NUMBER, GO TO 50
C 
      IF(ILNN.NE.LINE) GO TO 50 
      INUM = INUM+1 
C 
C 
C 
C 
C   SHOW MESSSAGE BANNER THE FIRST ITERATION
C 
      IF(INUM.NE.1) GO TO 20
      DO 5 J = 1,15 
5     IMSG(J+1) = IMESS5(J) 
      WRITE(ILLU,6) 
6     FORMAT(/) 
      ICWORD(1) = IOR(100000B,ILLU) 
      CALL REIO(2,ICWORD,IMSG,16) 
      CALL SFILL(IMSG,1,40,0040B) 
      GO TO 20
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C  CHECK LINKED LIST POINTER AND GET AN ASCII LINE NUMBER 
C 
10    IMSG(6) = 020061B 
      IF(IE11.EQ.0) IMSG(6) = 020060B 
      IMLN = KCVT(ILNN) 
      CALL SGET(IMLN,2,IMLN11)
      CALL SPUT(IMSG,3,IMLN11)
      GO TO 40
C 
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
C  CHECK THIS LU, SHOW NO MESSAGES
C 
20    ICCC = 10 
      CALL LUCHK(ILLU,I,IERCD,IARAY,ICCC) 
      IF(IERCD.EQ.0) GO TO 21 
      IF(IERCD.EQ.1) GO TO 30 
      IF(IERCD.EQ.3) GO TO 30 
      IF(IERCD.EQ.4) GO TO 23 
      IF(IERCD.EQ.6) GO TO 25 
      IF(IERCD.EQ.7) GO TO 23 
      IF(IERCD.EQ.9) GO TO 23 
      IF(IERCD.EQ.-1)GO TO 26 
      IF(IERCD.EQ.-2)GO TO 26 
      GO TO 10
C 
C   FILL IMESSA AND IMESSB
C   DORMANT TERMINAL
21    DO 22 J=1,3 
      IMSG(J+2)=IMESS2(J) 
22    CONTINUE
      GO TO 10
C   DORMANT LINE
23    DO 24 J=1,3 
      IMSG(J+2)=IMESS1(J) 
24    CONTINUE
      GO TO 10
C   INITIALIZED TERMINAL
25    IMSG(4)=IE16
      GO TO 10
C   NONZERO SUBCHANNEL
26    CALL SGET(IMESS6,1,ISBCH) 
      CALL SPUT(IMSG,6,ISBCH) 
      CALL SGET(IMESS6,2,ISBCH) 
      CALL SPUT(IMSG,7,ISBCH) 
      ISUB1 = (IAND(IEQST,30B))/10B 
      ISUB2 = IAND(IEQST,7B)
      ISUB1 = KCVT(ISUB1) 
      ISUB2 = KCVT(ISUB2) 
      CALL SPUT(IMSG,8,ISUB1) 
      CALL SPUT(IMSG,9,ISUB2) 
C 
C  IF THIS SUBCHANNEL IS ALSO DOWN, GO TO 32
C 
      IF(IERCD.EQ.-2) 261,10
C 
C 
C 
C   EQT DOWN OR STATE IS NOT CLEAR
30    IF(LBIT.EQ.0) GO TO 32
C 
C  LINE IS DOWN 
C 
      DO 31 J=1,3 
      IMSG(J+2)=IMESS1(J) 
      IMSG(J+16) = IMESS3(J)
31    CONTINUE
      GO TO 10
C 
C  TERMINAL IS DOWN 
C 
32    IF(IE16.EQ.0) GO TO 34
C 
C  ACTIVE TERMINAL
C 
      IMSG(4) = IE16
C 
C   ENTER HERE FROM NONZERO SUBCHANNEL FOR IERCD = -2 
C 
261   DO 33 J=1,3 
      IMSG(J+16) = IMESS3(J)
33    CONTINUE
      GO TO 10
C 
C  DORMANT TERMINAL 
C 
34    DO 35 J=1,3 
      IMSG(J+2)=IMESS2(J) 
      IMSG(J+16) = IMESS3(J)
35    CONTINUE
      GO TO 10
C 
40    CONTINUE
      IMLU    = KCVT(I) 
      CALL SGET(IMLU,1,ILU10) 
      CALL SGET(IMLU,2,ILU11) 
      CALL SPUT(IMSG,14,ILU10)
      CALL SPUT(IMSG,15,ILU11)
      IMSG(9) = KCVT(IFBIT) 
      IMSG(12) = KCVT(IEQQ) 
      IMSG(13) = KCVT(IAV)
      IMSG(16) = 041040B
      LCOD1 = IAND(ISCOD,000007B) 
      LCOD1 = KCVT(LCOD1) 
      LCOD2 = (IAND(ISCOD,000070B))/10B 
      LCOD2 = KCVT(LCOD2) 
      CALL SPUT(IMSG,29,LCOD2)
      CALL SPUT(IMSG,30,LCOD1)
      CALL REIO(2,ICWORD,IMSG,20) 
C 
      CALL SFILL(IMSG,1,40,0040B) 
C 
50    IDRT=IDRT+1 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
      WRITE(ILLU,6) 
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE ILINB(ILLU,INLU,IGID,IBUFS,INAT, 
     +ITMCT),91711-1X032  REV 1926  790906
C     28.06.79
C     THIS SUBROUTINE GETS A LIST OF LU NUMBERS OF TERMINALS IN THE 
C     GROUP BY SEARCHING THE EQT.  A GROUP ID CHARACTER IS PASSED 
C     TO THIS ROUTINE.
C     NOTE: NO CHECK IS MADE HERE FOR DRIVER TYPE 7 OR IF INLU IS 
C     A LINE LU.  USE LUCHK BEFORE CALLING ILINB. 
C 
C     ILLU = LIST LU
C     INLU = LINE LU
C     IGID = GROUP ID 
C     IBUFS = IBUFS(1) IS LINE LU NUMBER, IBUFS(2) IS IBUFL, THEN 
C             GROUP IGID TERMINAL NUMBERS.
C             THE NUMBERS ARE SYSTEM LU NUMBERS IN INTEGER FORMAT 
C     IBUFL = NUMBER OF TERMINAL LU IN IBUFS, ONE WORD PER TERMINAL, PLUS 
C             ONE (FOR THE LINE LU).
C           = 0  LINE NOT PRESENT IN INLU EQT 
C           = 1  LINE IS INITIALIZED WITH NO ASSIGNED TERMINALS.
C           > 1  LINE IS INITIALIZED WITH (IBUFL-1) ASSIGNED TERMINALS. 
C 
C     CALLS:  ILINA  GET THE LINE NUMBER, LIST POINTER, AND TERMINAL
C                    GROUP ID CHARACTER.
C     CALLS:  LDARG  ASSEMBLY ROUTINE TO CALL TRMLU 
C 
C     SOURCE TERM :  IBUFS  LIST OF TERMINAL LU ON ASSIGNED LINE
C 
C 
      DIMENSION IBUFS(28) 
      KK = 2
      ITMCT = 0 
      DO 1 J=1,28 
1     IBUFS(J) = 0
      IBUFS(2) = -1 
C 
C   GET THE LINE WORD 11 AND WORD 16
      CALL ILINA(INLU,ILNN,IE16,IE11) 
C 
C   DON'T GO ON IF LIST LINK POINTER IS ZERO. THERE IS NO LINE
      IF(IE11.EQ.0) 901,3 
C   DON'T GO ON IF THE LINE IS DORMANT
3     IF(IE16.EQ.100000B) 901,4 
C 
C   PUT THE LINE LU NUMBER INTO THE FIRST WORD OF IBUFS.
C   STARTING WITH THE LINE EQT, IT11 POINTS TO WORD ONE OF THE
C   NEXT EQT IN THE LIST.  GET THAT LU NUMBER, THEN USE IT TO GET THE 
C   EQT WORD 11, 16, AND 17 DATA CONTAINING LIST POINTER, TERMINAL ID,
C   AND LINE NUMBER.  CHECK THE LINE NUMBER AND GROUP ID OF THE TERMINAL
C   EQT TO BE SURE IT'S THE CORRECT LINE AND GROUP.  IF IT IS, PUT IT 
C   INTO IBUFS.  IF IT DOESN'T CHECK OUT, DON'T PUT ANYTHING INTO IBUFS 
C   FOR THIS EQT.  USING THE TERMINAL EQT WORD 11, CHECK IF IT POINTS 
C   TO THE LINE EQT.  IF IT DOES, THE GROUP SEARCH IS COMPLETE. 
C   FOR EACH TERMINAL FOUND SATISFYING LINE AND GROUP ID CHECKS, ENTER
C   THE LU NUMBER INTO THE NEXT WORD OF IBUFS AND INCREMENT KK. 
C   EVENTUALLY THE UPDATED LIST POINTER WILL POINT TO THE LINE LU, THEN 
C   A NORMAL EXIT IS TAKEN. 
C 
4     IBUFS(1) = INLU 
      IT11 = IE11 
      IDRT = IGET(1652B)
C 
C   DOES THIS LINE LU POINT TO A TERMINAL ? 
5     IF(IE11.NE.(IE11-10)) 51,900
C   YES, SO ADJUST IT4 TO POINT TO WORD 4 AND GET THE SYSTEM LU 
51    IT4 = IT11+3
C   FIRST PUT IT4 INTO THE B-REGISTER 
      CALL LDARG(IT4,ITT) 
C   GET SYSTEM LU OF THIS EQT.  IT4 AND A-REGISTER ARE INTEGER FORMAT 
C   ITT AND B-REGISTER ARE ASCII FORMAT.
C   VALIDATE LU AS BEING BETTER THAN THE BIT BUCKET 
      IF(IT4.NE.0) 52,900 
C   MAKE SURE WE'RE NOT DEALING WITH THE LINE LU AGAIN
52    IF(IT4.NE.INLU) 53,900
C   GET THE LINE ASSIGNMENT AND GROUP ID OF THIS EQT
53    CALL ILINA(IT4,ILNN,IT16,IT11)
C   TERMINAL DATA HERE.  COMPARE TERMINAL GROUP ID WITH SEARCH VALUE
      IDG = IOR(IAND(IT16,57400B),40B)
C   ARE THE GROUP ID THE SAME ? 
      IF(IGID.EQ.IDG) 54,55 
C   GROUP ID ARE THE SAME.  PUT TERMINAL LU INTO IBUFS
54    KK = KK+1 
      IBUFS(KK) = IT4 
C   ASSIGN ITID = TERMINAL ID THE FIRST TIME GROUP ID IS FOUND
      IF(ITMCT.EQ.0) 541,542
541   ITID = IT16 
542   ITMCT = ITMCT+1 
C   SEARCH NO MORE IF THE LINK POINTER IS THE LINE EQT. 
55    IF(IT11.NE.IE11) 51,900 
C   KK = THE NUMBER OF TERMINALS WITH THE SAME GROUP ID 
C   ITMCT = THE NUMBER OF TERMINALS WITH THE SAME GROUP ID AND
C           DEVICE ID.  IF THERE ARE ANY OF THESE, SEND A MESSAGE.
C 
900   IBUFS(2) = KK 
901   RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE ILINC(ILLU,INLU,ITID,IBUFS,
     +IDCT),91711-1X032  REV 1926  790906 
C     28.06.79
C     THIS SUBROUTINE USES THE WRU TERMINAL ID CHARACTER TO VERIFY THE
C     ACTIVE EQT ID LIST FOUND BY ILINB.
C     THE LINE LU IS USED TO LOCATE THE LINKED LIST. EACH TERMINAL IN 
C     THE LINKED LIST IS TESTED FOR GROUP MEMBERSHIP.  IDCT SHOWS HOW 
C     MANY TERMINALS ARE IN THE GROUP UNDER TEST. 
C 
C     ILLU = LIST LU
C     INLU = LINE LU USED IN ILINB. 
C     ITID = TERMINAL ID: GROUP ID-DEVICE ID
C     IBUFS = IBUFS(1) IS LINE LU NUMBER, IBUFS(2) IS IBUFL.  THE 
C             TERMINAL LU NUMBERS IN GROUP ITID FOLLOW. 
C             THE NUMBERS ARE SYSTEM LU NUMBERS IN INTEGER FORMAT 
C     IBUFL = NUMBER OF TERMINAL LU IN IBUFS, ONE WORD PER TERMINAL, PLUS 
C             THE LINE LU AT THE HEAD OF THE LIST.
C           = 0  LINE NOT PRESENT IN INLU EQT 
C           = 1  LINE IS INITIALIZED WITH NO ASSIGNED TERMINALS.
C           > 1  LINE IS INITIALIZED WITH (IBUFL-1) ASSIGNED TERMINALS. 
C 
C     IDCT  = COMPLETION CODE 
C           = 0  NO MATCH FOUND IN EQT ID LIST
C           = 1  ONE MATCH FOUND IN EQT ID LIST 
C           > 1  NUMBER OF DUPLICATE EQT ID FOUND 
C 
C 
      DIMENSION IBUFS(28) 
      IDDD = 11 
      IDCT = 0
      IF(IBUFS(1).EQ.0) GO TO 900 
      IF(IBUFS(2)) 900,4
4     DO 60 J=3,IBUFS(2)
C   GET THE LINE WORD 11 AND WORD 16
      CALL ILINA(IBUFS(J),ILNN,IT16,IT11) 
C   GET THE ID OF EACH TERMINAL IN IBUFS AND COMPARE WITH ITID.  FOR
C   EACH LU WITH A MATCHING ITID, INCREMENT IDCT. 
100   IF(ITID.EQ.IT16) 54,60
54    IDCT = IDCT+1 
60    CONTINUE
900   RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE ILIND(ILLU,IGRUP,IBUFS,IBUFV,IDCT,IBXLU, 
     +IARAY,IHHH),91711-1X032  REV 1926  790906 
C     17.07.79
C     THIS SUBROUTINE VERIFIES THE WRU ID LIST IS FOUND IN THE
C     EQT.  THE EQT ID LIST FROM ILINB IS USED HERE.
C 
C     ILLU  = LIST LU 
C     IGRUP = WRU LIST OF TERMINAL ID IN THE GROUP UNDER TEST 
C     INAT  = THE NUMBER OF REPLYS TO THE WRU ON THIS GROUP 
C     IBUFS = THE FIRST ENTRY IS THE LINE LU FOLLOWED BY IBSL, THEN A 
C             LIST OF TERMINAL LU NUMBERS.  THE NUMBERS ARE SYSTEM LU 
C             NUMBERS IN INTEGER FORMAT.
C     IBSL = NUMBER OF LU NUMBERS IN IBUFS TO VERIFY = IBUFS(1) 
C           = 0  LINE NOT PRESENT IN INLU EQT 
C           = 1  LINE IS INITIALIZED WITH NO ASSIGNED TERMINALS.
C           > 1  LINE IS INITIALIZED WITH (IBSL-1) ASSIGNED TERMINALS.
C     IBUFV = IF NONZERO, CONTAINS 3-WORD ENTRY PER FAILURE: IDCT, ID, LU 
C     IBVL  = TOTAL NUMBER OF LU WHICH FAILED WRU VERIFY = IBUFV(1) 
C           = 0  ALL IS WELL, NO LU VERIFY FAILURES 
C           > 0  VERIFY FAILURES
C           = -1 TEST ABORTED.  NO TERMINAL LU IN IBUFS.
C 
C 
      DIMENSION IBUFS(28),IGRUP(30),IBUFV(60),IARAY(3),IBXLU(60)
C 
C  INITIALIZE VARIABLES AND BUFFERS 
C 
      IDVCT = 0 
      IDCT = -1 
      CALL SFILL(IBUFV,1,120,0B)
      CALL SFILL(IBXLU,1,120,0B)
      IBUFV(1) = -1 
      IBXLU(1) = -1 
C 
C 
C 
C 
C 
C 
C 
      DO 60 J = 1,IBUFS(2)
      IF(J.EQ.2) J = J+1
      IAAA = 11 
      IFFF = 0
      IDCT = -1 
C   J = 1, GET THE LINE WORD 11 AND WORD 16 
C   J > 2, TERMINAL ID
      CALL ILINA(IBUFS(J),ILNN,IT16,IT11) 
      IF(J.NE.1) GO TO 100
C 
C  THE FIRST ITERATION SHOWS A MESSAGE HEADER.
C 
      WRITE(ILLU,110)IARAY
      GO TO 20
C 
C 
C 
C 
C   GET THE ID OF EACH TERMINAL IN IBUFS AND SEARCH THE IGRUP LIST. 
C   FOR EACH ID (VIA ILINA) COUNT THE NUMBER OF MATCHES FOUND.  IF ONE
C   MATCH IS FOUND, VERIFY IS GOOD, NO ACTION IS NECESSARY.  OTHERWISE
C   SAVE IDCT, ID, AND LU NUMBER, THEN INCREMENT IERCT. 
C 
100   DO 30 K=2,IGRUP(1)
C 
C  COMPARE COMPARE EACH ID FROM THE EQT STRUCTURE WITH THE ID FROM
C  THE POLL ON THE LINE.  COUNT THE NUMBER OF ID MATCHES FOUND AND
C  THE NUMBER OF TERMINAL LU PROCESSED. 
C 
      IF(IT16.NE.IGRUP(K)) GO TO 30 
      IDCT = IDCT+1 
      IDVCT = IDVCT+1 
30    CONTINUE
C 
C   IF IT16 IS NOT FOUND IN IGRUP THEN IDCT = -1, GO TO 31
C   IF DUPLICATE IT16 ARE FOUND IN IGRUP THEN IDCT > 0, GO TO 33
C   IF ONE MATCH IS FOUND IDCT = 0, GO TO 20
C 
      IF(IDCT) 31,20,33 
C 
C 
C 
31    IFFF = 1
C 
C   UPDATE IBUFV BY APPENDING IDCT, ITID, ITLU TO BUFFER IBUFV
C 
33    CALL IVBUF(IDCT,IT16,IBUFS(J),IBUFV)
C 
C   GET CONFIGURATION MESSAGE FOR LINE AND CLEAR TERMINALS
C 
20    CALL IMPXX(IBUFS(J),ILLU,IBUFS(1),IARAY,IFFF) 
C 
C   THE FIRST ITERATION IS THE LINE LU, GO TO 60
C 
      IF(J.EQ.1) GO TO 60 
C 
C 
C   IF ITLU HAS BEEN INITIALIZED IN ORDER TO DEMONSTRATE
C   SOMETHING HERE, SEND THE FOLLOWING MESSAGES.  OTHERWISE 
C   NO MESSAGES ARE SENT. 
C 
      IF(IHHH.EQ.5) GO TO 40
      IF(IHHH.EQ.-1) GO TO 40 
C 
C   IMPXX RETURNED A QUALIFICATION CODE, IFFF.  IFFF = -2 
C   SAYS ITLU IS UNAVAILABLE FOR ANY MESSAGE
C   IFFF = -3 SAYS THIS WAS A 264X TERMINAL.
C 
      IF(IFFF.EQ.-2) GO TO 22 
C 
C   *LN N TL MMAB   ONLN* 
C 
23    CALL IMSG3(ILLU,IBUFS(1),IBUFS(J),IT16,IARAY,5,IAAA)
C 
C   *LN N TL MMAB  VERIFY*
C 
      CALL IMSG3(ILLU,IBUFS(1),IBUFS(J),IT16,IARAY,4,IAAA)
C 
C 
C   IMPXX RETURNED A QUALIFICATION CODE, IFFF.
C   IFFF = -3, IT WAS OK TO SEND THE MESSAGE IF THIS TRML WAS 
C   JUST INITIALIZED (KEY = 0), BUT FLAG THIS LU AS UNAVAILABLE 
C   FOR FURTHER MESSAGES. 
C 
40    IF(IFFF.EQ.-3) GO TO 22 
      GO TO 60
C 
C 
C 
C 
C   UPDATE IBUFV FROM WHAT IMPXX TELLS US ABOUT ITLU. 
C 
22    CALL IVBUF(IDCT,IT16,IBUFS(J),IBXLU)
C 
C 
C 
60    CONTINUE
C 
C 
C 
C 
C 
      RETURN
110   FORMAT(/2X3A2"- *VERIFY* LU EQT  ID       MODEL K D LM RM INT PR")
      END 
C     END$
CFTN4,L 
      SUBROUTINE TB(ILU,INLU,ILLU,IARAY,
     +IBBB),91711-1X032  REV 1926  790906 
C     10.05.79
C     THIS SUBROUTINE SETS THE NAK, WACK COUNTS AND TERMINAL BLOCKING 
C     FACTOR FOR THE LINE 
C 
C     ILU  = CONSOLE LU 
C     ILLU = LIST LU
C     IBBB = MODE SELECTION 
C 
C     CALLS:
C 
      DIMENSION IREG(2),ICWORD(2),IARAY(3)
      EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) 
      DATA ICWORD/0,2200B/
100   CALL IMSG7(ILU,KTNC,IARAY,4,11) 
      IF(KTNC.GT.17B) 100,101 
101   CALL IMSG7(ILU,KRNC,IARAY,5,11) 
      IF(KRNC.GT.17B) 101,102 
102   CALL IMSG7(ILU,KWC,IARAY,6,11)
      IF(KWC.GT.37B) 102,103
103   CALL IMSG7(ILU,KTBF,IARAY,7,11) 
      IF(KTBF.GT.4) 103,200 
200   WRITE(ILLU,120)IARAY,KTNC,KRNC,KWC,KTBF 
      LRNC = KRNC*20B 
      LWC  = KWC*400B 
      LTBF = KTBF*20000B
      ICW = IOR(IOR(IOR(LRNC,KTNC),LWC),LTBF) 
      ICWORD(1) = IOR(100000B,INLU) 
      REG = XLUEX(3,ICWORD,ICW) 
120   FORMAT(2X3A2"- TNC:",I3,"  RNC:",I3,"  WC:",I3,"  TBF:",I3) 
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE EM(ILU,ITLU,ILLU,IARAY,
     +IBBB),91711-1X032  REV 1926  790906 
C     10.05.79
C     THIS SUBROUTINE SETS THE EDIT MODE AND POLLING GLOBALS
C 
C     ILU  = CONSOLE LU 
C     ITLU = LINE LU
C     ILLU = LIST LU
C     IBBB = MODE SELECTION 
C          = 0    OPERATOR ENTRY
C          = ICW  VERIFY
C 
C 
      DIMENSION IREG(2),ICWORD(2),IARAY(3)
      EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) 
      DATA ICWORD/0,2300B/
      IF(IBBB.NE.0) 10,100
10    ICW = IBBB
      GO TO 103 
100   WRITE(ILU,110)IARAY 
101   READ(ILU,*)KD,KR,KL,KC,KH,KX,KN,KS,KA 
102   WRITE(ILU,112)KD,KR,KL,KC,KH,KX,KN,KS,KA
      IF(KD.EQ.1) 121,122 
121   KD = 100000B
122   IF(KR.EQ.1) 123,124 
123   KR = 40000B 
124   IF(KL.EQ.1) 125,126 
125   KL = 20000B 
126   IF(KC.EQ.1) 127,128 
127   KC = 10000B 
128   IF(KH.EQ.1) 129,130 
129   KH = 4000B
130   IF(KX.EQ.1) 131,132 
131   KX = 2000B
132   IF(KN.EQ.1) 133,134 
133   KN = 1000B
134   IF(KS.EQ.1) 135,136 
135   KS = 400B 
136   IF(KA.NE.1) 137,138 
137   KA = 0
138   ICW = IOR(IOR(IOR(IOR(IOR(IOR(IOR(IOR(KD,KR),KL),KC),KH),KX),KN), 
     +KS),KA) 
103   ICWORD(1) = IOR(100000B,ITLU) 
      REG = XLUEX(3,ICWORD,ICW) 
110   FORMAT(2X3A2"- D R L C H X N S A",/,10X"_") 
112   FORMAT(10X9(I1X)) 
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE IWRXX(ILU,INLU,ILLU,ID,IARAY,IBUFX,
     +IOFLN,IEEE),91711-1X032  REV 1926  790906 
C   09.07.79
C 
C     THIS SUBROUTINE CALLS THE SUBROUTINES TO GENERATE OFF-LINE
C     TERMINAL ID FOR THE LINE UNDER TEST.
C 
C     IEEE = -1, CALLED BY VMPLN
C     IEEE = 1 , CALLED BY IOFLN
C 
C 
      DIMENSION IREG(2),IBUFR(128),IGRUP(30),ICWORD(2),IBUFS(28), 
     +IARAY(3),IBUFV(60),IOFLN(30),IBUFX(28)
      EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) 
      DATA ICWORD/0,0/,IREG/0,0/
C 
C 
C 
      INAT = 0
C 
C   INITIALIZE VARIABLES AND BUFFERS
C 
      CALL SFILL(IOFLN,1,60,0B) 
      CALL SFILL(IGRUP,1,60,0B) 
      CALL SFILL(IOFLN,1,60,0B) 
      IOFLN(1) = -1 
C 
      CALL SFILL(IBUFR,1,256,0B)
      IBUFL = 128 
C 
      KGID = IOR(IAND(ID,57400B),40B) 
C 
C   ALL TERMINALS THAT RESPOND TO THE POLL WILL HAVE THEIR ID IN
C   BUFFER IGRUP. 
C 
C 
      CALL IGRID(INLU,ID,IGRUP) 
C 
C   IF NO WRU RESPONSE FOR THIS GROUP, EXIT 
C 
      IF(IGRUP(1)) 900,20 
20    CALL SFILL(IBUFS,1,56,0B) 
      CALL SFILL(IBUFX,1,56,0B) 
C 
C 
C 
C 
C 
C 
C   USING THE LINKED EQT STRUCTURE FOR LINE LU = INLU, FIND ALL 
C   THE TERMINAL LU NUMBERS THAT ARE INITIALIZED TO TERMINALS IN
C   GROUP KGID. 
C 
      CALL ILINB(ILLU,INLU,KGID,IBUFS,INAT,ITMCT) 
C 
C   IF THERE ARE ANY OFF-LINE ID, SHOW THEM.
C   CHECK FOR UNIQUE ID AMONG THE GROUP KGID
C   AREAS VERIFIED ARE EQT LIST, WRU LIST, OFF LINE LIST
C 
      CALL ILINF(INLU,ILLU,IARAY,IGRUP,IBUFS,IOFLN,IBUFX,IDCT,IEEE) 
900   RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE IGRID(INLU,KGID, 
     +IGRUP),91711-1X032  REV 1926  790906
C   03.08.79
C 
C     WHO ARE YOU ON LINE LU = INLU, GROUP KGID.  ALL TERMINALS 
C     THAT REPLY HAVE THEIR ID PUT INTO BUFFER IGRUP. 
C 
      DIMENSION IREG(2),IBUFR(128),IGRUP(30),ICWORD(2)
      EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) 
      DATA ICWORD/0,0/,IREG/0,0/,INAT/0/
C 
C   INITIALIZE VARIABLES AND BUFFERS
C 
      KK = 1
C 
      CALL SFILL(IGRUP,1,60,000B) 
      IGRUP(1) = -1 
C 
      CALL SFILL(IBUFR,1,256,000B)
      IBUFL = 128 
C 
      ICWORD(1) = IOR(100000B,INLU) 
C   FORM THE GROUP POLL CHARACTER 
      ID = IOR(KGID,175B) 
C 
21    REG = XLUEX(1,ICWORD,IBUFR,IBUFL,ID)
      IBUFL = IB
C   NUMBER OF RESPONDING TERMINALS = INAT 
      INAT = IBUFL/3
C   IF IBUFL = 0 THERE IS NO RESPONSE FROM TERMINALS
      IF(IBUFL.EQ.0)  GO TO 900 
C 
C   PUT THE TERMINAL ID INTO IGRUP
C 
      IGRUP(1) = INAT+1 
      I = 1 
C 
C 
51    DO 52  NN = 2,IGRUP(1)
      IGRUP(NN) = IAND(IBUFR(I),077777B)
52    I = I+3 
C 
C 
C 
900   RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE ILINF(INLU,ILLU,IARAY,IGRUP,IBUFS,IOFLN, 
     +IBUFX,IDCT,IEEE),91711-1X032  REV 1926  790906
C   28.08.79
C 
C     IEEE = -1 CALLED BY IWRXX, VMPLN
C     IEEE =  1 CALLED BY IWRXX, IOFLN
C 
C 
C 
C     THIS SUBROUTINE OUTPUTS OFF-LINE TERMINAL ID FROM INPUT 
C     BUFFERS IGRUP, IBUFS, AND THE LINE LU.
C 
C     IGRUP WAS CREATED BY SUBROUTINE IGRID BY POLLING LINE LU = INLU 
C     WITH THE GROUP POLL CHARACTER UNDER TEST.  THEREFORE, BUFFER
C     IGRUP CONTAINS THOSE TERMINAL'S ID WHICH HAVE RESPONDED TO THE
C     GROUP POLL ON THE LINE UNDER TEST.
C 
C     IBUFS WAS CREATED BY SUBROUTINE ILINB BY FIRST KNOWING THE
C     LINE LU NUMBER, THEN FOLLOWING THE LINKED LIST STRUCTURE
C     FOR THE LINE.  FOR EACH TERMINAL EQT FOUND,  A SYSTEM SUBROUTINE
C     (TRMLU) RETURNED WITH THE LU NUMBER FOR THAT EQT, WHICH WAS 
C     PUT INTO IBUFS.  FOR THE CASE WHERE THE DRT ENTRY WAS ZERO IN 
C     THE EQT FIELD, THE LU IS INDETERMINATE AND TRMLU RETURNED WITH
C     ZERO, AND THERE WAS NO ENTRY MADE IN IBUFS. 
C 
C     HERE, THOSE TERMINALS RESPONDING TO THE GROUP POLL HAVE THEIR ID
C     EXAMINED FOR A SINGLE MATCH AMONG THE ID CONTAINED IN THE LINKED
C     EQT STRUCTURE FOR THE LINE UNDER TEST.  IF THERE IS A SINGLE
C     ID FOUND OR MULTIPLE ID ARE FOUND IN THE EQT STRUCTURE THAT ARE 
C     THE SAME, THE ID IS PASSED OVER AND THE NEXT ID IN IGRUP IS 
C     UNDER TEST.  IF THE ID UNDER TEST IS NOT FOUND IN THE EQT 
C     STRUCTURE, THAT ID IS PUT INTO BUFFER IOFLN.  FINALLY, ALL ID 
C     IN BUFFER IOFLN ARE OUTPUT. 
C 
C     NOTE THE PROCEDURE IS AN ITERATIVE OUTPUT OF OFF-LINE ID BY 
C     GROUP (THERE ARE 27 POSSIBLE GROUPS PER LINE).
C 
C 
C 
C 
C 
C 
      DIMENSION IBUFS(28),IBUFX(28),IGRUP(30),IOFLN(30),IARAY(3), 
     +IXEQT(30) 
C 
C   INITIALIZE VARIABLES
C 
      KK = 1
      LL = 1
C 
C   INITIALIZE BUFFERS IXEQT, IOFLN 
C 
      CALL SFILL(IXEQT,1,60,000B) 
      CALL SFILL(IOFLN,1,60,000B) 
      IOFLN(1) = -1 
      CALL SFILL(IBUFX,1,56,000B) 
C 
C 
C 
C 
C 
C   FOR EACH MEMBER OF IGRUP, CALL ILINC TO TEST FOR UNIQUENESS.
C   ILINC TESTS THE TRML ID FOR MEMBERSHIP AMONG ID FOUND IN EQT. 
C 
      DO 24 K=2,IGRUP(1)
555   CALL ILINC(ILLU,INLU,IGRUP(K),IBUFS,IDCT) 
C 
C   IDCT = 0, NO ID WAS FOUND IN EQT.  THIS TRML IS OFF LINE. 
C 
      IF(IDCT.EQ.0) 30,24 
C 
C   PUT THE OFF LINE ID INTO BUFFER IOFLN 
C 
30    KK = KK+1 
      IOFLN(KK) = IGRUP(K)
      IOFLN(1) = KK 
      GO TO 24
C 
C 
C 
C   IF IDCT = 1, GO TO 24  THIS IS THE EXPECTED CASE (SINGLE, DISTINCT) 
C   IF IDCT > 1, MORE THAN ONE EQT IS INITIALIZED TO THE SAME TRML. 
C                PUT THE ID INTO BUFFER IXEQT.
C 
40    IF(IDCT-2) 24,41
C   PUT ID INTO IXEQT.
41    LL = LL+1 
      IXEQT(LL) = IGRUP(K)
      IXEQT(1) = LL 
C 
C   PUT IXEQT INTO IBUFX.  CALL IXBUF TO TEST FOR SIMILAR ID AMONG
C   IXBUF.  THIS CAN HAPPEN IF THERE ARE SIMILAR ID AMONG IGRUP.
C 
      IF(IEEE) 42,24
42    CALL IMSG3(ILLU,IDCT,0,IGRUP(K),8,IARAY,11) 
C 
C 
24    CONTINUE
C 
C 
C 
C 
C 
C   CHECK FOR ANY OFF-LINE ID NOW.
C   GO TO 900 IF THERE ARE NO OFF-LINE ID.  IF THERE ARE OFF-LINE 
C   ID PRESENT, CHECK FOR NO DUPLICATE ID AMONG THE GROUP POLL LIST,
C   AND NO DUPLICATE ID AMONG THE EQT ID. 
C 
C 
C 
C 
C 
      IF(IOFLN(1)) 900,34 
C   IXBUF WILL FIND ANY DUPLICATE ID AMONG THE OFF-LINE ID AND
C   RETURN WITH BUFFER IBUFX CONTAINING ANY DUPLICATE OFF-LINE ID.
C   THE FIRST WORD OF IBUFX CONTAINS THE COMPLETION CODE. 
34    CALL IXBUF(IOFLN,IBUFX) 
C 
C   IF IBUFX(1) = -1, THERE WAS ONLY 1 OFF LINE ID. 
C 
      IF(IBUFX(1)) 26,31
C 
C   IF IBUFX(1) = 3,5,7,... THERE APPEARS TO BE SEVERAL SIMILAR ID
C   A BETTER ALOGORITHM CAN BE MADE BY SKIPPING ID ALREADY IN IBUFX.
C   HOWEVER, IF IBUFX(2) = 0, THEN NO SIMILAR ID WERE FOUND.
C 
31    IF(IBUFX(2).EQ.0) 26,32 
C 
C   TXTD1 * ab APPEARS OFF LINE nnn TIMES 
C 
32    NN = 2
      CALL IMSG3(ILLU,IBUFX(NN),0,IBUFX(NN+1),6,IARAY,11) 
      IF((NN+1).EQ.IBUFX(1)) 900,33 
33    NN = NN+2 
      GO TO 32
C 
C 
C 
C 
C 
C 
C 
C   SHOW THE OFF LINE ID
C 
26    DO 29 K = 2,IOFLN(1)
C   SHOW EITHER THE SURVEY OR VERIFY OFF-LINE MESSAGE 
      IF(IEEE) 27,28
C   OFF LINE FOR VERIFY MESSAGE 
27    CALL IMSG2(ILLU,0,IOFLN(K),4,IARAY,11)
      GO TO 29
C   OFF LINE FOR SURVEY MESSAGE 
28    CALL IMSG2(ILLU,0,IOFLN(K),9,IARAY,11)
29    CONTINUE
900   RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE IXBUF(IGRUP,IBUFX),91711-1X032  REV 1926  790906 
C     28.08.79
C 
C     CHECK IGRUP FOR DUPLICATE ID, PUT ANY DUPLICATE ID IN BUFFER
C     IBUFX.
C 
      DIMENSION  IGRUP(30),IBUFX(28)
      LL = 2
C   INITIALIZE IBUFX
      DO 5 K = 1,28 
5     IBUFX(K) = 0
      IBUFX(1) = -1 
C   DON'T FOOL WITH A SINGLE ID 
      IF(IGRUP(1).EQ.2) GO TO 606 
C 
      DO 606 K = 2,IGRUP(1)-1 
      IDNUM = 1 
      L = K+1 
C   COMPARE TWO ID.  IF THEY ARE THE SAME, SAVE IGRUP(K) AND THE RUNNING
C   TOTAL (IDNUM) . 
601   IF(IGRUP(K).EQ.IGRUP(L)) 602,603
602   IDNUM = IDNUM+1 
      IBUFX(LL) = IDNUM 
      IBUFX(LL + 1) = IGRUP(K)
603   IF(L.EQ.IGRUP(1)) 605,604 
604   L = L+1 
      GO TO 601 
C   ALL THE ID HAVE BEEN TESTED.  (A BETTER TEST CAN BE MADE) 
C ER
605   IBUFX(1) = LL + 1 
606   LL = LL + 2 
C     WRITE(1,110) IBUFX(1),IBUFX(2),IBUFX(3) 
110   FORMAT(2X"IXBUF BX1:",I2X"BX2:",I2X"BX3:",A2) 
      RETURN
      END 
C     END$
CFTN4,L 
      SUBROUTINE IVBUF(IDCT,ITID,ITLU,
     +IBUFV),91711-1X032  REV 1926  790906
C     28.08.79
C 
C   APPEND THE VALUES IDCT, ITID, ITLU TO BUFFER IBUFV, 
C   THEN RETURN.
C 
      DIMENSION IBUFV(60),IBVVV(60) 
C 
C   INITIALIZE IBVVV
C 
      CALL SFILL(IBVVV,1,120,0B)
C 
C   IS THIS THE FIRST TIME IBUFV IS ENTERED ? 
C 
      IF(IBUFV(1)) 15,6 
C 
C   NO... THERE ARE ENTRIES TO BE PRESERVED.
C 
6     KK = IBUFV(1) + 1 
      DO 10 K = 1,IBUFV(1)
10    IBVVV(K) = IBUFV(K) 
      GO TO 17
C 
C 
C 
C   YES.. START ENTERING DATA INTO THE SECOND WORD OF IBVVV 
C 
15    KK = 2
C 
C 
C 
C 
C   NEW DATA IS APPENDED TO EXISTING DATA 
C 
17    IBVVV(KK) = IDCT
      KK = KK + 1 
      IBVVV(KK) = ITID
      KK = KK + 1 
      IBVVV(KK) = ITLU
C   UPDATE THE BUFFER LENGTH
      IBVVV(1) = KK 
C 
C 
C 
C 
C   NOW CLEAR IBUFV TO 0
C 
      CALL SFILL(IBUFV,1,120,0B)
C 
C   COPY THE CURRENT DATA INTO IBUFV AND RETURN 
C 
      DO 30 K = 1,IBVVV(1)
30    IBUFV(K) = IBVVV(K) 
C 
C 
C 
C 
C 
40    RETURN
      END 
      END$
                                                                                                                                                                            