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

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.