LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ schke()

subroutine schke ( integer  isnum,
character*6  srnamt,
integer  nout 
)

Definition at line 2350 of file sblat2.f.

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