Return to TOKRL.f CVS log

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

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

1.1     ! root        1:       LOGICAL FUNCTION TOKRL(K1, K2, CODE)
        !             2:       INTEGER STMT, CODE, PSTMT
        !             3:       LOGICAL TOKLOP
        !             4:       COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
        !             5: C
        !             6: C     ROUTINE RETURNS TRUE IF FINDS A REAL CONSTANT IN
        !             7: C     STMT(K1)-STMT(K2-1) . ELSE IT RETURNS FALSE.
        !             8: C     BASIC CONSTRUCT IS: <INT> . <INT>
        !             9: C     <INT> .
        !            10: C     . <INT>
        !            11: C     EACH OF THESE MAY BE FOLLOWED BY <D,E> <+,-> <INT>
        !            12: C     ALSO LEGAL IS IN-CONST FOLLOWED BY EXPONENT CONSTRUCT
        !            13: C
        !            14:       TOKRL = .FALSE.
        !            15:       CALL NEXTOK(K1, K2, K)
        !            16:       IF (K.EQ.3 .AND. STMT(K1).EQ.64) GO TO 10
        !            17:       IF (K.EQ.1 .AND. STMT(K2).EQ.64) GO TO 40
        !            18: C     IF HAVE INT-CONST NEED EXPONENT FOR THIS TO BE A REAL-CONST
        !            19:       IF (K-1) 80, 50, 80
        !            20: C
        !            21: C     FIND BASIC REAL CONSTANT
        !            22: C
        !            23: C     (. INT-CONST) CONSTRUCT
        !            24:    10 CALL NEXTOK(K2, K3, K)
        !            25:       IF (K.NE.1) GO TO 80
        !            26:    20 K2 = K3
        !            27:    30 TOKRL = .TRUE.
        !            28:       CODE = 1
        !            29:       GO TO 50
        !            30: C     (INT-CONST .) CONSTRUCT; CHECK FOR (INT . INT )
        !            31:    40 K2 = K2 + 1
        !            32:       CALL NEXTOK(K2, K3, K)
        !            33:       IF (K.EQ.1) GO TO 20
        !            34:       IF (TOKLOP(K2-1,K4,K)) GO TO 80
        !            35:       GO TO 30
        !            36: C
        !            37: C     CHECK FOR EXPONENT
        !            38: C
        !            39:    50 IF (STMT(K2).NE.33) GO TO 60
        !            40:       CODE = 0
        !            41:       GO TO 70
        !            42:    60 IF (STMT(K2).NE.34) GO TO 80
        !            43:       CODE = 1
        !            44:    70 K3 = K2 + 1
        !            45:       IF (K3.EQ.NSTMT) GO TO 80
        !            46:       IF ((STMT(K3).EQ.60) .OR. (STMT(K3).EQ.61)) K3 = K3 + 1
        !            47:       CALL NEXTOK(K3, K4, K)
        !            48:       IF (K.NE.1) GO TO 80
        !            49:       K2 = K4
        !            50:       TOKRL = .TRUE.
        !            51:    80 RETURN
        !            52:       END

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