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