      SUBROUTINE CONSTR(MAINND)
      LOGICAL SYSERR, ERR, ABORT, INSYM, GREEN, INDIR
      LOGICAL OVER
C      NOTE SETNOD SETS ABORT FOR 2 P.U. WITH SAME NAME
C      CONSTR SETS ABORT IF IT FINDS NO SYMBOL TABLES FROM PASS1
C      ASLEV SETS ABORT IF IT FINDS RECURSION IN CALLING GRAPH
      INTEGER OUTUT2, OUTUT3, OUTUT4, SYMLEN
      INTEGER PNODE, PLAT, LS(2)
      COMMON /HEAD/ LNODE, PNODE, NODE(500)
      COMMON /SCR1/ LINODE, INODE(500)
      COMMON /PARAMS/ I1, I2, I3, SYMLEN, OUTUT2, OUTUT3, OUTUT4
      COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
      COMMON /DETECT/ ERR, SYSERR, ABORT
      DATA IBR /1/, JBR /4/
      DATA LS(1) /1H,/, LS(2) /1H /
C
C      CONSTR DIRECTS THE FIRST PORTION OF PASS2
C      CALLS SETNOD TO CONSTRUCT THE LAT NODES FOR EACH P.U..
C      CALLS SETEXT TO SETUP BASIC EXERNALS NODES
C      AS NEEDED.
C      CALLS SETREF TO MAKE CONNECTS BETWEEN THE NODES
C      CALLS INVOKE TO CALCULATE LEVELS AND ASSIMILATE
C      ALL PROC INFO NECESSARY
C     CALLS ERASE TO GET RID OF NON-REFERENCE LINKS IN
C     CALLING GRAPH
C      CALLS CHKALL TO DO FINAL CHECKS OF ALL REFS AND TO
C      WRITE ALL GOOD REFS OUT FOR FUTURE PROCESSING
C     FORMS SUPERROOT IN GRAPH
C      CALLS OUTPUT ROUTINES WHENEVER CAN, TO GIVE PARTIAL
C      LISTINGS OF CURRENT DATA STRUCTURE
C
C     USE INSYM TO POSSIBLY SKIP OVER BAD REFS WITH DUMMY SYM TBL
C     SETREF READS REFS FROM OUTUT3, WRITES ON OUTUT4
C     INVOKE READS FROM OUTUT4
C     CHKALL READS FROM OUTUT4, WRITES OUTUT3
C     UNSAFE READS FROM OUTUT3
C      INITIALIZE LEVEL ARRAY AND ISR
      ISR = 0
      DO 10 I=1,LNODE
        INODE(I) = 0
   10 CONTINUE
C     INITIALIZE LOGICAL FLAGS FOR DETECTION OF PRESENCE OF
C     EXTERNAL ENTITIES (GREEN) AND INDIRECT REFS(INDIR)
      GREEN = .FALSE.
      INDIR = .FALSE.
 20   IF(.NOT.INSYM(0,0)) GOTO 30
C
C      SUCCESSFULLY READ SYMBOL TABLE
C
      CALL SETNOD
      IF (SYSERR .OR. ABORT) GO TO 130
      GO TO 20
   30 REWIND OUTUT2
      IF (PNODE.EQ.1) GO TO 150
C      CHANGE LEVEL ON ASFS SO DONT PROCESS THEM
      L = PNODE - 1
      DO 40 I=1,L
        IF (NODE(I).LT.0) INODE(I) = -2
   40 CONTINUE
C
C      SETUP BASIC EXTERNAL DEFNS AS NEEDED
C
      CALL SETEXT
      IF (SYSERR) GO TO 130
C
C      READ IN SYMBOL TABLES
C      SETREF WILL READ IN REFS
C
 50   IF(.NOT.INSYM(OUTUT3, OUTUT4)) GOTO 60
      CALL SETREF ( GREEN, INDIR  )
      IF (SYSERR .OR. ABORT) GO TO 130
      GO TO 50
   60 REWIND OUTUT2
      REWIND OUTUT3
      WRITE (OUTUT4) IBR, JBR, IBR
      REWIND OUTUT4
      IF(.NOT.INDIR) GOTO 70
C
C       CALL LEVEL ALG
C
      CALL INVOKE
      IF (ABORT .OR. SYSERR) GO TO 130
      REWIND OUTUT2
      REWIND OUTUT4
C
C      CHECK AND EXPAND REFS AND SAVE ALL GOOD ONES FOR LATER
C
 70   IF(.NOT.INSYM(OUTUT4,OUTUT3)) GOTO 80
      CALL CHKALL
      IF (SYSERR) GO TO 130
      GO TO 70
   80 WRITE (OUTUT3) IBR, JBR, IBR
C
C      CONSTRUCT SUPEROOT IN LAT
C
      IF (PNODE+1.GT.LNODE) GO TO 180
      IF (PLAT+SYMLEN+7.GT.LLAT) GO TO 160
      NODE(PNODE) = PLAT
C      MAINND IS SUPEROOT INDEX IN NODE
C      ISR IS SUPEROOT INDEX IN LAT
      MAINND = PNODE
      ISR = PLAT
      PNODE = PNODE + 1
      LAT(PLAT) = LS(1)
      PLAT = PLAT + 1
      IF (SYMLEN.EQ.1) GO TO 100
      DO 90 I=2,SYMLEN
        L = PLAT + I - 2
        LAT(L) = LS(2)
   90 CONTINUE
      PLAT = L + 1
  100 L = PLAT + 5
      DO 110 I=PLAT,L
        LAT(I) = 0
  110 CONTINUE
      LAT(L+1) = 5
      PLAT = L + 2
C
C      LOOK FOR CALLABLE PGM UNITS WITHOUT PARENTS
C
      L = PNODE - 2
      DO 120 I=1,L
        K = SYMLEN + 3 + IABS(NODE(I))
        IF (LAT(K).EQ.0) CALL SETPD(IABS(NODE(I)), ISR)
        IF (SYSERR) GO TO 130
 120  CONTINUE
 130  IF(.NOT.GREEN) GOTO 190
C     ERASE GREEN LINKS
      L = PNODE - 2
      DO 210 I = 1,L
C     SKIP ASF NODES
      IF(NODE(I) .LT. 0) GOTO 210
C     FIND HEAD OF GREEN LINKS
      N = NODE(I) + SYMLEN + 3
 220  IF(LAT(N+1) .LE. 0) GOTO 230
      N = LAT(N+1)
      GOTO 220
 230  LAT(N+1) = 0
 210  CONTINUE
 190  OVER = SYSERR
      SYSERR = .FALSE.
      CALL OUT2 (ISR)
      SYSERR = SYSERR.OR.OVER
      IF(SYSERR) CALL ERROR1(
     *    56H ILLEGAL COMMON USAGE AND UNSAFE REFERENCES NOT VERIFIED,
     *    56)
      CALL OUT2C
  140 RETURN
  150 ABORT = .TRUE.
      GO TO 140
  160 CALL ERROR1(33H IN CONSTR, TABLE OVERFLOW OF LAT, 33)
  170 SYSERR = .TRUE.
      GO TO 130
  180 CALL ERROR1(34H IN CONSTR, TABLE OVERFLOW OF NODE, 34)
      GO TO 170
      END
