LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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: