*DECK DMMCH SUBROUTINE DMMCH (TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, $ BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FTL, NOUT, MV, KPRINT) C***BEGIN PROLOGUE DMMCH C***SUBSIDIARY C***PURPOSE Check the results of the computational tests. C***LIBRARY SLATEC (BLAS) C***AUTHOR Dongarra, J. J., (ANL) C Duff, I., (AERE) C Du Croz, J., (NAG) C Hammarling, S., (NAG) C***DESCRIPTION C C Checks the results of the computational tests. C C Auxiliary routine for test program for Level 3 Blas. C***REFERENCES (NONE) C***ROUTINES CALLED (NONE) C***REVISION HISTORY (YYMMDD) C 890208 DATE WRITTEN C 910620 Modified to meet SLATEC code and prologue standards. (BKS) C***END PROLOGUE DMMCH C .. Parameters .. DOUBLE PRECISION ZERO, ONE PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) C .. Scalar Arguments .. LOGICAL FTL DOUBLE PRECISION ALPHA, BETA, EPS, ERR INTEGER KK, KPRINT, LDA, LDB, LDC, LDCC, M, N, NOUT LOGICAL MV CHARACTER*1 TRANSA, TRANSB C .. Array Arguments .. DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ), $ CC( LDCC, * ), CT( * ), G( * ) C .. Local Scalars .. DOUBLE PRECISION ERRI INTEGER I, J, K LOGICAL TRANA, TRANB C .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT C***FIRST EXECUTABLE STATEMENT DMMCH TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' C C Compute expected result, one column at a time, in CT using data C in A, B and C. C Compute gauges in G. C DO 120 J = 1, N C DO 10 I = 1, M CT( I ) = ZERO G( I ) = ZERO 10 CONTINUE IF( .NOT.TRANA.AND..NOT.TRANB )THEN DO 30 K = 1, KK DO 20 I = 1, M CT( I ) = CT( I ) + A( I, K )*B( K, J ) G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( K, J ) ) 20 CONTINUE 30 CONTINUE ELSE IF( TRANA.AND..NOT.TRANB )THEN DO 50 K = 1, KK DO 40 I = 1, M CT( I ) = CT( I ) + A( K, I )*B( K, J ) G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( K, J ) ) 40 CONTINUE 50 CONTINUE ELSE IF( .NOT.TRANA.AND.TRANB )THEN DO 70 K = 1, KK DO 60 I = 1, M CT( I ) = CT( I ) + A( I, K )*B( J, K ) G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( J, K ) ) 60 CONTINUE 70 CONTINUE ELSE IF( TRANA.AND.TRANB )THEN DO 90 K = 1, KK DO 80 I = 1, M CT( I ) = CT( I ) + A( K, I )*B( J, K ) G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( J, K ) ) 80 CONTINUE 90 CONTINUE END IF DO 100 I = 1, M CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) G( I ) = ABS( ALPHA )*G( I ) + ABS( BETA )*ABS( C( I, J ) ) 100 CONTINUE C C Compute the error ratio for this result. C ERR = ZERO DO 110 I = 1, M ERRI = ABS( CT( I ) - CC( I, J ) )/EPS IF( G( I ).NE.ZERO ) $ ERRI = ERRI/G( I ) ERR = MAX( ERR, ERRI ) IF( ERR*SQRT( EPS ).GE.ONE ) THEN FTL = .TRUE. IF (KPRINT .GE. 2) THEN WRITE( NOUT, FMT = 9999 ) DO 140 K = 1, M IF( MV )THEN WRITE( NOUT, FMT = 9998 )K, CT( K ), CC( K, J ) ELSE WRITE( NOUT, FMT = 9998 )K, CC( K, J ), CT( K ) END IF 140 CONTINUE ENDIF ENDIF 110 CONTINUE 120 CONTINUE RETURN C 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL', $ 'F ACCURATE *******', /' EXPECTED RESULT COMPU', $ 'TED RESULT' ) 9998 FORMAT( 1X, I7, 2G18.6 ) C C End of DMMCH. C END