Return to COMCHK.f CVS log

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

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

1.1     ! root        1:       SUBROUTINE COMCHK(MAIN)
        !             2:       INTEGER TEMP(1), PLAT, STAR, PCOM, COM, PNODE, SYMLEN
        !             3:       INTEGER ZERO(1)
        !             4:       COMMON /COMS/ LCOM, PCOM, COM(300)
        !             5:       COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
        !             6:       COMMON /PARAMS/ I1, I2, I3, SYMLEN, I4, I5, I6
        !             7:       COMMON /HEAD/ LNODE, PNODE, NODE(500)
        !             8:       COMMON /SCR2/ LNN, NN(500)
        !             9:       DATA STAR /1H*/
        !            10:       DATA ZERO(1) /0/
        !            11: C
        !            12: C     ALGORITHM TO CHECK FOR LEGAL USE OF COMMON IN PGM UNITS
        !            13: C     NODE(MAIN) POINTS TO SUPEROOT ENTRY IN LAT
        !            14: C
        !            15:       IF (PCOM.LE.0) GO TO 130
        !            16:       LK = 1
        !            17:    10 IF (LK.GE.PCOM-1) GO TO 130
        !            18: C
        !            19: C     CHECK COMMON ISNT BLANK COMMON
        !            20: C
        !            21:       CALL S5UNPK(COM(LK), TEMP, 1)
        !            22:       IF (TEMP(1).EQ.STAR) GO TO 120
        !            23: C
        !            24: C     CHECK THAT COMMON BLOCK NOT IN BLOCK DATA PGM
        !            25: C     NEED NOT CHECK THE COMMON
        !            26: C
        !            27:       K = LK + SYMLEN + 1
        !            28:       IF (COM(K).EQ.1) GO TO 120
        !            29: C
        !            30: C     NEED ALGORITHM TO CHECK OUT THIS COMMON
        !            31: C
        !            32:       L = PNODE - 1
        !            33:       DO 20 K=1,L
        !            34:         NN(K) = 0
        !            35:         IF (NODE(K).LT.0) NN(K) = 1
        !            36:    20 CONTINUE
        !            37:       ICNT = 0
        !            38:       NN(MAIN) = 2
        !            39: C
        !            40: C     SEARCH FOR A 2 NODE
        !            41: C
        !            42:    30 L = PNODE - 1
        !            43:       DO 40 K=1,L
        !            44:         IF (NN(K).EQ.2) GO TO 50
        !            45:    40 CONTINUE
        !            46:       GO TO 120
        !            47: C
        !            48: C     FOUND A 2 NODE; CHANGE TO 1 TO SHOW HAVE VISITED IT;
        !            49: C     IF SUBPGM CONTAINS COMMON IN QUESTION INCREMENT COUNT;
        !            50: C     IF COUNT> 1 ERROR IN USAGE
        !            51: C     IF SUBPGM DOESN'T CONTAIN COMMON, MARK HIS DESC 2 IF THEY ARE 0.
        !            52: C
        !            53:    50 NN(K) = 1
        !            54:       LBR = NODE(K)
        !            55:       L = NODE(K) + SYMLEN + 2
        !            56:       L = LAT(L)
        !            57:    60 IF (L.EQ.0) GO TO 90
        !            58:       IF (LAT(L).NE.LK) GO TO 80
        !            59: C
        !            60: C     FOUND COMMON LK AT THIS NODE
        !            61: C     MARK NODE TO A 3
        !            62: C
        !            63:       NN(K) = 3
        !            64:       ICNT = ICNT + 1
        !            65:       IF (ICNT.LE.1) GO TO 30
        !            66:       CALL ERROR2(31H ILLEGAL USAGE OF COMMON BLOCK , 31, COM(LK),
        !            67:      *  1, 1, 0)
        !            68:       K = PNODE - 1
        !            69:       DO 70 I=1,K
        !            70:         L = NODE(I)
        !            71:         IF (NN(I).EQ.3) CALL ERROR2(19H WHICH APPEARED IN , 19, LAT(L),
        !            72:      *  1, 0, 0)
        !            73:    70 CONTINUE
        !            74:       CALL ERROR2( 1H1, 0, ZERO(1), -3, 0, 1)
        !            75:       GO TO 120
        !            76:    80 L = LAT(L+2)
        !            77:       GO TO 60
        !            78: C
        !            79: C     ARE DONE SEARCHING FOR COMMON LK AT THIS NODE
        !            80: C     ADD DESCENDENTS ONTO LIST TO BE VISITED
        !            81: C
        !            82:    90 L = NODE(K) + SYMLEN + 4
        !            83:       L = LAT(L)
        !            84:   100 IF (L.EQ.0) GO TO 30
        !            85:       K = PNODE - 1
        !            86: C
        !            87: C     FIND DESC OF NODE AND IF NOT VISITED SET TO 2
        !            88: C
        !            89:       DO 110 I=1,K
        !            90:         IF (NODE(I).NE.LAT(L)) GO TO 110
        !            91:         IF (NN(I).EQ.0) NN(I) = 2
        !            92:   110 CONTINUE
        !            93:       L = LAT(L+1)
        !            94:       GO TO 100
        !            95:   120 LK = LK + SYMLEN + 5
        !            96:       GO TO 10
        !            97:   130 RETURN
        !            98:       END

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