V10/cmd/pfort/CHK3.f
SUBROUTINE CHK3(IDUM, IACT, IDUM8, IACT8, IE, R, NO)
C
C CHECKS PROC ARGUMENTS FOR PROPER USAGE AND TYPE
C IDUM LAT INDEX DUMY PROC ARG
C IACT LAT INDEX ACTUAL PROC
C IDUM8 USAGE DUMMY FROM DSA ATTRIBUTES
C IACT8 USAGE ACTUAL FROM LAT ENTRY
C IE CALLED RTNE
C R STMT NO OF CALL
C NO CONTAINS THE NUMBER OF PARAMETER BEING CHECKED BY THIS CALL
C
INTEGER PLAT, R(1), SYMLEN, NO(1)
COMMON /PARAMS/ I1, I2, I3, SYMLEN, I4, I5, I6
COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
C SEPARATE OUT EXTERNAL ENTITIES
IF (IDUM8.NE.13) GO TO 20
L = IGATT2(IDUM,1)/8
IF (L.NE.1) GO TO 50
C FURTHER CHECK THAT EPLICITLY TYPED EXTERNAL ENTITIES
C MATCH FCNS
IF (IACT8.NE.1 .AND. IACT8.NE.6) GO TO 30
C CHECK FCN HAS SAME TYPE ACROSS REF BNDRY
10 L = IACT + SYMLEN + 6
IF (MOD(IGATT2(IDUM,1),8).EQ.LAT(L)/8) GO TO 50
CALL ERROR2(40H INCONSISTENT FCN TYPES IN REFERENCE TO , 40,
* LAT(IE), 1, 1, 0)
CALL ERROR2(1H1, 0, R(1), -1, 0, 1)
GO TO 50
C CHECK SUBROUTINES
20 IF (IDUM8.EQ.6 .AND. IACT8.EQ.0) GO TO 50
C CHECK OUT FCNS
IF (IDUM8.EQ.5 .AND. IACT8.EQ.1) GO TO 10
C SEPARATE OUT BASIC EXTERNALS BECAUSE THEY ARE CONSIDERED
C TYPED BY THE FORTRAN.
IF (IDUM8.EQ.5 .AND. IACT8.EQ.6) GO TO 40
30 CALL ERROR2(
* 50H INCOMPATIBLE PROCEDURE PARAMETER ASSOCIATED WITH ,50,
* NO, -2, 1, 0)
CALL ERROR2(17H IN REFERENCE TO ,17, LAT(IE), 1, 0, 0)
CALL ERROR2(1H1, 0, R(1), -1, 0, 1)
GO TO 50
C CHECK BASIC EXTER HAS NOT BEEN EXPLICITLY TYPED
C OR ELSE IT HAS TO AGREE WITH THE ACTUAL TYPE
40 L = IACT + SYMLEN + 6
IF (LAT(L)/8.EQ.1) GO TO 10
50 RETURN
END