V10/cmd/pfort/SETARG.f

      INTEGER FUNCTION SETARG(PP, N)
      INTEGER PLAT, DSA, PP, SYMLEN, PDSA
      LOGICAL ERR, SYSERR, ABORT
      COMMON /CTABL/ LDSA, PDSA, DSA(5000)
      COMMON /DETECT/ ERR, SYSERR, ABORT
      COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
      COMMON /PARAMS/ INUT, I1, NOCHAR, SYMLEN, I2, I3, I4
C
C     SETS UP LIST OF ARGUMENTS , HANGING OFF NODE AT LAT(PP)
C     ARGES ARE KEPT IN ORDERED LINEAR LINKED LIST
C     ORDERING CORRESPONDS TO LEFT TO RIGHT APPEARENCE IN DEFN
C     N-SUBPRGM ENTRY IN DSA
C     PP- CURRENT RTNE NODE IN LAT
C     ARGUMENT NODE
C     WD 1      ATTRIBUTES
C     WD2       LENGTH WITH -1 FOR VARIABLEY DIMENSIONED ARRAYS
C     WD3       HEAD OF PARENT REFS LIST
C     WD4       HEAD OF DESCENDENTS REFS LIST
C     WD5       PTR TO NEXT ARG
C
C     FIND FIRST ARGUMENT & ZERO COUNT
C
      J = DSA(N+2)
      SETARG = 0
      IPROC = 0
C
C     FIND FIRST ENTRY ON DSA ARGLIST;
C     KK HEAD OF TO BE CREATED ARGLIST IN LAT
C
      I = DSA(J)
      KK = PP + SYMLEN + 1
C
C     SETUP STORAGE FOR ARG ENTRY
C
   10 IF (PLAT+4.GE.LLAT) GO TO 80
C
C     ENTER ATTRIBUTE WORD AND ZERO REST OF ENTRY
C
      LAT(PLAT) = DSA(I)
      LAT(KK) = PLAT
      KK = PLAT + 3
      DO 20 IA=1,3
        L = IA + PLAT
        LAT(L) = 0
   20 CONTINUE
      K = IGATT1(I,8)
      IF (K.NE.10) GO TO 50
C
C     GET STRUCTURE  OF ARG
C
      K = IGATT1(I,7)
      IF (K) 40, 40, 30
C
C     ARRAY
C
   30 K = DSA(I+2)
      LAT(PLAT+1) = DSA(K)
      GO TO 60
C
C     SCALAR
C
   40 LAT(PLAT+1) = 1
      GO TO 60
C     SET RELATIVE ORDER OF PROC ARGS IN ITS 2ND WORD
   50 IPROC = IPROC + 1
      LAT(PLAT+1) = IPROC
C
C     CHECK FOR MORE ARGS; ADVANCE  PLAT
C
   60 PLAT = PLAT + 4
      SETARG = SETARG + 1
      IF (DSA(J+1)) 90, 90, 70
   70 J = DSA(J+1)
      I = DSA(J)
      GO TO 10
   80 SYSERR = .TRUE.
      CALL ERROR1(33H IN SETARG, TABLE OVERFLOW OF LAT, 33)
   90 RETURN
      END