      SUBROUTINE PROC(IP, IM, IIM, OK)
C
C      P.U. AT LAT(IP) CALLS P.U. AT LAT(IM) (NODE(IIM))
C      PROC COLLECTS ACTUAL PROC TEMPLATE(S) FROM THE CALL IF IT CAN
C      CHECKS FOR MISSING SUBPGMS AND STORES TEMPLATES OFF PGM UNIT
C      AT LAT(IM), THEM PROC CALLS ASLEV TO READJUST LEVELS OF ACTUALS
C      SENT TO LAT(IM) VS LEVEL (IM)
C
      LOGICAL ERR, SYSERR, ABORT, OK
      INTEGER STACK, SYMLEN, PDSA, DSA, REF, PREF, PNODE, PLAT, FINDND,
     *    FIND, SS(120), KBR(1)
      COMMON /CEXPRS/ LSTACK, STACK(620)
      COMMON /PARAMS/ I1, I2, I3, SYMLEN, I4, I5, I6
      COMMON /CTABL/ LDSA, PDSA, DSA(5000)
      COMMON /CREF/ LREF, PREF, REF(100)
      COMMON /HEAD/ LNODE, PNODE, NODE(500)
      COMMON /SCR1/ LINODE, INODE(500)
      COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
      COMMON /DETECT/ ERR, SYSERR, ABORT
      EQUIVALENCE (SS(1),STACK(501))
      DATA KBR(1) /0/
      LSS = 501
C      ARE THERE ARGS IN THIS REF
      IF (REF(1).NE.0) GO TO 20
   10 RETURN
C      CYCLE THROUGH REF ARGS
C      JJ IS LAST ENTRY IN REF FOR ARGS
C      IS PTS TO FIRST FREE WD IN STACK
C      MAX IS 1 IF NO DUMMY PROCS IN REF, ELSE IS EQUAL TO THE
C      NUMBER OF ACTUAL PROCS SUBSTITUTABLE FOR THE DUMMY PROCS
   20 JJ = REF(1) + 4
      IS = 1
      MAX = 0
      DO 90 I=5,JJ,2
C      SKIP OVER EXPR AS ACTUAL ARGS AND ALL ACTUALS BUT PROC ARGS
        IF (REF(I).EQ.0) GO TO 90
        IF (REF(I+1).NE.6) GO TO 90
C      SEE IF ACTUAL ARG IS DUMMY PROC ARG AT LAT(IP)
C      OR ACTUAL PROCEDURE
        IF (IGATT1(REF(I),4).EQ.1) GO TO 40
C      HAVE AN ACTUAL PROCEDURE
        L = REF(I)
        L = FINDND(DSA(L+4),K)
        IF (L.NE.0) GO TO 30
C      IF, AS GATHERING ACTUAL PROCS MATCHED TO DUMMY PROC ARGS
C      PROC FINDS A MISSING SUBPROGM, PROCESSING OF THIS REF CEASES
      L = REF(I)
      CALL ERROR2(20H MISSING SUBPROGRAM , 20, DSA(L+4), 1, 1, 0)
      CALL ERROR2(1H1, 0, REF(3), -1, 0, 1)
        GO TO 10
   30   IF (IS+2.GT.LSS) GO TO 200
C      2 WD STACK ENTRY FOR AN ACTUAL PROC AS AN ACTUAL ARG
C      IS FIRST WD - 1, 2ND WD - LAT INDEX OF ACTUAL PROC
        STACK(IS) = 1
        STACK(IS+1) = L
        IF (MAX.EQ.0) MAX = 1
        IS = IS + 2
        GO TO 90
C      HAVE A DUMMY PROC CHECK OUT NO OF ACTUALS
C      MATCHED TO IT AND STACK THOSE WITH COUNTER ON TOP
   40   L = IP + SYMLEN + 5
        L = LAT(L)
        IF (L.NE.0) GO TO 50
      IF (.NOT.OK) GOTO 10
      CALL ERROR2(26H MISSING ACTUAL PROCEDURES ,26, KBR(1), -1,1,1)
      OK = .FALSE.
        GO TO 10
C      COLLECT ACTUALS CORRESPONDING TO THIS PROC ARG
C      K IS REL POSIT OF PROC ARG AMONG ALL ARGS AT LAT(IP)
C      L PTS TO TEMPLATE AT LAT(IP)
   50   K = REF(I)
        K = DSA(K+2)
C     J POINTS TO FIRST ELEMENT ON ARGLIST
        J = IP + SYMLEN + 1
        J = LAT(J)
        IF (K.LE.1) GO TO 70
        DO 60 LL=2,K
          J = LAT(J+3)
   60   CONTINUE
C      K IS REL POSIT OF PROC ARG AMONG PROC ARGS IN LAT(IP)
C      THAT IS IT IS OFFSET NECESS TO READ CORRESP ACTUAL
C      PROCS OFF TEMPLATES AT LAT(IP)
C     J POINTS TO DUMMY PROC ARG ENTRY IN LAT (IP)
   70   K = LAT(J+1)
        IF (IS+1.GE.LSS) GO TO 200
C      J POINTS TO POSITION IN STACK OF COUNT OF HOW MANY
C      ACTUALS ARE MATCHED TO THIS DUMMY
        J = IS
        STACK(IS) = 0
        IS = IS + 1
   80   IF (IS+1.GE.LSS) GO TO 200
C      N WD STACK ENTRY FOR DUMMY PROC ARGS USED AS ACTUAL ARGS IN REF
C      WD 1 CONTAINS NO OF ACTUAL PROCS MATCHED TO THE DUMMY
C      WDS 2 - N CONTAIN THE LAT INDICES OF EACH ACTUAL PROC
        STACK(J) = STACK(J) + 1
        LL = K + L
        STACK(IS) = LAT(LL)
        IS = IS + 1
        L = LAT(L) + L
        L = LAT(L)
        IF (L.NE.0) GO TO 80
        IF (STACK(J).GT.MAX) MAX = STACK(J)
   90 CONTINUE
C      HAVE COLLECTED ALL PROC ACTUALS CORRESP TO THE PROC
C      ARGS IN THE REF, NOTE MAX IS NO OF TEMPLATES RESULTING FROM
C      THIS REF TO BE PASSED TO LAT(IM) AS LONG AS THEIR DUPS
C      ARE NOT THERE ALREADY
C      BUILD EACH TEMPLATE IN LOOP AND CHECK FOR DUPLICATION
C      IF NOT THERE COPY INTO LAT OFF LAT(IM) AND CHECK LEVEL OF ACTUALS
C      PASSED DOWN VS LEVEL OF LAT(IM)
      IF (MAX.EQ.0) GO TO 10
      DO 190 I=1,MAX
C      CREATE PROC INDICES PORTION OF TEMPLATE IN SS
        K = 1
        ISS = 1
  100   IF (K.GE.IS) GO TO 110
        L = 1
        IF (STACK(K).GT.1) L = I
        IF (ISS+1.GE.120) GO TO 200
        J = K + L
        SS(ISS) = STACK(J)
        K = K + STACK(K) + 1
        ISS = ISS + 1
        GO TO 100
C      HAVE TEMPLATE IN SS(1) THROUGH SS(ISS-1)
C      SEE IF IT HAS A DUPLICATE AT LAT(IM)
  110   K = IM + SYMLEN + 5
        K = LAT(K)
        IST = ISS - 1
  120   IF (K.EQ.0) GO TO 150
        DO 130 L=1,IST
          J = K + L
          IF (LAT(J).NE.SS(L)) GO TO 140
  130   CONTINUE
C      FOUND DUPLICATE
        GO TO 190
C      HAVENT FOUND A DUPLICATE YET
C      SEE IF THERE ARE MORE TEMPLATES TO COMPARE
  140   K = LAT(K) + K
        K = LAT(K)
        GO TO 120
C      NOT A DUPLICATE WILL ADD IT ON
  150   IF (PLAT+IST+2.LE.LLAT) GO TO 160
        CALL ERROR1(32H IN PROC, TABLE OVERFLOW OF LAT , 32)
        SYSERR = .TRUE.
        GO TO 10
C      MAKE AN ENTRY CONSISTING OF 1ST WORD - NO OF PROCS+1, SUBSEQUENT
C      WORDS - PROCS LAT INDICES, LAST WORD - PTR
C      TO NEXT SUCH TEMPLATE
  160   DO 170 L=1,IST
          J = PLAT + L
          LAT(J) = SS(L)
  170   CONTINUE
        LAT(PLAT) = IST + 1
        L = PLAT
        PLAT = PLAT + IST + 2
        J = IM + SYMLEN + 5
        LAT(PLAT-1) = LAT(J)
        LAT(J) = L
C      CHECK LEVELS
        DO 180 L=1,IST
          J = FIND(SS(L))
C     FIND HEAD OF GREEN LINKS LIST AT LAT(IM)
      JR = IM + SYMLEN + 3
      JLR = -SS(L)
 210  IF(LAT(JR+1) .LE. 0) GOTO 220
      JR = LAT(JR+1)
      GOTO 210
C     HAVE TOP OF GREEN LINKS LIST AT LAT(JR)
 220  IF(LAT(JR+1) .EQ. 0) GOTO 230
      JR = IABS( LAT(JR+1) )
C     LOOK FOR DUPLICATE ENTRY ON GREEN LINKS LIST
      IF(LAT(JR) .EQ. JLR) GOTO 240
      GOTO 220
C     ADD ON ENTRY TO GREEN LINKS LIST
 230  IF(PLAT + 2 .GT. LLAT) GOTO 250
      LAT(PLAT) = JLR
      LAT(PLAT+1) = 0
      LAT(JR+1) = -PLAT
      PLAT = PLAT+2
 240  IF((-1).EQ.INODE(J) .OR. (-2).EQ.INODE(J) .OR.
     *  INODE(J).GT.INODE(IIM)) GOTO 180
          INODE(J) = INODE(IIM) + 1
      CALL ASLEV (-J)
          IF (SYSERR .OR. ABORT) GO TO 10
  180   CONTINUE
  190 CONTINUE
      GO TO 10
  200 SYSERR = .TRUE.
      CALL ERROR1(33H IN PROC, TABLE OVERFLOW OF STACK, 33)
      GO TO 10
 250  SYSERR = .TRUE.
      CALL ERROR1(31H IN PROC, TABLE OVERFLOW OF LAT,31)
      GOTO 10
      END
