LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
 subroutine smvch ( character*1 TRANS, integer M, integer N, real ALPHA, real, dimension( nmax, * ) A, integer NMAX, real, dimension( * ) X, integer INCX, real BETA, real, dimension( * ) Y, integer INCY, real, dimension( * ) YT, real, dimension( * ) G, real, dimension( * ) YY, real EPS, real ERR, logical FATAL, integer NOUT, logical MV )

Definition at line 2641 of file c_sblat2.f.

2641 *
2642 * Checks the results of the computational tests.
2643 *
2644 * Auxiliary routine for test program for Level 2 Blas.
2645 *
2646 * -- Written on 10-August-1987.
2647 * Richard Hanson, Sandia National Labs.
2648 * Jeremy Du Croz, NAG Central Office.
2649 *
2650 * .. Parameters ..
2651  REAL zero, one
2652  parameter ( zero = 0.0, one = 1.0 )
2653 * .. Scalar Arguments ..
2654  REAL alpha, beta, eps, err
2655  INTEGER incx, incy, m, n, nmax, nout
2656  LOGICAL fatal, mv
2657  CHARACTER*1 trans
2658 * .. Array Arguments ..
2659  REAL a( nmax, * ), g( * ), x( * ), y( * ), yt( * ),
2660  \$ yy( * )
2661 * .. Local Scalars ..
2662  REAL erri
2663  INTEGER i, incxl, incyl, iy, j, jx, kx, ky, ml, nl
2664  LOGICAL tran
2665 * .. Intrinsic Functions ..
2666  INTRINSIC abs, max, sqrt
2667 * .. Executable Statements ..
2668  tran = trans.EQ.'T'.OR.trans.EQ.'C'
2669  IF( tran )THEN
2670  ml = n
2671  nl = m
2672  ELSE
2673  ml = m
2674  nl = n
2675  END IF
2676  IF( incx.LT.0 )THEN
2677  kx = nl
2678  incxl = -1
2679  ELSE
2680  kx = 1
2681  incxl = 1
2682  END IF
2683  IF( incy.LT.0 )THEN
2684  ky = ml
2685  incyl = -1
2686  ELSE
2687  ky = 1
2688  incyl = 1
2689  END IF
2690 *
2691 * Compute expected result in YT using data in A, X and Y.
2692 * Compute gauges in G.
2693 *
2694  iy = ky
2695  DO 30 i = 1, ml
2696  yt( iy ) = zero
2697  g( iy ) = zero
2698  jx = kx
2699  IF( tran )THEN
2700  DO 10 j = 1, nl
2701  yt( iy ) = yt( iy ) + a( j, i )*x( jx )
2702  g( iy ) = g( iy ) + abs( a( j, i )*x( jx ) )
2703  jx = jx + incxl
2704  10 CONTINUE
2705  ELSE
2706  DO 20 j = 1, nl
2707  yt( iy ) = yt( iy ) + a( i, j )*x( jx )
2708  g( iy ) = g( iy ) + abs( a( i, j )*x( jx ) )
2709  jx = jx + incxl
2710  20 CONTINUE
2711  END IF
2712  yt( iy ) = alpha*yt( iy ) + beta*y( iy )
2713  g( iy ) = abs( alpha )*g( iy ) + abs( beta*y( iy ) )
2714  iy = iy + incyl
2715  30 CONTINUE
2716 *
2717 * Compute the error ratio for this result.
2718 *
2719  err = zero
2720  DO 40 i = 1, ml
2721  erri = abs( yt( i ) - yy( 1 + ( i - 1 )*abs( incy ) ) )/eps
2722  IF( g( i ).NE.zero )
2723  \$ erri = erri/g( i )
2724  err = max( err, erri )
2725  IF( err*sqrt( eps ).GE.one )
2726  \$ GO TO 50
2727  40 CONTINUE
2728 * If the loop completes, all results are at least half accurate.
2729  GO TO 70
2730 *
2731 * Report fatal error.
2732 *
2733  50 fatal = .true.
2734  WRITE( nout, fmt = 9999 )
2735  DO 60 i = 1, ml
2736  IF( mv )THEN
2737  WRITE( nout, fmt = 9998 )i, yt( i ),
2738  \$ yy( 1 + ( i - 1 )*abs( incy ) )
2739  ELSE
2740  WRITE( nout, fmt = 9998 )i,
2741  \$ yy( 1 + ( i - 1 )*abs( incy ) ), yt(i)
2742  END IF
2743  60 CONTINUE
2744 *
2745  70 CONTINUE
2746  RETURN
2747 *
2748  9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
2749  \$ 'F ACCURATE *******', /' EXPECTED RESULT COMPU',
2750  \$ 'TED RESULT' )
2751  9998 FORMAT( 1x, i7, 2g18.6 )
2752 *
2753 * End of SMVCH.
2754 *