LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ dmmch()

subroutine dmmch ( character*1  TRANSA,
character*1  TRANSB,
integer  M,
integer  N,
integer  KK,
double precision  ALPHA,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( ldb, * )  B,
integer  LDB,
double precision  BETA,
double precision, dimension( ldc, * )  C,
integer  LDC,
double precision, dimension( * )  CT,
double precision, dimension( * )  G,
double precision, dimension( ldcc, * )  CC,
integer  LDCC,
double precision  EPS,
double precision  ERR,
logical  FATAL,
integer  NOUT,
logical  MV 
)

Definition at line 2505 of file dblat3.f.

2508 *
2509 * Checks the results of the computational tests.
2510 *
2511 * Auxiliary routine for test program for Level 3 Blas.
2512 *
2513 * -- Written on 8-February-1989.
2514 * Jack Dongarra, Argonne National Laboratory.
2515 * Iain Duff, AERE Harwell.
2516 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
2517 * Sven Hammarling, Numerical Algorithms Group Ltd.
2518 *
2519 * .. Parameters ..
2520  DOUBLE PRECISION ZERO, ONE
2521  parameter( zero = 0.0d0, one = 1.0d0 )
2522 * .. Scalar Arguments ..
2523  DOUBLE PRECISION ALPHA, BETA, EPS, ERR
2524  INTEGER KK, LDA, LDB, LDC, LDCC, M, N, NOUT
2525  LOGICAL FATAL, MV
2526  CHARACTER*1 TRANSA, TRANSB
2527 * .. Array Arguments ..
2528  DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ),
2529  $ CC( LDCC, * ), CT( * ), G( * )
2530 * .. Local Scalars ..
2531  DOUBLE PRECISION ERRI
2532  INTEGER I, J, K
2533  LOGICAL TRANA, TRANB
2534 * .. Intrinsic Functions ..
2535  INTRINSIC abs, max, sqrt
2536 * .. Executable Statements ..
2537  trana = transa.EQ.'T'.OR.transa.EQ.'C'
2538  tranb = transb.EQ.'T'.OR.transb.EQ.'C'
2539 *
2540 * Compute expected result, one column at a time, in CT using data
2541 * in A, B and C.
2542 * Compute gauges in G.
2543 *
2544  DO 120 j = 1, n
2545 *
2546  DO 10 i = 1, m
2547  ct( i ) = zero
2548  g( i ) = zero
2549  10 CONTINUE
2550  IF( .NOT.trana.AND..NOT.tranb )THEN
2551  DO 30 k = 1, kk
2552  DO 20 i = 1, m
2553  ct( i ) = ct( i ) + a( i, k )*b( k, j )
2554  g( i ) = g( i ) + abs( a( i, k ) )*abs( b( k, j ) )
2555  20 CONTINUE
2556  30 CONTINUE
2557  ELSE IF( trana.AND..NOT.tranb )THEN
2558  DO 50 k = 1, kk
2559  DO 40 i = 1, m
2560  ct( i ) = ct( i ) + a( k, i )*b( k, j )
2561  g( i ) = g( i ) + abs( a( k, i ) )*abs( b( k, j ) )
2562  40 CONTINUE
2563  50 CONTINUE
2564  ELSE IF( .NOT.trana.AND.tranb )THEN
2565  DO 70 k = 1, kk
2566  DO 60 i = 1, m
2567  ct( i ) = ct( i ) + a( i, k )*b( j, k )
2568  g( i ) = g( i ) + abs( a( i, k ) )*abs( b( j, k ) )
2569  60 CONTINUE
2570  70 CONTINUE
2571  ELSE IF( trana.AND.tranb )THEN
2572  DO 90 k = 1, kk
2573  DO 80 i = 1, m
2574  ct( i ) = ct( i ) + a( k, i )*b( j, k )
2575  g( i ) = g( i ) + abs( a( k, i ) )*abs( b( j, k ) )
2576  80 CONTINUE
2577  90 CONTINUE
2578  END IF
2579  DO 100 i = 1, m
2580  ct( i ) = alpha*ct( i ) + beta*c( i, j )
2581  g( i ) = abs( alpha )*g( i ) + abs( beta )*abs( c( i, j ) )
2582  100 CONTINUE
2583 *
2584 * Compute the error ratio for this result.
2585 *
2586  err = zero
2587  DO 110 i = 1, m
2588  erri = abs( ct( i ) - cc( i, j ) )/eps
2589  IF( g( i ).NE.zero )
2590  $ erri = erri/g( i )
2591  err = max( err, erri )
2592  IF( err*sqrt( eps ).GE.one )
2593  $ GO TO 130
2594  110 CONTINUE
2595 *
2596  120 CONTINUE
2597 *
2598 * If the loop completes, all results are at least half accurate.
2599  GO TO 150
2600 *
2601 * Report fatal error.
2602 *
2603  130 fatal = .true.
2604  WRITE( nout, fmt = 9999 )
2605  DO 140 i = 1, m
2606  IF( mv )THEN
2607  WRITE( nout, fmt = 9998 )i, ct( i ), cc( i, j )
2608  ELSE
2609  WRITE( nout, fmt = 9998 )i, cc( i, j ), ct( i )
2610  END IF
2611  140 CONTINUE
2612  IF( n.GT.1 )
2613  $ WRITE( nout, fmt = 9997 )j
2614 *
2615  150 CONTINUE
2616  RETURN
2617 *
2618  9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
2619  $ 'F ACCURATE *******', /' EXPECTED RESULT COMPU',
2620  $ 'TED RESULT' )
2621  9998 FORMAT( 1x, i7, 2g18.6 )
2622  9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', i3 )
2623 *
2624 * End of DMMCH
2625 *
Here is the caller graph for this function: