V10/cmd/pfort/SETASF.f

      SUBROUTINE SETASF(PP, K)
      INTEGER PP, SYMLEN, PLAT, PDSA, SETARG, PNODE, DSA
      LOGICAL ERR, SYSERR, ABORT
      COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
      COMMON /HEAD/ LNODE, PNODE, NODE(500)
      COMMON /CTABL/ LDSA, PDSA, DSA(5000)
      COMMON /PARAMS/ INUT, I1, NOCHAR, SYMLEN, I2, I3, I4
      COMMON /DETECT/ ERR, SYSERR, ABORT
C
C     SETUP ASF NODE;  IT HAS A NODE JUST LIKE A RTNE
C     EXCEPT ITS INDEX IN NODE IS NEGATIVE
C     PP-COM ADDRESS OF PARENT SUBPGM
C     K-DSA ADDRESS OF ASF ENTRY
C
      IF (PNODE+1.GT.LNODE) GO TO 40
      IF (PLAT+SYMLEN+11.GT.LLAT) GO TO 60
C
C     CREATE NEW NODE ENTRY
C
      NODE(PNODE) = -PLAT
      PNODE = PNODE + 1
C
C     ENTER NAME AND ZERO REST OF NODE
C
      DO 10 I=1,SYMLEN
        L = K + 3 + I
        LL = PLAT + I - 1
        LAT(LL) = DSA(L)
   10 CONTINUE
      DO 20 I=1,6
        L = LL + I
        LAT(L) = 0
   20 CONTINUE
C
C     SET LAST ELEMENT TO TYPE OF PGM UNIT
C     STORE IN SAME WORD ASF TYPE
C
      I = IGATT1(K,1)
      LAT(L+1) = 4 + 8*MOD(I,8)
C
C     SETUP PARENT'S LIST TO POINT TO PP IN ASF NODE
C
      L = PLAT + SYMLEN + 3
      LAT(L) = L + 4
      LAT(L+4) = PP
      LAT(L+5) = 0
      KQ = PLAT
      PLAT = L + 6
C
C     SETUP REFERENCE IN PP'S DESCENDENTS LIST
C
      II = PP + SYMLEN + 4
      LAT(PLAT) = KQ
      LAT(PLAT+1) = LAT(II)
      LAT(II) = PLAT
      PLAT = PLAT + 2
C
C     SETUP ARGUMENTS
C
      L = KQ + SYMLEN
      LAT(L) = SETARG(KQ,K)
   30 RETURN
   40 CALL ERROR1(34H IN SETASF, TABLE OVERFLOW OF NODE, 34)
   50 SYSERR = .TRUE.
      GO TO 30
   60 CALL ERROR1(33H IN SETASF, TABLE OVERFLOW OF LAT, 33)
      GO TO 50
      END