dmvch()

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

Definition at line 2639 of file c_dblat2.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 ..
      DOUBLE PRECISION   ZERO, ONE
      parameter( zero = 0.0d0, one = 1.0d0 )
*     .. Scalar Arguments ..
      DOUBLE PRECISION   ALPHA, BETA, EPS, ERR
      INTEGER            INCX, INCY, M, N, NMAX, NOUT
      LOGICAL            FATAL, MV
      CHARACTER*1        TRANS
*     .. Array Arguments ..
      DOUBLE PRECISION   A( NMAX, * ), G( * ), X( * ), Y( * ), YT( * ),
     $                   YY( * )
*     .. Local Scalars ..
      DOUBLE PRECISION   ERRI
      INTEGER            I, INCXL, INCYL, IY, J, JX, KX, KY, ML, NL
      LOGICAL            TRAN
*     .. Intrinsic Functions ..
      INTRINSIC          abs, max, sqrt
*     .. Executable Statements ..
      tran = trans.EQ.'T'.OR.trans.EQ.'C'
      IF( tran )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 30 i = 1, ml
         yt( iy ) = zero
         g( iy ) = zero
         jx = kx
         IF( tran )THEN
            DO 10 j = 1, nl
               yt( iy ) = yt( iy ) + a( j, i )*x( jx )
               g( iy ) = g( iy ) + abs( a( j, i )*x( jx ) )
               jx = jx + incxl
   10       CONTINUE
         ELSE
            DO 20 j = 1, nl
               yt( iy ) = yt( iy ) + a( i, j )*x( jx )
               g( iy ) = g( iy ) + abs( a( i, j )*x( jx ) )
               jx = jx + incxl
   20       CONTINUE
         END IF
         yt( iy ) = alpha*yt( iy ) + beta*y( iy )
         g( iy ) = abs( alpha )*g( iy ) + abs( beta*y( iy ) )
         iy = iy + incyl
   30 CONTINUE
*
*     Compute the error ratio for this result.
*
      err = zero
      DO 40 i = 1, ml
         erri = abs( yt( i ) - yy( 1 + ( i - 1 )*abs( incy ) ) )/eps
         IF( g( i ).NE.zero )
     $      erri = erri/g( i )
         err = max( err, erri )
         IF( err*sqrt( eps ).GE.one )
     $      GO TO 50
   40 CONTINUE
*     If the loop completes, all results are at least half accurate.
      GO TO 70
*
*     Report fatal error.
*
   50 fatal = .true.
      WRITE( nout, fmt = 9999 )
      DO 60 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
   60 CONTINUE
*
   70 CONTINUE
      RETURN
*
 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
     $      'F ACCURATE *******', /'           EXPECTED RESULT   COMPU',
     $      'TED RESULT' )
 9998 FORMAT( 1x, i7, 2g18.6 )
*
*     End of DMVCH.
*