LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ schke()

subroutine schke ( integer  ISNUM,
character*6  SRNAMT,
integer  NOUT 
)

Definition at line 2322 of file sblat2.f.

2323 *
2324 * Tests the error exits from the Level 2 Blas.
2325 * Requires a special version of the error-handling routine XERBLA.
2326 * ALPHA, BETA, A, X and Y should not need to be defined.
2327 *
2328 * Auxiliary routine for test program for Level 2 Blas.
2329 *
2330 * -- Written on 10-August-1987.
2331 * Richard Hanson, Sandia National Labs.
2332 * Jeremy Du Croz, NAG Central Office.
2333 *
2334 * .. Scalar Arguments ..
2335  INTEGER ISNUM, NOUT
2336  CHARACTER*6 SRNAMT
2337 * .. Scalars in Common ..
2338  INTEGER INFOT, NOUTC
2339  LOGICAL LERR, OK
2340 * .. Local Scalars ..
2341  REAL ALPHA, BETA
2342 * .. Local Arrays ..
2343  REAL A( 1, 1 ), X( 1 ), Y( 1 )
2344 * .. External Subroutines ..
2345  EXTERNAL chkxer, sgbmv, sgemv, sger, ssbmv, sspmv, sspr,
2346  $ sspr2, ssymv, ssyr, ssyr2, stbmv, stbsv, stpmv,
2347  $ stpsv, strmv, strsv
2348 * .. Common blocks ..
2349  COMMON /infoc/infot, noutc, ok, lerr
2350 * .. Executable Statements ..
2351 * OK is set to .FALSE. by the special version of XERBLA or by CHKXER
2352 * if anything is wrong.
2353  ok = .true.
2354 * LERR is set to .TRUE. by the special version of XERBLA each time
2355 * it is called, and is then tested and re-set by CHKXER.
2356  lerr = .false.
2357  GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
2358  $ 90, 100, 110, 120, 130, 140, 150,
2359  $ 160 )isnum
2360  10 infot = 1
2361  CALL sgemv( '/', 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
2362  CALL chkxer( srnamt, infot, nout, lerr, ok )
2363  infot = 2
2364  CALL sgemv( 'N', -1, 0, alpha, a, 1, x, 1, beta, y, 1 )
2365  CALL chkxer( srnamt, infot, nout, lerr, ok )
2366  infot = 3
2367  CALL sgemv( 'N', 0, -1, alpha, a, 1, x, 1, beta, y, 1 )
2368  CALL chkxer( srnamt, infot, nout, lerr, ok )
2369  infot = 6
2370  CALL sgemv( 'N', 2, 0, alpha, a, 1, x, 1, beta, y, 1 )
2371  CALL chkxer( srnamt, infot, nout, lerr, ok )
2372  infot = 8
2373  CALL sgemv( 'N', 0, 0, alpha, a, 1, x, 0, beta, y, 1 )
2374  CALL chkxer( srnamt, infot, nout, lerr, ok )
2375  infot = 11
2376  CALL sgemv( 'N', 0, 0, alpha, a, 1, x, 1, beta, y, 0 )
2377  CALL chkxer( srnamt, infot, nout, lerr, ok )
2378  GO TO 170
2379  20 infot = 1
2380  CALL sgbmv( '/', 0, 0, 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
2381  CALL chkxer( srnamt, infot, nout, lerr, ok )
2382  infot = 2
2383  CALL sgbmv( 'N', -1, 0, 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
2384  CALL chkxer( srnamt, infot, nout, lerr, ok )
2385  infot = 3
2386  CALL sgbmv( 'N', 0, -1, 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
2387  CALL chkxer( srnamt, infot, nout, lerr, ok )
2388  infot = 4
2389  CALL sgbmv( 'N', 0, 0, -1, 0, alpha, a, 1, x, 1, beta, y, 1 )
2390  CALL chkxer( srnamt, infot, nout, lerr, ok )
2391  infot = 5
2392  CALL sgbmv( 'N', 2, 0, 0, -1, alpha, a, 1, x, 1, beta, y, 1 )
2393  CALL chkxer( srnamt, infot, nout, lerr, ok )
2394  infot = 8
2395  CALL sgbmv( 'N', 0, 0, 1, 0, alpha, a, 1, x, 1, beta, y, 1 )
2396  CALL chkxer( srnamt, infot, nout, lerr, ok )
2397  infot = 10
2398  CALL sgbmv( 'N', 0, 0, 0, 0, alpha, a, 1, x, 0, beta, y, 1 )
2399  CALL chkxer( srnamt, infot, nout, lerr, ok )
2400  infot = 13
2401  CALL sgbmv( 'N', 0, 0, 0, 0, alpha, a, 1, x, 1, beta, y, 0 )
2402  CALL chkxer( srnamt, infot, nout, lerr, ok )
2403  GO TO 170
2404  30 infot = 1
2405  CALL ssymv( '/', 0, alpha, a, 1, x, 1, beta, y, 1 )
2406  CALL chkxer( srnamt, infot, nout, lerr, ok )
2407  infot = 2
2408  CALL ssymv( 'U', -1, alpha, a, 1, x, 1, beta, y, 1 )
2409  CALL chkxer( srnamt, infot, nout, lerr, ok )
2410  infot = 5
2411  CALL ssymv( 'U', 2, alpha, a, 1, x, 1, beta, y, 1 )
2412  CALL chkxer( srnamt, infot, nout, lerr, ok )
2413  infot = 7
2414  CALL ssymv( 'U', 0, alpha, a, 1, x, 0, beta, y, 1 )
2415  CALL chkxer( srnamt, infot, nout, lerr, ok )
2416  infot = 10
2417  CALL ssymv( 'U', 0, alpha, a, 1, x, 1, beta, y, 0 )
2418  CALL chkxer( srnamt, infot, nout, lerr, ok )
2419  GO TO 170
2420  40 infot = 1
2421  CALL ssbmv( '/', 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
2422  CALL chkxer( srnamt, infot, nout, lerr, ok )
2423  infot = 2
2424  CALL ssbmv( 'U', -1, 0, alpha, a, 1, x, 1, beta, y, 1 )
2425  CALL chkxer( srnamt, infot, nout, lerr, ok )
2426  infot = 3
2427  CALL ssbmv( 'U', 0, -1, alpha, a, 1, x, 1, beta, y, 1 )
2428  CALL chkxer( srnamt, infot, nout, lerr, ok )
2429  infot = 6
2430  CALL ssbmv( 'U', 0, 1, alpha, a, 1, x, 1, beta, y, 1 )
2431  CALL chkxer( srnamt, infot, nout, lerr, ok )
2432  infot = 8
2433  CALL ssbmv( 'U', 0, 0, alpha, a, 1, x, 0, beta, y, 1 )
2434  CALL chkxer( srnamt, infot, nout, lerr, ok )
2435  infot = 11
2436  CALL ssbmv( 'U', 0, 0, alpha, a, 1, x, 1, beta, y, 0 )
2437  CALL chkxer( srnamt, infot, nout, lerr, ok )
2438  GO TO 170
2439  50 infot = 1
2440  CALL sspmv( '/', 0, alpha, a, x, 1, beta, y, 1 )
2441  CALL chkxer( srnamt, infot, nout, lerr, ok )
2442  infot = 2
2443  CALL sspmv( 'U', -1, alpha, a, x, 1, beta, y, 1 )
2444  CALL chkxer( srnamt, infot, nout, lerr, ok )
2445  infot = 6
2446  CALL sspmv( 'U', 0, alpha, a, x, 0, beta, y, 1 )
2447  CALL chkxer( srnamt, infot, nout, lerr, ok )
2448  infot = 9
2449  CALL sspmv( 'U', 0, alpha, a, x, 1, beta, y, 0 )
2450  CALL chkxer( srnamt, infot, nout, lerr, ok )
2451  GO TO 170
2452  60 infot = 1
2453  CALL strmv( '/', 'N', 'N', 0, a, 1, x, 1 )
2454  CALL chkxer( srnamt, infot, nout, lerr, ok )
2455  infot = 2
2456  CALL strmv( 'U', '/', 'N', 0, a, 1, x, 1 )
2457  CALL chkxer( srnamt, infot, nout, lerr, ok )
2458  infot = 3
2459  CALL strmv( 'U', 'N', '/', 0, a, 1, x, 1 )
2460  CALL chkxer( srnamt, infot, nout, lerr, ok )
2461  infot = 4
2462  CALL strmv( 'U', 'N', 'N', -1, a, 1, x, 1 )
2463  CALL chkxer( srnamt, infot, nout, lerr, ok )
2464  infot = 6
2465  CALL strmv( 'U', 'N', 'N', 2, a, 1, x, 1 )
2466  CALL chkxer( srnamt, infot, nout, lerr, ok )
2467  infot = 8
2468  CALL strmv( 'U', 'N', 'N', 0, a, 1, x, 0 )
2469  CALL chkxer( srnamt, infot, nout, lerr, ok )
2470  GO TO 170
2471  70 infot = 1
2472  CALL stbmv( '/', 'N', 'N', 0, 0, a, 1, x, 1 )
2473  CALL chkxer( srnamt, infot, nout, lerr, ok )
2474  infot = 2
2475  CALL stbmv( 'U', '/', 'N', 0, 0, a, 1, x, 1 )
2476  CALL chkxer( srnamt, infot, nout, lerr, ok )
2477  infot = 3
2478  CALL stbmv( 'U', 'N', '/', 0, 0, a, 1, x, 1 )
2479  CALL chkxer( srnamt, infot, nout, lerr, ok )
2480  infot = 4
2481  CALL stbmv( 'U', 'N', 'N', -1, 0, a, 1, x, 1 )
2482  CALL chkxer( srnamt, infot, nout, lerr, ok )
2483  infot = 5
2484  CALL stbmv( 'U', 'N', 'N', 0, -1, a, 1, x, 1 )
2485  CALL chkxer( srnamt, infot, nout, lerr, ok )
2486  infot = 7
2487  CALL stbmv( 'U', 'N', 'N', 0, 1, a, 1, x, 1 )
2488  CALL chkxer( srnamt, infot, nout, lerr, ok )
2489  infot = 9
2490  CALL stbmv( 'U', 'N', 'N', 0, 0, a, 1, x, 0 )
2491  CALL chkxer( srnamt, infot, nout, lerr, ok )
2492  GO TO 170
2493  80 infot = 1
2494  CALL stpmv( '/', 'N', 'N', 0, a, x, 1 )
2495  CALL chkxer( srnamt, infot, nout, lerr, ok )
2496  infot = 2
2497  CALL stpmv( 'U', '/', 'N', 0, a, x, 1 )
2498  CALL chkxer( srnamt, infot, nout, lerr, ok )
2499  infot = 3
2500  CALL stpmv( 'U', 'N', '/', 0, a, x, 1 )
2501  CALL chkxer( srnamt, infot, nout, lerr, ok )
2502  infot = 4
2503  CALL stpmv( 'U', 'N', 'N', -1, a, x, 1 )
2504  CALL chkxer( srnamt, infot, nout, lerr, ok )
2505  infot = 7
2506  CALL stpmv( 'U', 'N', 'N', 0, a, x, 0 )
2507  CALL chkxer( srnamt, infot, nout, lerr, ok )
2508  GO TO 170
2509  90 infot = 1
2510  CALL strsv( '/', 'N', 'N', 0, a, 1, x, 1 )
2511  CALL chkxer( srnamt, infot, nout, lerr, ok )
2512  infot = 2
2513  CALL strsv( 'U', '/', 'N', 0, a, 1, x, 1 )
2514  CALL chkxer( srnamt, infot, nout, lerr, ok )
2515  infot = 3
2516  CALL strsv( 'U', 'N', '/', 0, a, 1, x, 1 )
2517  CALL chkxer( srnamt, infot, nout, lerr, ok )
2518  infot = 4
2519  CALL strsv( 'U', 'N', 'N', -1, a, 1, x, 1 )
2520  CALL chkxer( srnamt, infot, nout, lerr, ok )
2521  infot = 6
2522  CALL strsv( 'U', 'N', 'N', 2, a, 1, x, 1 )
2523  CALL chkxer( srnamt, infot, nout, lerr, ok )
2524  infot = 8
2525  CALL strsv( 'U', 'N', 'N', 0, a, 1, x, 0 )
2526  CALL chkxer( srnamt, infot, nout, lerr, ok )
2527  GO TO 170
2528  100 infot = 1
2529  CALL stbsv( '/', 'N', 'N', 0, 0, a, 1, x, 1 )
2530  CALL chkxer( srnamt, infot, nout, lerr, ok )
2531  infot = 2
2532  CALL stbsv( 'U', '/', 'N', 0, 0, a, 1, x, 1 )
2533  CALL chkxer( srnamt, infot, nout, lerr, ok )
2534  infot = 3
2535  CALL stbsv( 'U', 'N', '/', 0, 0, a, 1, x, 1 )
2536  CALL chkxer( srnamt, infot, nout, lerr, ok )
2537  infot = 4
2538  CALL stbsv( 'U', 'N', 'N', -1, 0, a, 1, x, 1 )
2539  CALL chkxer( srnamt, infot, nout, lerr, ok )
2540  infot = 5
2541  CALL stbsv( 'U', 'N', 'N', 0, -1, a, 1, x, 1 )
2542  CALL chkxer( srnamt, infot, nout, lerr, ok )
2543  infot = 7
2544  CALL stbsv( 'U', 'N', 'N', 0, 1, a, 1, x, 1 )
2545  CALL chkxer( srnamt, infot, nout, lerr, ok )
2546  infot = 9
2547  CALL stbsv( 'U', 'N', 'N', 0, 0, a, 1, x, 0 )
2548  CALL chkxer( srnamt, infot, nout, lerr, ok )
2549  GO TO 170
2550  110 infot = 1
2551  CALL stpsv( '/', 'N', 'N', 0, a, x, 1 )
2552  CALL chkxer( srnamt, infot, nout, lerr, ok )
2553  infot = 2
2554  CALL stpsv( 'U', '/', 'N', 0, a, x, 1 )
2555  CALL chkxer( srnamt, infot, nout, lerr, ok )
2556  infot = 3
2557  CALL stpsv( 'U', 'N', '/', 0, a, x, 1 )
2558  CALL chkxer( srnamt, infot, nout, lerr, ok )
2559  infot = 4
2560  CALL stpsv( 'U', 'N', 'N', -1, a, x, 1 )
2561  CALL chkxer( srnamt, infot, nout, lerr, ok )
2562  infot = 7
2563  CALL stpsv( 'U', 'N', 'N', 0, a, x, 0 )
2564  CALL chkxer( srnamt, infot, nout, lerr, ok )
2565  GO TO 170
2566  120 infot = 1
2567  CALL sger( -1, 0, alpha, x, 1, y, 1, a, 1 )
2568  CALL chkxer( srnamt, infot, nout, lerr, ok )
2569  infot = 2
2570  CALL sger( 0, -1, alpha, x, 1, y, 1, a, 1 )
2571  CALL chkxer( srnamt, infot, nout, lerr, ok )
2572  infot = 5
2573  CALL sger( 0, 0, alpha, x, 0, y, 1, a, 1 )
2574  CALL chkxer( srnamt, infot, nout, lerr, ok )
2575  infot = 7
2576  CALL sger( 0, 0, alpha, x, 1, y, 0, a, 1 )
2577  CALL chkxer( srnamt, infot, nout, lerr, ok )
2578  infot = 9
2579  CALL sger( 2, 0, alpha, x, 1, y, 1, a, 1 )
2580  CALL chkxer( srnamt, infot, nout, lerr, ok )
2581  GO TO 170
2582  130 infot = 1
2583  CALL ssyr( '/', 0, alpha, x, 1, a, 1 )
2584  CALL chkxer( srnamt, infot, nout, lerr, ok )
2585  infot = 2
2586  CALL ssyr( 'U', -1, alpha, x, 1, a, 1 )
2587  CALL chkxer( srnamt, infot, nout, lerr, ok )
2588  infot = 5
2589  CALL ssyr( 'U', 0, alpha, x, 0, a, 1 )
2590  CALL chkxer( srnamt, infot, nout, lerr, ok )
2591  infot = 7
2592  CALL ssyr( 'U', 2, alpha, x, 1, a, 1 )
2593  CALL chkxer( srnamt, infot, nout, lerr, ok )
2594  GO TO 170
2595  140 infot = 1
2596  CALL sspr( '/', 0, alpha, x, 1, a )
2597  CALL chkxer( srnamt, infot, nout, lerr, ok )
2598  infot = 2
2599  CALL sspr( 'U', -1, alpha, x, 1, a )
2600  CALL chkxer( srnamt, infot, nout, lerr, ok )
2601  infot = 5
2602  CALL sspr( 'U', 0, alpha, x, 0, a )
2603  CALL chkxer( srnamt, infot, nout, lerr, ok )
2604  GO TO 170
2605  150 infot = 1
2606  CALL ssyr2( '/', 0, alpha, x, 1, y, 1, a, 1 )
2607  CALL chkxer( srnamt, infot, nout, lerr, ok )
2608  infot = 2
2609  CALL ssyr2( 'U', -1, alpha, x, 1, y, 1, a, 1 )
2610  CALL chkxer( srnamt, infot, nout, lerr, ok )
2611  infot = 5
2612  CALL ssyr2( 'U', 0, alpha, x, 0, y, 1, a, 1 )
2613  CALL chkxer( srnamt, infot, nout, lerr, ok )
2614  infot = 7
2615  CALL ssyr2( 'U', 0, alpha, x, 1, y, 0, a, 1 )
2616  CALL chkxer( srnamt, infot, nout, lerr, ok )
2617  infot = 9
2618  CALL ssyr2( 'U', 2, alpha, x, 1, y, 1, a, 1 )
2619  CALL chkxer( srnamt, infot, nout, lerr, ok )
2620  GO TO 170
2621  160 infot = 1
2622  CALL sspr2( '/', 0, alpha, x, 1, y, 1, a )
2623  CALL chkxer( srnamt, infot, nout, lerr, ok )
2624  infot = 2
2625  CALL sspr2( 'U', -1, alpha, x, 1, y, 1, a )
2626  CALL chkxer( srnamt, infot, nout, lerr, ok )
2627  infot = 5
2628  CALL sspr2( 'U', 0, alpha, x, 0, y, 1, a )
2629  CALL chkxer( srnamt, infot, nout, lerr, ok )
2630  infot = 7
2631  CALL sspr2( 'U', 0, alpha, x, 1, y, 0, a )
2632  CALL chkxer( srnamt, infot, nout, lerr, ok )
2633 *
2634  170 IF( ok )THEN
2635  WRITE( nout, fmt = 9999 )srnamt
2636  ELSE
2637  WRITE( nout, fmt = 9998 )srnamt
2638  END IF
2639  RETURN
2640 *
2641  9999 FORMAT( ' ', a6, ' PASSED THE TESTS OF ERROR-EXITS' )
2642  9998 FORMAT( ' ******* ', a6, ' FAILED THE TESTS OF ERROR-EXITS *****',
2643  $ '**' )
2644 *
2645 * End of SCHKE
2646 *
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine stbsv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
STBSV
Definition: stbsv.f:189
subroutine sspr(UPLO, N, ALPHA, X, INCX, AP)
SSPR
Definition: sspr.f:127
subroutine sgbmv(TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGBMV
Definition: sgbmv.f:185
subroutine strmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
STRMV
Definition: strmv.f:147
subroutine sger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SGER
Definition: sger.f:130
subroutine strsv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
STRSV
Definition: strsv.f:149
subroutine ssyr(UPLO, N, ALPHA, X, INCX, A, LDA)
SSYR
Definition: ssyr.f:132
subroutine stpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
STPMV
Definition: stpmv.f:142
subroutine stbmv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
STBMV
Definition: stbmv.f:186
subroutine ssymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SSYMV
Definition: ssymv.f:152
subroutine sspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
SSPMV
Definition: sspmv.f:147
subroutine ssbmv(UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SSBMV
Definition: ssbmv.f:184
subroutine stpsv(UPLO, TRANS, DIAG, N, AP, X, INCX)
STPSV
Definition: stpsv.f:144
subroutine sspr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
SSPR2
Definition: sspr2.f:142
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
Definition: sgemv.f:156
subroutine ssyr2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SSYR2
Definition: ssyr2.f:147
Here is the caller graph for this function: