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

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.