2407
 2408
 2409
 2410
 2411
 2412
 2413
 2414
 2415
 2416
 2417
 2418
 2419      INTEGER            ISNUM, NOUT
 2420      CHARACTER*6        SRNAMT
 2421
 2422      INTEGER            INFOT, NOUTC
 2423      LOGICAL            LERR, OK
 2424
 2425      COMPLEX*16         ALPHA, BETA
 2426      DOUBLE PRECISION   RALPHA
 2427
 2428      COMPLEX*16         A( 1, 1 ), X( 1 ), Y( 1 )
 2429
 2433
 2434      COMMON             /infoc/infot, noutc, ok, lerr
 2435
 2436
 2437
 2438      ok = .true.
 2439
 2440
 2441      lerr = .false.
 2442      GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
 2443     $        90, 100, 110, 120, 130, 140, 150, 160,
 2444     $        170 )isnum
 2445   10 infot = 1
 2446      CALL zgemv( 
'/', 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
 
 2447      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2448      infot = 2
 2449      CALL zgemv( 
'N', -1, 0, alpha, a, 1, x, 1, beta, y, 1 )
 
 2450      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2451      infot = 3
 2452      CALL zgemv( 
'N', 0, -1, alpha, a, 1, x, 1, beta, y, 1 )
 
 2453      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2454      infot = 6
 2455      CALL zgemv( 
'N', 2, 0, alpha, a, 1, x, 1, beta, y, 1 )
 
 2456      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2457      infot = 8
 2458      CALL zgemv( 
'N', 0, 0, alpha, a, 1, x, 0, beta, y, 1 )
 
 2459      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2460      infot = 11
 2461      CALL zgemv( 
'N', 0, 0, alpha, a, 1, x, 1, beta, y, 0 )
 
 2462      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2463      GO TO 180
 2464   20 infot = 1
 2465      CALL zgbmv( 
'/', 0, 0, 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
 
 2466      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2467      infot = 2
 2468      CALL zgbmv( 
'N', -1, 0, 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
 
 2469      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2470      infot = 3
 2471      CALL zgbmv( 
'N', 0, -1, 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
 
 2472      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2473      infot = 4
 2474      CALL zgbmv( 
'N', 0, 0, -1, 0, alpha, a, 1, x, 1, beta, y, 1 )
 
 2475      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2476      infot = 5
 2477      CALL zgbmv( 
'N', 2, 0, 0, -1, alpha, a, 1, x, 1, beta, y, 1 )
 
 2478      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2479      infot = 8
 2480      CALL zgbmv( 
'N', 0, 0, 1, 0, alpha, a, 1, x, 1, beta, y, 1 )
 
 2481      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2482      infot = 10
 2483      CALL zgbmv( 
'N', 0, 0, 0, 0, alpha, a, 1, x, 0, beta, y, 1 )
 
 2484      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2485      infot = 13
 2486      CALL zgbmv( 
'N', 0, 0, 0, 0, alpha, a, 1, x, 1, beta, y, 0 )
 
 2487      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2488      GO TO 180
 2489   30 infot = 1
 2490      CALL zhemv( 
'/', 0, alpha, a, 1, x, 1, beta, y, 1 )
 
 2491      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2492      infot = 2
 2493      CALL zhemv( 
'U', -1, alpha, a, 1, x, 1, beta, y, 1 )
 
 2494      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2495      infot = 5
 2496      CALL zhemv( 
'U', 2, alpha, a, 1, x, 1, beta, y, 1 )
 
 2497      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2498      infot = 7
 2499      CALL zhemv( 
'U', 0, alpha, a, 1, x, 0, beta, y, 1 )
 
 2500      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2501      infot = 10
 2502      CALL zhemv( 
'U', 0, alpha, a, 1, x, 1, beta, y, 0 )
 
 2503      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2504      GO TO 180
 2505   40 infot = 1
 2506      CALL zhbmv( 
'/', 0, 0, alpha, a, 1, x, 1, beta, y, 1 )
 
 2507      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2508      infot = 2
 2509      CALL zhbmv( 
'U', -1, 0, alpha, a, 1, x, 1, beta, y, 1 )
 
 2510      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2511      infot = 3
 2512      CALL zhbmv( 
'U', 0, -1, alpha, a, 1, x, 1, beta, y, 1 )
 
 2513      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2514      infot = 6
 2515      CALL zhbmv( 
'U', 0, 1, alpha, a, 1, x, 1, beta, y, 1 )
 
 2516      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2517      infot = 8
 2518      CALL zhbmv( 
'U', 0, 0, alpha, a, 1, x, 0, beta, y, 1 )
 
 2519      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2520      infot = 11
 2521      CALL zhbmv( 
'U', 0, 0, alpha, a, 1, x, 1, beta, y, 0 )
 
 2522      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2523      GO TO 180
 2524   50 infot = 1
 2525      CALL zhpmv( 
'/', 0, alpha, a, x, 1, beta, y, 1 )
 
 2526      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2527      infot = 2
 2528      CALL zhpmv( 
'U', -1, alpha, a, x, 1, beta, y, 1 )
 
 2529      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2530      infot = 6
 2531      CALL zhpmv( 
'U', 0, alpha, a, x, 0, beta, y, 1 )
 
 2532      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2533      infot = 9
 2534      CALL zhpmv( 
'U', 0, alpha, a, x, 1, beta, y, 0 )
 
 2535      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2536      GO TO 180
 2537   60 infot = 1
 2538      CALL ztrmv( 
'/', 
'N', 
'N', 0, a, 1, x, 1 )
 
 2539      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2540      infot = 2
 2541      CALL ztrmv( 
'U', 
'/', 
'N', 0, a, 1, x, 1 )
 
 2542      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2543      infot = 3
 2544      CALL ztrmv( 
'U', 
'N', 
'/', 0, a, 1, x, 1 )
 
 2545      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2546      infot = 4
 2547      CALL ztrmv( 
'U', 
'N', 
'N', -1, a, 1, x, 1 )
 
 2548      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2549      infot = 6
 2550      CALL ztrmv( 
'U', 
'N', 
'N', 2, a, 1, x, 1 )
 
 2551      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2552      infot = 8
 2553      CALL ztrmv( 
'U', 
'N', 
'N', 0, a, 1, x, 0 )
 
 2554      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2555      GO TO 180
 2556   70 infot = 1
 2557      CALL ztbmv( 
'/', 
'N', 
'N', 0, 0, a, 1, x, 1 )
 
 2558      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2559      infot = 2
 2560      CALL ztbmv( 
'U', 
'/', 
'N', 0, 0, a, 1, x, 1 )
 
 2561      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2562      infot = 3
 2563      CALL ztbmv( 
'U', 
'N', 
'/', 0, 0, a, 1, x, 1 )
 
 2564      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2565      infot = 4
 2566      CALL ztbmv( 
'U', 
'N', 
'N', -1, 0, a, 1, x, 1 )
 
 2567      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2568      infot = 5
 2569      CALL ztbmv( 
'U', 
'N', 
'N', 0, -1, a, 1, x, 1 )
 
 2570      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2571      infot = 7
 2572      CALL ztbmv( 
'U', 
'N', 
'N', 0, 1, a, 1, x, 1 )
 
 2573      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2574      infot = 9
 2575      CALL ztbmv( 
'U', 
'N', 
'N', 0, 0, a, 1, x, 0 )
 
 2576      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2577      GO TO 180
 2578   80 infot = 1
 2579      CALL ztpmv( 
'/', 
'N', 
'N', 0, a, x, 1 )
 
 2580      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2581      infot = 2
 2582      CALL ztpmv( 
'U', 
'/', 
'N', 0, a, x, 1 )
 
 2583      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2584      infot = 3
 2585      CALL ztpmv( 
'U', 
'N', 
'/', 0, a, x, 1 )
 
 2586      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2587      infot = 4
 2588      CALL ztpmv( 
'U', 
'N', 
'N', -1, a, x, 1 )
 
 2589      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2590      infot = 7
 2591      CALL ztpmv( 
'U', 
'N', 
'N', 0, a, x, 0 )
 
 2592      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2593      GO TO 180
 2594   90 infot = 1
 2595      CALL ztrsv( 
'/', 
'N', 
'N', 0, a, 1, x, 1 )
 
 2596      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2597      infot = 2
 2598      CALL ztrsv( 
'U', 
'/', 
'N', 0, a, 1, x, 1 )
 
 2599      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2600      infot = 3
 2601      CALL ztrsv( 
'U', 
'N', 
'/', 0, a, 1, x, 1 )
 
 2602      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2603      infot = 4
 2604      CALL ztrsv( 
'U', 
'N', 
'N', -1, a, 1, x, 1 )
 
 2605      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2606      infot = 6
 2607      CALL ztrsv( 
'U', 
'N', 
'N', 2, a, 1, x, 1 )
 
 2608      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2609      infot = 8
 2610      CALL ztrsv( 
'U', 
'N', 
'N', 0, a, 1, x, 0 )
 
 2611      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2612      GO TO 180
 2613  100 infot = 1
 2614      CALL ztbsv( 
'/', 
'N', 
'N', 0, 0, a, 1, x, 1 )
 
 2615      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2616      infot = 2
 2617      CALL ztbsv( 
'U', 
'/', 
'N', 0, 0, a, 1, x, 1 )
 
 2618      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2619      infot = 3
 2620      CALL ztbsv( 
'U', 
'N', 
'/', 0, 0, a, 1, x, 1 )
 
 2621      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2622      infot = 4
 2623      CALL ztbsv( 
'U', 
'N', 
'N', -1, 0, a, 1, x, 1 )
 
 2624      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2625      infot = 5
 2626      CALL ztbsv( 
'U', 
'N', 
'N', 0, -1, a, 1, x, 1 )
 
 2627      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2628      infot = 7
 2629      CALL ztbsv( 
'U', 
'N', 
'N', 0, 1, a, 1, x, 1 )
 
 2630      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2631      infot = 9
 2632      CALL ztbsv( 
'U', 
'N', 
'N', 0, 0, a, 1, x, 0 )
 
 2633      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2634      GO TO 180
 2635  110 infot = 1
 2636      CALL ztpsv( 
'/', 
'N', 
'N', 0, a, x, 1 )
 
 2637      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2638      infot = 2
 2639      CALL ztpsv( 
'U', 
'/', 
'N', 0, a, x, 1 )
 
 2640      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2641      infot = 3
 2642      CALL ztpsv( 
'U', 
'N', 
'/', 0, a, x, 1 )
 
 2643      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2644      infot = 4
 2645      CALL ztpsv( 
'U', 
'N', 
'N', -1, a, x, 1 )
 
 2646      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2647      infot = 7
 2648      CALL ztpsv( 
'U', 
'N', 
'N', 0, a, x, 0 )
 
 2649      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2650      GO TO 180
 2651  120 infot = 1
 2652      CALL zgerc( -1, 0, alpha, x, 1, y, 1, a, 1 )
 
 2653      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2654      infot = 2
 2655      CALL zgerc( 0, -1, alpha, x, 1, y, 1, a, 1 )
 
 2656      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2657      infot = 5
 2658      CALL zgerc( 0, 0, alpha, x, 0, y, 1, a, 1 )
 
 2659      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2660      infot = 7
 2661      CALL zgerc( 0, 0, alpha, x, 1, y, 0, a, 1 )
 
 2662      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2663      infot = 9
 2664      CALL zgerc( 2, 0, alpha, x, 1, y, 1, a, 1 )
 
 2665      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2666      GO TO 180
 2667  130 infot = 1
 2668      CALL zgeru( -1, 0, alpha, x, 1, y, 1, a, 1 )
 
 2669      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2670      infot = 2
 2671      CALL zgeru( 0, -1, alpha, x, 1, y, 1, a, 1 )
 
 2672      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2673      infot = 5
 2674      CALL zgeru( 0, 0, alpha, x, 0, y, 1, a, 1 )
 
 2675      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2676      infot = 7
 2677      CALL zgeru( 0, 0, alpha, x, 1, y, 0, a, 1 )
 
 2678      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2679      infot = 9
 2680      CALL zgeru( 2, 0, alpha, x, 1, y, 1, a, 1 )
 
 2681      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2682      GO TO 180
 2683  140 infot = 1
 2684      CALL zher( 
'/', 0, ralpha, x, 1, a, 1 )
 
 2685      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2686      infot = 2
 2687      CALL zher( 
'U', -1, ralpha, x, 1, a, 1 )
 
 2688      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2689      infot = 5
 2690      CALL zher( 
'U', 0, ralpha, x, 0, a, 1 )
 
 2691      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2692      infot = 7
 2693      CALL zher( 
'U', 2, ralpha, x, 1, a, 1 )
 
 2694      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2695      GO TO 180
 2696  150 infot = 1
 2697      CALL zhpr( 
'/', 0, ralpha, x, 1, a )
 
 2698      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2699      infot = 2
 2700      CALL zhpr( 
'U', -1, ralpha, x, 1, a )
 
 2701      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2702      infot = 5
 2703      CALL zhpr( 
'U', 0, ralpha, x, 0, a )
 
 2704      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2705      GO TO 180
 2706  160 infot = 1
 2707      CALL zher2( 
'/', 0, alpha, x, 1, y, 1, a, 1 )
 
 2708      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2709      infot = 2
 2710      CALL zher2( 
'U', -1, alpha, x, 1, y, 1, a, 1 )
 
 2711      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2712      infot = 5
 2713      CALL zher2( 
'U', 0, alpha, x, 0, y, 1, a, 1 )
 
 2714      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2715      infot = 7
 2716      CALL zher2( 
'U', 0, alpha, x, 1, y, 0, a, 1 )
 
 2717      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2718      infot = 9
 2719      CALL zher2( 
'U', 2, alpha, x, 1, y, 1, a, 1 )
 
 2720      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2721      GO TO 180
 2722  170 infot = 1
 2723      CALL zhpr2( 
'/', 0, alpha, x, 1, y, 1, a )
 
 2724      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2725      infot = 2
 2726      CALL zhpr2( 
'U', -1, alpha, x, 1, y, 1, a )
 
 2727      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2728      infot = 5
 2729      CALL zhpr2( 
'U', 0, alpha, x, 0, y, 1, a )
 
 2730      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2731      infot = 7
 2732      CALL zhpr2( 
'U', 0, alpha, x, 1, y, 0, a )
 
 2733      CALL chkxer( srnamt, infot, nout, lerr, ok )
 
 2734
 2735  180 IF( ok )THEN
 2736         WRITE( nout, fmt = 9999 )srnamt
 2737      ELSE
 2738         WRITE( nout, fmt = 9998 )srnamt
 2739      END IF
 2740      RETURN
 2741
 2742 9999 FORMAT( ' ', a6, ' PASSED THE TESTS OF ERROR-EXITS' )
 2743 9998 FORMAT( ' ******* ', a6, ' FAILED THE TESTS OF ERROR-EXITS *****',
 2744     $      '**' )
 2745
 2746
 2747
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine zgbmv(trans, m, n, kl, ku, alpha, a, lda, x, incx, beta, y, incy)
ZGBMV
subroutine zgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
ZGEMV
subroutine zgeru(m, n, alpha, x, incx, y, incy, a, lda)
ZGERU
subroutine zgerc(m, n, alpha, x, incx, y, incy, a, lda)
ZGERC
subroutine zhbmv(uplo, n, k, alpha, a, lda, x, incx, beta, y, incy)
ZHBMV
subroutine zhemv(uplo, n, alpha, a, lda, x, incx, beta, y, incy)
ZHEMV
subroutine zher2(uplo, n, alpha, x, incx, y, incy, a, lda)
ZHER2
subroutine zher(uplo, n, alpha, x, incx, a, lda)
ZHER
subroutine zhpmv(uplo, n, alpha, ap, x, incx, beta, y, incy)
ZHPMV
subroutine zhpr2(uplo, n, alpha, x, incx, y, incy, ap)
ZHPR2
subroutine zhpr(uplo, n, alpha, x, incx, ap)
ZHPR
subroutine ztbmv(uplo, trans, diag, n, k, a, lda, x, incx)
ZTBMV
subroutine ztbsv(uplo, trans, diag, n, k, a, lda, x, incx)
ZTBSV
subroutine ztpmv(uplo, trans, diag, n, ap, x, incx)
ZTPMV
subroutine ztpsv(uplo, trans, diag, n, ap, x, incx)
ZTPSV
subroutine ztrmv(uplo, trans, diag, n, a, lda, x, incx)
ZTRMV
subroutine ztrsv(uplo, trans, diag, n, a, lda, x, incx)
ZTRSV