LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ cmvch()

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 2911 of file cblat2.f.

2911 *
2912 * Checks the results of the computational tests.
2913 *
2914 * Auxiliary routine for test program for Level 2 Blas.
2915 *
2916 * -- Written on 10-August-1987.
2917 * Richard Hanson, Sandia National Labs.
2918 * Jeremy Du Croz, NAG Central Office.
2919 *
2920 * .. Parameters ..
2921  COMPLEX zero
2922  parameter( zero = ( 0.0, 0.0 ) )
2923  REAL rzero, rone
2924  parameter( rzero = 0.0, rone = 1.0 )
2925 * .. Scalar Arguments ..
2926  COMPLEX alpha, beta
2927  REAL eps, err
2928  INTEGER incx, incy, m, n, nmax, nout
2929  LOGICAL fatal, mv
2930  CHARACTER*1 trans
2931 * .. Array Arguments ..
2932  COMPLEX a( nmax, * ), x( * ), y( * ), yt( * ), yy( * )
2933  REAL g( * )
2934 * .. Local Scalars ..
2935  COMPLEX c
2936  REAL erri
2937  INTEGER i, incxl, incyl, iy, j, jx, kx, ky, ml, nl
2938  LOGICAL ctran, tran
2939 * .. Intrinsic Functions ..
2940  INTRINSIC abs, aimag, conjg, max, REAL, sqrt
2941 * .. Statement Functions ..
2942  REAL abs1
2943 * .. Statement Function definitions ..
2944  abs1( c ) = abs( REAL( C ) ) + abs( aimag( c ) )
2945 * .. Executable Statements ..
2946  tran = trans.EQ.'T'
2947  ctran = trans.EQ.'C'
2948  IF( tran.OR.ctran )THEN
2949  ml = n
2950  nl = m
2951  ELSE
2952  ml = m
2953  nl = n
2954  END IF
2955  IF( incx.LT.0 )THEN
2956  kx = nl
2957  incxl = -1
2958  ELSE
2959  kx = 1
2960  incxl = 1
2961  END IF
2962  IF( incy.LT.0 )THEN
2963  ky = ml
2964  incyl = -1
2965  ELSE
2966  ky = 1
2967  incyl = 1
2968  END IF
2969 *
2970 * Compute expected result in YT using data in A, X and Y.
2971 * Compute gauges in G.
2972 *
2973  iy = ky
2974  DO 40 i = 1, ml
2975  yt( iy ) = zero
2976  g( iy ) = rzero
2977  jx = kx
2978  IF( tran )THEN
2979  DO 10 j = 1, nl
2980  yt( iy ) = yt( iy ) + a( j, i )*x( jx )
2981  g( iy ) = g( iy ) + abs1( a( j, i ) )*abs1( x( jx ) )
2982  jx = jx + incxl
2983  10 CONTINUE
2984  ELSE IF( ctran )THEN
2985  DO 20 j = 1, nl
2986  yt( iy ) = yt( iy ) + conjg( a( j, i ) )*x( jx )
2987  g( iy ) = g( iy ) + abs1( a( j, i ) )*abs1( x( jx ) )
2988  jx = jx + incxl
2989  20 CONTINUE
2990  ELSE
2991  DO 30 j = 1, nl
2992  yt( iy ) = yt( iy ) + a( i, j )*x( jx )
2993  g( iy ) = g( iy ) + abs1( a( i, j ) )*abs1( x( jx ) )
2994  jx = jx + incxl
2995  30 CONTINUE
2996  END IF
2997  yt( iy ) = alpha*yt( iy ) + beta*y( iy )
2998  g( iy ) = abs1( alpha )*g( iy ) + abs1( beta )*abs1( y( iy ) )
2999  iy = iy + incyl
3000  40 CONTINUE
3001 *
3002 * Compute the error ratio for this result.
3003 *
3004  err = zero
3005  DO 50 i = 1, ml
3006  erri = abs( yt( i ) - yy( 1 + ( i - 1 )*abs( incy ) ) )/eps
3007  IF( g( i ).NE.rzero )
3008  $ erri = erri/g( i )
3009  err = max( err, erri )
3010  IF( err*sqrt( eps ).GE.rone )
3011  $ GO TO 60
3012  50 CONTINUE
3013 * If the loop completes, all results are at least half accurate.
3014  GO TO 80
3015 *
3016 * Report fatal error.
3017 *
3018  60 fatal = .true.
3019  WRITE( nout, fmt = 9999 )
3020  DO 70 i = 1, ml
3021  IF( mv )THEN
3022  WRITE( nout, fmt = 9998 )i, yt( i ),
3023  $ yy( 1 + ( i - 1 )*abs( incy ) )
3024  ELSE
3025  WRITE( nout, fmt = 9998 )i,
3026  $ yy( 1 + ( i - 1 )*abs( incy ) ), yt( i )
3027  END IF
3028  70 CONTINUE
3029 *
3030  80 CONTINUE
3031  RETURN
3032 *
3033  9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
3034  $ 'F ACCURATE *******', /' EXPECTED RE',
3035  $ 'SULT COMPUTED RESULT' )
3036  9998 FORMAT( 1x, i7, 2( ' (', g15.6, ',', g15.6, ')' ) )
3037 *
3038 * End of CMVCH.
3039 *
Here is the caller graph for this function: