Return to CHK3.f CVS log

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

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

1.1     ! root        1:       SUBROUTINE CHK3(IDUM, IACT, IDUM8, IACT8, IE, R, NO)
        !             2: C
        !             3: C     CHECKS PROC ARGUMENTS FOR PROPER USAGE AND TYPE
        !             4: C     IDUM LAT INDEX DUMY PROC ARG
        !             5: C     IACT LAT INDEX ACTUAL PROC
        !             6: C     IDUM8 USAGE DUMMY FROM DSA ATTRIBUTES
        !             7: C     IACT8 USAGE ACTUAL FROM LAT ENTRY
        !             8: C     IE CALLED RTNE
        !             9: C     R STMT NO OF CALL
        !            10: C     NO CONTAINS THE NUMBER OF PARAMETER BEING CHECKED BY THIS CALL
        !            11: C
        !            12:       INTEGER PLAT, R(1), SYMLEN, NO(1)
        !            13:       COMMON /PARAMS/ I1, I2, I3, SYMLEN, I4, I5, I6
        !            14:       COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
        !            15: C     SEPARATE OUT EXTERNAL ENTITIES
        !            16:       IF (IDUM8.NE.13) GO TO 20
        !            17:       L = IGATT2(IDUM,1)/8
        !            18:       IF (L.NE.1) GO TO 50
        !            19: C     FURTHER CHECK THAT EPLICITLY TYPED EXTERNAL ENTITIES
        !            20: C     MATCH FCNS
        !            21:       IF (IACT8.NE.1 .AND. IACT8.NE.6) GO TO 30
        !            22: C     CHECK FCN HAS SAME TYPE ACROSS REF BNDRY
        !            23:    10 L = IACT + SYMLEN + 6
        !            24:       IF (MOD(IGATT2(IDUM,1),8).EQ.LAT(L)/8) GO TO 50
        !            25:       CALL ERROR2(40H INCONSISTENT FCN TYPES IN REFERENCE TO , 40,
        !            26:      *  LAT(IE), 1, 1, 0)
        !            27:       CALL ERROR2(1H1, 0, R(1), -1, 0, 1)
        !            28:       GO TO 50
        !            29: C     CHECK SUBROUTINES
        !            30:    20 IF (IDUM8.EQ.6 .AND. IACT8.EQ.0) GO TO 50
        !            31: C     CHECK OUT FCNS
        !            32:       IF (IDUM8.EQ.5 .AND. IACT8.EQ.1) GO TO 10
        !            33: C     SEPARATE OUT BASIC EXTERNALS BECAUSE THEY ARE CONSIDERED
        !            34: C     TYPED BY THE FORTRAN.
        !            35:       IF (IDUM8.EQ.5 .AND. IACT8.EQ.6) GO TO 40
        !            36:    30 CALL ERROR2(
        !            37:      *  50H INCOMPATIBLE PROCEDURE PARAMETER ASSOCIATED WITH ,50,
        !            38:      *  NO, -2, 1, 0)
        !            39:       CALL ERROR2(17H IN REFERENCE TO ,17, LAT(IE), 1, 0, 0)
        !            40:       CALL ERROR2(1H1, 0, R(1), -1, 0, 1)
        !            41:       GO TO 50
        !            42: C     CHECK BASIC EXTER HAS NOT BEEN EXPLICITLY TYPED
        !            43: C     OR ELSE IT HAS TO AGREE WITH THE ACTUAL TYPE
        !            44:    40 L = IACT + SYMLEN + 6
        !            45:       IF (LAT(L)/8.EQ.1) GO TO 10
        !            46:    50 RETURN
        !            47:       END

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