subroutine cmvch	(	character*1	TRANS,
		integer	M,
		integer	N,
		complex	ALPHA,
		complex, dimension( nmax, * )	A,
		integer	NMAX,
		complex, dimension( * )	X,
		integer	INCX,
		complex	BETA,
		complex, dimension( * )	Y,
		integer	INCY,
		complex, dimension( * )	YT,
		real, dimension( * )	G,
		complex, dimension( * )	YY,
		real	EPS,
		real	ERR,
		logical	FATAL,
		integer	NOUT,
		logical	MV
	)

Definition at line 2453 of file c_cblat2.f.

*
*  Checks the results of the computational tests.
*
*  Auxiliary routine for test program for Level 2 Blas.
*
*  -- Written on 10-August-1987.
*     Richard Hanson, Sandia National Labs.
*     Jeremy Du Croz, NAG Central Office.
*
*     .. Parameters ..
      COMPLEX            zero
      parameter                ( zero = ( 0.0, 0.0 ) )
      REAL               rzero, rone
      parameter                ( rzero = 0.0, rone = 1.0 )
*     .. Scalar Arguments ..
      COMPLEX            alpha, beta
      REAL               eps, err
      INTEGER            incx, incy, m, n, nmax, nout
      LOGICAL            fatal, mv
      CHARACTER*1        trans
*     .. Array Arguments ..
      COMPLEX            a( nmax, * ), x( * ), y( * ), yt( * ), yy( * )
      REAL               g( * )
*     .. Local Scalars ..
      COMPLEX            c
      REAL               erri
      INTEGER            i, incxl, incyl, iy, j, jx, kx, ky, ml, nl
      LOGICAL            ctran, tran
*     .. Intrinsic Functions ..
      INTRINSIC          abs, aimag, conjg, max, REAL, sqrt
*     .. Statement Functions ..
      REAL               abs1
*     .. Statement Function definitions ..
      abs1( c ) = abs( REAL( C ) ) + abs( aimag( c ) )
*     .. Executable Statements ..
      tran = trans.EQ.'T'
      ctran = trans.EQ.'C'
      IF( tran.OR.ctran )THEN
         ml = n
         nl = m
      ELSE
         ml = m
         nl = n
      END IF
      IF( incx.LT.0 )THEN
         kx = nl
         incxl = -1
      ELSE
         kx = 1
         incxl = 1
      END IF
      IF( incy.LT.0 )THEN
         ky = ml
         incyl = -1
      ELSE
         ky = 1
         incyl = 1
      END IF
*
*     Compute expected result in YT using data in A, X and Y.
*     Compute gauges in G.
*
      iy = ky
      DO 40 i = 1, ml
         yt( iy ) = zero
         g( iy ) = rzero
         jx = kx
         IF( tran )THEN
            DO 10 j = 1, nl
               yt( iy ) = yt( iy ) + a( j, i )*x( jx )
               g( iy ) = g( iy ) + abs1( a( j, i ) )*abs1( x( jx ) )
               jx = jx + incxl
   10       CONTINUE
         ELSE IF( ctran )THEN
            DO 20 j = 1, nl
               yt( iy ) = yt( iy ) + conjg( a( j, i ) )*x( jx )
               g( iy ) = g( iy ) + abs1( a( j, i ) )*abs1( x( jx ) )
               jx = jx + incxl
   20       CONTINUE
         ELSE
            DO 30 j = 1, nl
               yt( iy ) = yt( iy ) + a( i, j )*x( jx )
               g( iy ) = g( iy ) + abs1( a( i, j ) )*abs1( x( jx ) )
               jx = jx + incxl
   30       CONTINUE
         END IF
         yt( iy ) = alpha*yt( iy ) + beta*y( iy )
         g( iy ) = abs1( alpha )*g( iy ) + abs1( beta )*abs1( y( iy ) )
         iy = iy + incyl
   40 CONTINUE
*
*     Compute the error ratio for this result.
*
      err = zero
      DO 50 i = 1, ml
         erri = abs( yt( i ) - yy( 1 + ( i - 1 )*abs( incy ) ) )/eps
         IF( g( i ).NE.rzero )
     $      erri = erri/g( i )
         err = max( err, erri )
         IF( err*sqrt( eps ).GE.rone )
     $      GO TO 60
   50 CONTINUE
*     If the loop completes, all results are at least half accurate.
      GO TO 80
*
*     Report fatal error.
*
   60 fatal = .true.
      WRITE( nout, fmt = 9999 )
      DO 70 i = 1, ml
         IF( mv )THEN
            WRITE( nout, fmt = 9998 )i, yt( i ),
     $         yy( 1 + ( i - 1 )*abs( incy ) )
         ELSE
            WRITE( nout, fmt = 9998 )i,
     $         yy( 1 + ( i - 1 )*abs( incy ) ), yt( i )
         END IF
   70 CONTINUE
*
   80 CONTINUE
      RETURN
*
 9999 FORMAT(' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
     $     'F ACCURATE *******', /'                       EXPECTED RE',
     $     'SULT                    COMPUTED RESULT' )
 9998 FORMAT( 1x, i7, 2( '  (', g15.6, ',', g15.6, ')' ) )
*
*     End of CMVCH.
*