V10/cmd/pfort/SUBS.f
SUBROUTINE SUBS(K2, NO)
INTEGER STMT, PSTMT
LOGICAL ERR, SYSERR, ABORT, TOKPNO
COMMON /DETECT/ ERR, SYSERR, ABORT
COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
C
C STMT(PSTMT)-STMT(K2-1) CONTAIN SUBSCRIPT CONSTRUCT
C NO IS NUMBER OF SUBSCRIPTS EXPECTED
C ROUTINE CHECKS SYNTAX AND NUMBER OF SUBSCRIPTS
C IF FLUSH OF CONSTRUCT IS NECESSARY, AND NSTMT IS REACHED
C ERR=.TRUE.
C
ICNT = 0
10 CALL NEXTOK(PSTMT, K2, K)
IF (K.EQ.0) GO TO 70
IF (TOKPNO(PSTMT,K2,LL)) GO TO 60
20 CALL ERROR1(28H ILLEGAL SYNTAX OF SUBSCRIPT, 28)
C
C FLUSH TO END OF SUBSCRIPT CONSTRUCTION
C
30 IF (STMT(K2).EQ.62) GO TO 40
K2 = K2 + 1
IF (K2.LT.NSTMT) GO TO 30
ERR = .TRUE.
GO TO 50
40 K2 = K2 + 1
50 RETURN
60 IF (STMT(K2).NE.66) GO TO 130
PSTMT = K2 + 1
IF (PSTMT.GE.NSTMT) GO TO 20
CALL NEXTOK(PSTMT, K2, K)
IF (K.NE.0) GO TO 20
C
C ACESS SYMBOL TABLE ENTRY FOR VARIABLE TO DETERMINE
C USAGE AND TYPE
C
70 KQ = LOOKUP(K2,.FALSE.)
IF (SYSERR) GO TO 30
I1 = IGATT1(KQ,1)
I1 = MOD(I1,8)
I2 = IGATT1(KQ,7)
I3 = IGATT1(KQ,8)
IF (I3.EQ.0) GO TO 90
IF (I3.EQ.10) GO TO 100
80 CALL ERROR1(43H ILLEGAL VARIABLE IN SUBSCRIPT CONSTRUCTION, 43)
GO TO 120
90 CALL SATT1(KQ, 8, 10)
C
C IMPLICITLY TYPE VARIABLES FIRST ENCOUNTERED IN SUBSCRIPT
C CONSTRUCT
C
100 IF (I1.GT.0) GO TO 110
I1 = 1
IF (STMT(PSTMT).GE.38 .AND. STMT(PSTMT).LE.43) I1 = 2
CALL SATT1(KQ, 1, I1)
110 IF (I2.NE.0 .OR. I1.NE.2) GO TO 80
120 IF (STMT(K2).NE.60 .AND. STMT(K2).NE.61) GO TO 130
CALL NEXTOK(K2+1, K3, K)
IF (K.NE.1) GO TO 20
K2 = K3
130 ICNT = ICNT + 1
IF (STMT(K2).EQ.68) GO TO 140
IF (STMT(K2).NE.62) GO TO 20
IF (NO.NE.ICNT) CALL ERROR1(34H INCOMPATIBLE NUMBER OF SUBSCRIPTS,
* 34)
IF (ICNT.GT.3) CALL ERROR1(20H TOO MANY SUBSCRIPTS, 20)
GO TO 40
140 PSTMT = K2 + 1
IF (PSTMT.GE.NSTMT) GO TO 20
GO TO 10
END