1*DECK DMMCH
2      SUBROUTINE DMMCH (TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB,
3     $   BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FTL, NOUT, MV, KPRINT)
4C***BEGIN PROLOGUE  DMMCH
5C***SUBSIDIARY
6C***PURPOSE  Check the results of the computational tests.
7C***LIBRARY   SLATEC (BLAS)
8C***AUTHOR  Dongarra, J. J., (ANL)
9C           Duff, I., (AERE)
10C           Du Croz, J., (NAG)
11C           Hammarling, S., (NAG)
12C***DESCRIPTION
13C
14C  Checks the results of the computational tests.
15C
16C  Auxiliary routine for test program for Level 3 Blas.
17C***REFERENCES  (NONE)
18C***ROUTINES CALLED  (NONE)
19C***REVISION HISTORY  (YYMMDD)
20C   890208  DATE WRITTEN
21C   910620  Modified to meet SLATEC code and prologue standards.  (BKS)
22C***END PROLOGUE  DMMCH
23C     .. Parameters ..
24      DOUBLE PRECISION   ZERO, ONE
25      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
26C     .. Scalar Arguments ..
27      LOGICAL            FTL
28      DOUBLE PRECISION   ALPHA, BETA, EPS, ERR
29      INTEGER            KK, KPRINT, LDA, LDB, LDC, LDCC, M, N, NOUT
30      LOGICAL            MV
31      CHARACTER*1        TRANSA, TRANSB
32C     .. Array Arguments ..
33      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), C( LDC, * ),
34     $                   CC( LDCC, * ), CT( * ), G( * )
35C     .. Local Scalars ..
36      DOUBLE PRECISION   ERRI
37      INTEGER            I, J, K
38      LOGICAL            TRANA, TRANB
39C     .. Intrinsic Functions ..
40      INTRINSIC          ABS, MAX, SQRT
41C***FIRST EXECUTABLE STATEMENT  DMMCH
42      TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
43      TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
44C
45C     Compute expected result, one column at a time, in CT using data
46C     in A, B and C.
47C     Compute gauges in G.
48C
49      DO 120 J = 1, N
50C
51         DO 10 I = 1, M
52            CT( I ) = ZERO
53            G( I ) = ZERO
54   10    CONTINUE
55         IF( .NOT.TRANA.AND..NOT.TRANB )THEN
56            DO 30 K = 1, KK
57               DO 20 I = 1, M
58                  CT( I ) = CT( I ) + A( I, K )*B( K, J )
59                  G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( K, J ) )
60   20          CONTINUE
61   30       CONTINUE
62         ELSE IF( TRANA.AND..NOT.TRANB )THEN
63            DO 50 K = 1, KK
64               DO 40 I = 1, M
65                  CT( I ) = CT( I ) + A( K, I )*B( K, J )
66                  G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( K, J ) )
67   40          CONTINUE
68   50       CONTINUE
69         ELSE IF( .NOT.TRANA.AND.TRANB )THEN
70            DO 70 K = 1, KK
71               DO 60 I = 1, M
72                  CT( I ) = CT( I ) + A( I, K )*B( J, K )
73                  G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( J, K ) )
74   60          CONTINUE
75   70       CONTINUE
76         ELSE IF( TRANA.AND.TRANB )THEN
77            DO 90 K = 1, KK
78               DO 80 I = 1, M
79                  CT( I ) = CT( I ) + A( K, I )*B( J, K )
80                  G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( J, K ) )
81   80          CONTINUE
82   90       CONTINUE
83         END IF
84         DO 100 I = 1, M
85            CT( I ) = ALPHA*CT( I ) + BETA*C( I, J )
86            G( I ) = ABS( ALPHA )*G( I ) + ABS( BETA )*ABS( C( I, J ) )
87  100    CONTINUE
88C
89C        Compute the error ratio for this result.
90C
91         ERR = ZERO
92         DO 110 I = 1, M
93            ERRI = ABS( CT( I ) - CC( I, J ) )/EPS
94            IF( G( I ).NE.ZERO )
95     $         ERRI = ERRI/G( I )
96            ERR = MAX( ERR, ERRI )
97            IF( ERR*SQRT( EPS ).GE.ONE ) THEN
98            FTL = .TRUE.
99             IF (KPRINT .GE. 2) THEN
100             WRITE( NOUT, FMT = 9999 )
101             DO 140 K = 1, M
102                IF( MV )THEN
103                   WRITE( NOUT, FMT = 9998 )K, CT( K ), CC( K, J )
104                ELSE
105                   WRITE( NOUT, FMT = 9998 )K, CC( K, J ), CT( K )
106                END IF
107  140        CONTINUE
108             ENDIF
109           ENDIF
110  110    CONTINUE
111  120 CONTINUE
112      RETURN
113C
114 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
115     $      'F ACCURATE *******', /'           EXPECTED RESULT   COMPU',
116     $      'TED RESULT' )
117 9998 FORMAT( 1X, I7, 2G18.6 )
118C
119C     End of DMMCH.
120C
121      END
122