Return to SUBS.f CVS log

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

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

1.1     ! root        1:       SUBROUTINE SUBS(K2, NO)
        !             2:       INTEGER STMT, PSTMT
        !             3:       LOGICAL ERR, SYSERR, ABORT, TOKPNO
        !             4:       COMMON /DETECT/ ERR, SYSERR, ABORT
        !             5:       COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
        !             6: C
        !             7: C     STMT(PSTMT)-STMT(K2-1) CONTAIN SUBSCRIPT CONSTRUCT
        !             8: C     NO IS NUMBER OF SUBSCRIPTS EXPECTED
        !             9: C     ROUTINE CHECKS SYNTAX AND NUMBER OF SUBSCRIPTS
        !            10: C     IF FLUSH OF CONSTRUCT IS NECESSARY, AND NSTMT IS REACHED
        !            11: C     ERR=.TRUE.
        !            12: C
        !            13:       ICNT = 0
        !            14:    10 CALL NEXTOK(PSTMT, K2, K)
        !            15:       IF (K.EQ.0) GO TO 70
        !            16:       IF (TOKPNO(PSTMT,K2,LL)) GO TO 60
        !            17:    20 CALL ERROR1(28H ILLEGAL SYNTAX OF SUBSCRIPT, 28)
        !            18: C
        !            19: C     FLUSH TO END OF SUBSCRIPT CONSTRUCTION
        !            20: C
        !            21:    30 IF (STMT(K2).EQ.62) GO TO 40
        !            22:       K2 = K2 + 1
        !            23:       IF (K2.LT.NSTMT) GO TO 30
        !            24:       ERR = .TRUE.
        !            25:       GO TO 50
        !            26:    40 K2 = K2 + 1
        !            27:    50 RETURN
        !            28:    60 IF (STMT(K2).NE.66) GO TO 130
        !            29:       PSTMT = K2 + 1
        !            30:       IF (PSTMT.GE.NSTMT) GO TO 20
        !            31:       CALL NEXTOK(PSTMT, K2, K)
        !            32:       IF (K.NE.0) GO TO 20
        !            33: C
        !            34: C     ACESS SYMBOL TABLE ENTRY FOR VARIABLE TO DETERMINE
        !            35: C     USAGE AND TYPE
        !            36: C
        !            37:    70 KQ = LOOKUP(K2,.FALSE.)
        !            38:       IF (SYSERR) GO TO 30
        !            39:       I1 = IGATT1(KQ,1)
        !            40:       I1 = MOD(I1,8)
        !            41:       I2 = IGATT1(KQ,7)
        !            42:       I3 = IGATT1(KQ,8)
        !            43:       IF (I3.EQ.0) GO TO 90
        !            44:       IF (I3.EQ.10) GO TO 100
        !            45:    80 CALL ERROR1(43H ILLEGAL VARIABLE IN SUBSCRIPT CONSTRUCTION, 43)
        !            46:       GO TO 120
        !            47:    90 CALL SATT1(KQ, 8, 10)
        !            48: C
        !            49: C     IMPLICITLY TYPE VARIABLES FIRST ENCOUNTERED IN SUBSCRIPT
        !            50: C     CONSTRUCT
        !            51: C
        !            52:   100 IF (I1.GT.0) GO TO 110
        !            53:       I1 = 1
        !            54:       IF (STMT(PSTMT).GE.38 .AND. STMT(PSTMT).LE.43) I1 = 2
        !            55:       CALL SATT1(KQ, 1, I1)
        !            56:   110 IF (I2.NE.0 .OR. I1.NE.2) GO TO 80
        !            57:   120 IF (STMT(K2).NE.60 .AND. STMT(K2).NE.61) GO TO 130
        !            58:       CALL NEXTOK(K2+1, K3, K)
        !            59:       IF (K.NE.1) GO TO 20
        !            60:       K2 = K3
        !            61:   130 ICNT = ICNT + 1
        !            62:       IF (STMT(K2).EQ.68) GO TO 140
        !            63:       IF (STMT(K2).NE.62) GO TO 20
        !            64:       IF (NO.NE.ICNT) CALL ERROR1(34H INCOMPATIBLE NUMBER OF SUBSCRIPTS,
        !            65:      *    34)
        !            66:       IF (ICNT.GT.3) CALL ERROR1(20H TOO MANY SUBSCRIPTS, 20)
        !            67:       GO TO 40
        !            68:   140 PSTMT = K2 + 1
        !            69:       IF (PSTMT.GE.NSTMT) GO TO 20
        !            70:       GO TO 10
        !            71:       END

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