LAPACK  3.10.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 2906 of file cblat2.f.

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