LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ smmch()

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

Definition at line 2511 of file sblat3.f.

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