      SUBROUTINE SETREF(GREEN,INDIR)
      INTEGER CHK1, KBR(1)
      INTEGER REF, PREF, PDSA, DSA, PLAT, PNODE, FINDND, SYMLEN
      LOGICAL ERR, SYSERR, ABORT, COMPAR, GREEN, INDIR
      COMMON /HEAD/ LNODE, PNODE, NODE(500)
      COMMON/ SCR1/ LINODE, INODE(500)
      COMMON /FACTS/ NAME, NOST, ITYP, IASF
      COMMON /CREF/ LREF, PREF, REF(100)
      COMMON /CTABL/ LDSA, PDSA, DSA(5000)
      COMMON /DETECT/ ERR, SYSERR, ABORT
      COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
      COMMON /PARAMS/ I1, I2, I3, SYMLEN, I4, I5, I6
      COMMON /TABL/ NEXT, LABHD, ISYM, IBNEXT
      DATA IBR /1/, JBR /3/, KBR(1) /0/
C
C     GREEN = T IF ENCOUNTER EXTERNAL ENTITIES AT ALL
C     INDIR = T IF ENCOUNTER ANY INDIRECT REFS
C      READS IN ALL REFS FOR A PROGRAM UNIT; FINDS MISSING
C      SUBPROGRAM REFS AND DISCARDS THEM; CHECKS ASF REFS AND
C      DISCARDS THEM; WRITES INDIRECT REFS OUT ON I6 WITHOUT
C      PROCESSING; DOES MINIMAL CHECKING OF DIRECT REFS
C      CREATING PAR/DESC LINKS AND WRITING GOOD
C      REFS OUT ON I6, AFTER DONE WITH REFS, SEARCHES
C      FOR EXTERNAL ENTITIES (USAGE 13) TO FIX UP LEVELS
C
      IJK = FINDND(DSA(NAME+4),IIJK)
C      READ IN A NEW REF; IF HIT END OF REFS RECORD
C      END OF REFS ON I6 AND RETURN
   10 IF (INREF(I5)) 20, 20, 80
C      WRITE END OF REFS
   20 WRITE (I6) IBR, JBR, IBR
C      CHECK FOR NON DUMMY EXTERNALS IN SYMBOL TABLE WHICH
C      C AUSE CHANGES IN LEVEL CALCS
      K = ISYM
   30 IF (K) 40, 40, 50
 150  SYSERR=.TRUE.
      CALL ERROR1(33H IN SETREF, TABLE OVERFLOW OF LAT,33)
   40 RETURN
   50 IF (IGATT1(K,8).NE.13 .OR. IGATT1(K,4).EQ.1) GO TO 70
      L = FINDND(DSA(K+4),IL)
      IF (L.NE.0) GO TO 60
      CALL ERROR2(18H MISSING EXTERNAL , 18, DSA(K+4), 1, 1, 0)
      CALL ERROR2(1H1,0,KBR(1),-1, 0, 1)
      GO TO 70
C     FOUND AN EXTERNAL ENTITY
 60   GREEN = .TRUE.
C     ENTER ONTO GREEN LINKS LIST AT NODE
      N = IJK + SYMLEN + 3
C     J IS HEAD OF GREEN LINKS LIST (SEE SETPD)
 160  IF(LAT(N+1).LE.0) GOTO 170
      N = LAT(N+1)
      GOTO 160
 170  J = N+1
      IF(PLAT+2.GT.LLAT) GOTO 150
      LAT(PLAT) = -L
      LAT(PLAT+1) = LAT(J)
      LAT(J) = -PLAT
      PLAT = PLAT+2
      IF(-2.EQ.INODE(IL).OR.INODE(IL).GT.INODE(IIJK)) GOTO 70
      INODE(IL) = INODE(IIJK) + 1
      CALL ASLEV(-IL)
      IF (ABORT .OR. SYSERR) GO TO 40
   70 K = DSA(K+3)
      GO TO 30
C
C      REF IS  WD1--NUMBER OF ARGS(2 WD ENTRIES)
C            WD2--PTR TO PGM UNIT CALLED IN DSA
C            WD3--STMT NO OF  CALL
C            WD4--CODE, 0 FOR SUBR REFS; 1 FOR FCN REFS
C             WD5+-ARG ENTRIES (WD1-SYMBOL TABLE INDEX OR 0
C                             WD2-TYPE/STRUCTURE INFO)
C
   80 IF (REF(4).LT.4) GO TO 100
C
C      ASF REFERENCE; CHECKED AND THEN DISCARDED
C
      K1 = PNODE - 1
      DO 90 I=1,K1
        IF (NODE(I).GE.0) GO TO 90
        IJR = IABS(NODE(I))
        L = IJR + SYMLEN + 3
        L = LAT(L)
        K = REF(2)
C
C      IF HAVE ASF REF, FIND ASF BY NAME AND PAR CHECKS
C
        IF (COMPAR(DSA(K+4),LAT(IJR)) .AND. LAT(L).EQ.IJK) GO TO 110
   90 CONTINUE
      L = REF(2) + 4
      CALL ERROR2(18H MISSING ASF DEFN , 18, DSA(L), 1, 1, 0)
      CALL ERROR2(1H1, 0, REF(3), -1, 0, 1)
      GO TO 10
C
C      WRITE INDIRECT REF OUT ON I6
C
  100 K2 = IGATT1(REF(2),4)
      IF(K2.EQ.0) GOTO 140
      INDIR = .TRUE.
      GOTO 130
C      CHECK FOR MISSING SUBPROGRAM
 140  K1 = REF(2)
      IJR = FINDND(DSA(K1+4),IIJR)
      IF (IJR.NE.0) GO TO 110
      CALL ERROR2(20H MISSING SUBPROGRAM , 20, DSA(K1+4), 1
     *  ,1, 0)
      CALL ERROR2(1H1, 0, REF(3), -1, 0, 1)
      GO TO 10
C      CHECK DIRECT REFS AND ASF REFS
C      1 MEANS OK 0 MEANS N.G.
  110 IF (CHK1(IJK,IJR)) 10, 10, 120
  120 IF (REF(4).EQ.4) GO TO 10
C      GOOD DIRECT REF; CREATE PAR/DES LINKS
      CALL SETPD(IJR, IJK)
      IF (SYSERR) GO TO 40
      IF (-2.EQ.INODE(IIJR) .OR. INODE(IIJR).GT.INODE(IIJK)) GO TO 130
C      FIX UP LEVELS
      INODE(IIJR) = INODE(IIJK) + 1
      CALL ASLEV(IIJR)
      IF (SYSERR .OR. ABORT) GO TO 40
  130 WRITE (I6) PREF, IBR, (REF(L),L=1,PREF)
      GO TO 10
      END
