zmvch()

subroutine zmvch	(	character*1	trans,
		integer	m,
		integer	n,
		complex*16	alpha,
		complex*16, dimension( nmax, * )	a,
		integer	nmax,
		complex*16, dimension( * )	x,
		integer	incx,
		complex*16	beta,
		complex*16, dimension( * )	y,
		integer	incy,
		complex*16, dimension( * )	yt,
		double precision, dimension( * )	g,
		complex*16, dimension( * )	yy,
		double precision	eps,
		double precision	err,
		logical	fatal,
		integer	nout,
		logical	mv
	)

Definition at line 2457 of file c_zblat2.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*16         ZERO
      parameter( zero = ( 0.0d0, 0.0d0 ) )
      DOUBLE PRECISION   RZERO, RONE
      parameter( rzero = 0.0d0, rone = 1.0d0 )
*     .. Scalar Arguments ..
      COMPLEX*16         ALPHA, BETA
      DOUBLE PRECISION   EPS, ERR
      INTEGER            INCX, INCY, M, N, NMAX, NOUT
      LOGICAL            FATAL, MV
      CHARACTER*1        TRANS
*     .. Array Arguments ..
      COMPLEX*16         A( NMAX, * ), X( * ), Y( * ), YT( * ), YY( * )
      DOUBLE PRECISION   G( * )
*     .. Local Scalars ..
      COMPLEX*16         C
      DOUBLE PRECISION   ERRI
      INTEGER            I, INCXL, INCYL, IY, J, JX, KX, KY, ML, NL
      LOGICAL            CTRAN, TRAN
*     .. Intrinsic Functions ..
      INTRINSIC          abs, dimag, dconjg, max, dble, sqrt
*     .. Statement Functions ..
      DOUBLE PRECISION   ABS1
*     .. Statement Function definitions ..
      abs1( c ) = abs( dble( c ) ) + abs( dimag( 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 ) + dconjg( 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 ZMVCH.
*