|
|
1.1 ! root 1: SUBROUTINE ID(K2) ! 2: INTEGER STMT, PSTMT ! 3: LOGICAL ERR, SYSERR, ABORT, DOVAR ! 4: COMMON /DETECT/ ERR, SYSERR, ABORT ! 5: COMMON /INPUT/ NSTMT, PSTMT, STMT(1327) ! 6: COMMON /FACTS/ NAME, NOST, ITYP, IASF ! 7: C ! 8: C ROUTINE CHECKS IDENTIFIERS IN <LIST> FOR BEING ARRAY,ARRAY ELEMENT ! 9: C OR VARIABLE.- RETURNS ERR=.TRUE. IF MUST CEASE PROCESSING ! 10: C FIRST CHECK USAGE ! 11: C ! 12: K = LOOKUP(K2,.FALSE.) ! 13: IF (SYSERR) GO TO 50 ! 14: C ! 15: C CHECK USAGE ! 16: C ! 17: I3 = IGATT1(K,8) ! 18: IF (I3.NE.0) GO TO 10 ! 19: CALL SATT1(K, 8, 10) ! 20: GO TO 20 ! 21: 10 IF (I3.NE.10) CALL ERROR1(27H ILLEGAL IDENTIFIER IN LIST, 27) ! 22: C ! 23: C SET TYPE ! 24: C ! 25: 20 I3 = IGATT1(K,1) ! 26: IF (I3.NE.0) GO TO 30 ! 27: I3 = 1 ! 28: IF (STMT(PSTMT).LE.43 .AND. STMT(PSTMT).GE.38) I3 = 2 ! 29: CALL SATT1(K, 1, I3) ! 30: C ! 31: C CHECK FOR READING INTO DO CONTROL VARIABLE OR LIMIT ! 32: C ! 33: 30 IF (ITYP.NE.23) GO TO 40 ! 34: IF (DOVAR(K)) CALL ERROR1( ! 35: * 57H ILLEGAL TO CHANGE VALUE OF CONTROL VARIABLE OR DO LIMITS, ! 36: * 57) ! 37: C ! 38: C MARK VARIABLES AS SET IF VALUES READ IN ! 39: C ! 40: CALL SATT1(K, 5, 1) ! 41: C ! 42: C SEPARATE OUT ARRAY ELEMENTS AND CHECK SUBSCRIPTS ! 43: C ! 44: 40 IF (STMT(K2).NE.65) GO TO 50 ! 45: I3 = IGATT1(K,7) ! 46: IF (I3.EQ.0) GO TO 60 ! 47: PSTMT = K2 + 1 ! 48: IF (PSTMT.GE.NSTMT) GO TO 80 ! 49: CALL SUBS(K2, I3) ! 50: ERR = .FALSE. ! 51: 50 RETURN ! 52: 60 CALL ERROR1(40H ILLEGAL SUBSCRIPTING OF SCALAR VARIABLE, 40) ! 53: 70 ERR = .TRUE. ! 54: GO TO 50 ! 55: 80 CALL ERROR1(19H SUBSCRIPTING ERROR, 19) ! 56: GO TO 70 ! 57: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.