LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ smmch()

subroutine smmch ( character*1  TRANSA,
character*1  TRANSB,
integer  M,
integer  N,
integer  KK,
real  ALPHA,
real, dimension( lda, * )  A,
integer  LDA,
real, dimension( ldb, * )  B,
integer  LDB,
real  BETA,
real, dimension( ldc, * )  C,
integer  LDC,
real, dimension( * )  CT,
real, dimension( * )  G,
real, dimension( ldcc, * )  CC,
integer  LDCC,
real  EPS,
real  ERR,
logical  FATAL,
integer  NOUT,
logical  MV 
)

Definition at line 2200 of file c_sblat3.f.

2203 *
2204 * Checks the results of the computational tests.
2205 *
2206 * Auxiliary routine for test program for Level 3 Blas.
2207 *
2208 * -- Written on 8-February-1989.
2209 * Jack Dongarra, Argonne National Laboratory.
2210 * Iain Duff, AERE Harwell.
2211 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
2212 * Sven Hammarling, Numerical Algorithms Group Ltd.
2213 *
2214 * .. Parameters ..
2215  REAL ZERO, ONE
2216  parameter( zero = 0.0, one = 1.0 )
2217 * .. Scalar Arguments ..
2218  REAL ALPHA, BETA, EPS, ERR
2219  INTEGER KK, LDA, LDB, LDC, LDCC, M, N, NOUT
2220  LOGICAL FATAL, MV
2221  CHARACTER*1 TRANSA, TRANSB
2222 * .. Array Arguments ..
2223  REAL A( LDA, * ), B( LDB, * ), C( LDC, * ),
2224  $ CC( LDCC, * ), CT( * ), G( * )
2225 * .. Local Scalars ..
2226  REAL ERRI
2227  INTEGER I, J, K
2228  LOGICAL TRANA, TRANB
2229 * .. Intrinsic Functions ..
2230  INTRINSIC abs, max, sqrt
2231 * .. Executable Statements ..
2232  trana = transa.EQ.'T'.OR.transa.EQ.'C'
2233  tranb = transb.EQ.'T'.OR.transb.EQ.'C'
2234 *
2235 * Compute expected result, one column at a time, in CT using data
2236 * in A, B and C.
2237 * Compute gauges in G.
2238 *
2239  DO 120 j = 1, n
2240 *
2241  DO 10 i = 1, m
2242  ct( i ) = zero
2243  g( i ) = zero
2244  10 CONTINUE
2245  IF( .NOT.trana.AND..NOT.tranb )THEN
2246  DO 30 k = 1, kk
2247  DO 20 i = 1, m
2248  ct( i ) = ct( i ) + a( i, k )*b( k, j )
2249  g( i ) = g( i ) + abs( a( i, k ) )*abs( b( k, j ) )
2250  20 CONTINUE
2251  30 CONTINUE
2252  ELSE IF( trana.AND..NOT.tranb )THEN
2253  DO 50 k = 1, kk
2254  DO 40 i = 1, m
2255  ct( i ) = ct( i ) + a( k, i )*b( k, j )
2256  g( i ) = g( i ) + abs( a( k, i ) )*abs( b( k, j ) )
2257  40 CONTINUE
2258  50 CONTINUE
2259  ELSE IF( .NOT.trana.AND.tranb )THEN
2260  DO 70 k = 1, kk
2261  DO 60 i = 1, m
2262  ct( i ) = ct( i ) + a( i, k )*b( j, k )
2263  g( i ) = g( i ) + abs( a( i, k ) )*abs( b( j, k ) )
2264  60 CONTINUE
2265  70 CONTINUE
2266  ELSE IF( trana.AND.tranb )THEN
2267  DO 90 k = 1, kk
2268  DO 80 i = 1, m
2269  ct( i ) = ct( i ) + a( k, i )*b( j, k )
2270  g( i ) = g( i ) + abs( a( k, i ) )*abs( b( j, k ) )
2271  80 CONTINUE
2272  90 CONTINUE
2273  END IF
2274  DO 100 i = 1, m
2275  ct( i ) = alpha*ct( i ) + beta*c( i, j )
2276  g( i ) = abs( alpha )*g( i ) + abs( beta )*abs( c( i, j ) )
2277  100 CONTINUE
2278 *
2279 * Compute the error ratio for this result.
2280 *
2281  err = zero
2282  DO 110 i = 1, m
2283  erri = abs( ct( i ) - cc( i, j ) )/eps
2284  IF( g( i ).NE.zero )
2285  $ erri = erri/g( i )
2286  err = max( err, erri )
2287  IF( err*sqrt( eps ).GE.one )
2288  $ GO TO 130
2289  110 CONTINUE
2290 *
2291  120 CONTINUE
2292 *
2293 * If the loop completes, all results are at least half accurate.
2294  GO TO 150
2295 *
2296 * Report fatal error.
2297 *
2298  130 fatal = .true.
2299  WRITE( nout, fmt = 9999 )
2300  DO 140 i = 1, m
2301  IF( mv )THEN
2302  WRITE( nout, fmt = 9998 )i, ct( i ), cc( i, j )
2303  ELSE
2304  WRITE( nout, fmt = 9998 )i, cc( i, j ), ct( i )
2305  END IF
2306  140 CONTINUE
2307  IF( n.GT.1 )
2308  $ WRITE( nout, fmt = 9997 )j
2309 *
2310  150 CONTINUE
2311  RETURN
2312 *
2313  9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
2314  $ 'F ACCURATE *******', /' EXPECTED RESULT COMPU',
2315  $ 'TED RESULT' )
2316  9998 FORMAT( 1x, i7, 2g18.6 )
2317  9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', i3 )
2318 *
2319 * End of SMMCH.
2320 *