Return to TYPST.f CVS log

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

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

1.1     ! root        1:       SUBROUTINE TYPST(ITYP, KK, KL)
        !             2:       INTEGER PSTMT, K(186), KI(30), STMT, CODE, KT(30)
        !             3:       LOGICAL ERR, SYSERR, ASSMT, ABORT
        !             4:       COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
        !             5:       COMMON /DETECT/ ERR, SYSERR, ABORT
        !             6:       COMMON /STS/ K, KI, KT
        !             7: C
        !             8: C*****STS
        !             9: C     K(*) (INT) ARRAY CONTAINS A TABLE OF INTERNAL CODES FOR EACH
        !            10: C     "KEYWORD" IN FORTRAN STMTS
        !            11: C     KI(*) (INT) ARRAY CONTAINING NUMBER OF CHARACTERS IN EACH
        !            12: C     KEYWORD IN K
        !            13: C     KT(*)  (INT) ARRAY CONTAINING CLASS OF EACH STMT IN K
        !            14: C     (SEE PU FOR FURTHER DOC OF IGP -CLASS)
        !            15: C     TEST IF ITS AN ASSIGNMENT; IF SO ITYP = 30
        !            16: C     ELSE SEARCH K ARRAY FOR STMT;  ITYP CONTAINS CODED
        !            17: C     TYPE OF STMT; KK CONTAINS GENERAL CLASS OF STMTS IT FALLS IN
        !            18: C     KL IS COUNT OF NUMBER OF LETTERS IN FIRST WORD OF STMT
        !            19: C
        !            20:       CALL TYPST2(ASSMT)
        !            21:       IF (ASSMT) GO TO 40
        !            22:       J = 1
        !            23:       CODE = 0
        !            24:    10 I = PSTMT
        !            25:       CODE = CODE + 1
        !            26:       L = J + KI(CODE) - 1
        !            27:       DO 20 LL=J,L
        !            28:         IF (STMT(I).NE.K(LL)) GO TO 30
        !            29:         I = I + 1
        !            30:    20 CONTINUE
        !            31:       ITYP = CODE
        !            32:       KK = KT(CODE)
        !            33:       KL = KI(CODE)
        !            34:       RETURN
        !            35:    30 J = L + 1
        !            36:       IF (CODE.LT.29) GO TO 10
        !            37:       ERR = .TRUE.
        !            38:       RETURN
        !            39:    40 ITYP = 30
        !            40:       KK = KT(30)
        !            41:       KL = 0
        !            42:       RETURN
        !            43:       END

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