Return to SETARG.f CVS log

Up to [Research Unix] / researchv10no / cmd / pfort

Annotation of researchv10no/cmd/pfort/SETARG.f, revision 1.1

1.1     ! root        1:       INTEGER FUNCTION SETARG(PP, N)
        !             2:       INTEGER PLAT, DSA, PP, SYMLEN, PDSA
        !             3:       LOGICAL ERR, SYSERR, ABORT
        !             4:       COMMON /CTABL/ LDSA, PDSA, DSA(5000)
        !             5:       COMMON /DETECT/ ERR, SYSERR, ABORT
        !             6:       COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
        !             7:       COMMON /PARAMS/ INUT, I1, NOCHAR, SYMLEN, I2, I3, I4
        !             8: C
        !             9: C     SETS UP LIST OF ARGUMENTS , HANGING OFF NODE AT LAT(PP)
        !            10: C     ARGES ARE KEPT IN ORDERED LINEAR LINKED LIST
        !            11: C     ORDERING CORRESPONDS TO LEFT TO RIGHT APPEARENCE IN DEFN
        !            12: C     N-SUBPRGM ENTRY IN DSA
        !            13: C     PP- CURRENT RTNE NODE IN LAT
        !            14: C     ARGUMENT NODE
        !            15: C     WD 1      ATTRIBUTES
        !            16: C     WD2       LENGTH WITH -1 FOR VARIABLEY DIMENSIONED ARRAYS
        !            17: C     WD3       HEAD OF PARENT REFS LIST
        !            18: C     WD4       HEAD OF DESCENDENTS REFS LIST
        !            19: C     WD5       PTR TO NEXT ARG
        !            20: C
        !            21: C     FIND FIRST ARGUMENT & ZERO COUNT
        !            22: C
        !            23:       J = DSA(N+2)
        !            24:       SETARG = 0
        !            25:       IPROC = 0
        !            26: C
        !            27: C     FIND FIRST ENTRY ON DSA ARGLIST;
        !            28: C     KK HEAD OF TO BE CREATED ARGLIST IN LAT
        !            29: C
        !            30:       I = DSA(J)
        !            31:       KK = PP + SYMLEN + 1
        !            32: C
        !            33: C     SETUP STORAGE FOR ARG ENTRY
        !            34: C
        !            35:    10 IF (PLAT+4.GE.LLAT) GO TO 80
        !            36: C
        !            37: C     ENTER ATTRIBUTE WORD AND ZERO REST OF ENTRY
        !            38: C
        !            39:       LAT(PLAT) = DSA(I)
        !            40:       LAT(KK) = PLAT
        !            41:       KK = PLAT + 3
        !            42:       DO 20 IA=1,3
        !            43:         L = IA + PLAT
        !            44:         LAT(L) = 0
        !            45:    20 CONTINUE
        !            46:       K = IGATT1(I,8)
        !            47:       IF (K.NE.10) GO TO 50
        !            48: C
        !            49: C     GET STRUCTURE  OF ARG
        !            50: C
        !            51:       K = IGATT1(I,7)
        !            52:       IF (K) 40, 40, 30
        !            53: C
        !            54: C     ARRAY
        !            55: C
        !            56:    30 K = DSA(I+2)
        !            57:       LAT(PLAT+1) = DSA(K)
        !            58:       GO TO 60
        !            59: C
        !            60: C     SCALAR
        !            61: C
        !            62:    40 LAT(PLAT+1) = 1
        !            63:       GO TO 60
        !            64: C     SET RELATIVE ORDER OF PROC ARGS IN ITS 2ND WORD
        !            65:    50 IPROC = IPROC + 1
        !            66:       LAT(PLAT+1) = IPROC
        !            67: C
        !            68: C     CHECK FOR MORE ARGS; ADVANCE  PLAT
        !            69: C
        !            70:    60 PLAT = PLAT + 4
        !            71:       SETARG = SETARG + 1
        !            72:       IF (DSA(J+1)) 90, 90, 70
        !            73:    70 J = DSA(J+1)
        !            74:       I = DSA(J)
        !            75:       GO TO 10
        !            76:    80 SYSERR = .TRUE.
        !            77:       CALL ERROR1(33H IN SETARG, TABLE OVERFLOW OF LAT, 33)
        !            78:    90 RETURN
        !            79:       END

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.