Annotation of researchv10no/cmd/pfort/ID.f, revision 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

unix.superglobalmegacorp.com

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