Return to ID.f CVS log

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

Annotation of researchv10no/cmd/pfort/ID.f, revision 1.1.1.1

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.