SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ pzblas3tstchke()

subroutine pzblas3tstchke ( logical, dimension( * )  ltest,
integer  inout,
integer  nprocs 
)

Definition at line 2294 of file pzblas3tst.f.

2295*
2296* -- PBLAS test routine (version 2.0) --
2297* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
2298* and University of California, Berkeley.
2299* April 1, 1998
2300*
2301* .. Scalar Arguments ..
2302 INTEGER INOUT, NPROCS
2303* ..
2304* .. Array Arguments ..
2305 LOGICAL LTEST( * )
2306* ..
2307*
2308* Purpose
2309* =======
2310*
2311* PZBLAS3TSTCHKE tests the error exits of the Level 3 PBLAS.
2312*
2313* Arguments
2314* =========
2315*
2316* LTEST (global input) LOGICAL array
2317* On entry, LTEST is an array of dimension at least 11 (NSUBS).
2318* If LTEST( 1 ) is .TRUE., PZGEMM will be tested;
2319* If LTEST( 2 ) is .TRUE., PZSYMM will be tested;
2320* If LTEST( 3 ) is .TRUE., PZHEMM will be tested;
2321* If LTEST( 4 ) is .TRUE., PZSYRK will be tested;
2322* If LTEST( 5 ) is .TRUE., PZHERK will be tested;
2323* If LTEST( 6 ) is .TRUE., PZSYR2K will be tested;
2324* If LTEST( 7 ) is .TRUE., PZHER2K will be tested;
2325* If LTEST( 8 ) is .TRUE., PZTRMM will be tested;
2326* If LTEST( 9 ) is .TRUE., PZTRSM will be tested;
2327* If LTEST( 10 ) is .TRUE., PZGEADD will be tested;
2328* If LTEST( 11 ) is .TRUE., PZTRADD will be tested;
2329*
2330* INOUT (global input) INTEGER
2331* On entry, INOUT specifies the unit number for output file.
2332* When INOUT is 6, output to screen, when INOUT = 0, output to
2333* stderr. INOUT is only defined in process 0.
2334*
2335* NPROCS (global input) INTEGER
2336* On entry, NPROCS specifies the total number of processes cal-
2337* ling this routine.
2338*
2339* Calling sequence encodings
2340* ==========================
2341*
2342* code Formal argument list Examples
2343*
2344* 11 (n, v1,v2) _SWAP, _COPY
2345* 12 (n,s1, v1 ) _SCAL, _SCAL
2346* 13 (n,s1, v1,v2) _AXPY, _DOT_
2347* 14 (n,s1,i1,v1 ) _AMAX
2348* 15 (n,u1, v1 ) _ASUM, _NRM2
2349*
2350* 21 ( trans, m,n,s1,m1,v1,s2,v2) _GEMV
2351* 22 (uplo, n,s1,m1,v1,s2,v2) _SYMV, _HEMV
2352* 23 (uplo,trans,diag, n, m1,v1 ) _TRMV, _TRSV
2353* 24 ( m,n,s1,v1,v2,m1) _GER_
2354* 25 (uplo, n,s1,v1, m1) _SYR
2355* 26 (uplo, n,u1,v1, m1) _HER
2356* 27 (uplo, n,s1,v1,v2,m1) _SYR2, _HER2
2357*
2358* 31 ( transa,transb, m,n,k,s1,m1,m2,s2,m3) _GEMM
2359* 32 (side,uplo, m,n, s1,m1,m2,s2,m3) _SYMM, _HEMM
2360* 33 ( uplo,trans, n,k,s1,m1, s2,m3) _SYRK
2361* 34 ( uplo,trans, n,k,u1,m1, u2,m3) _HERK
2362* 35 ( uplo,trans, n,k,s1,m1,m2,s2,m3) _SYR2K
2363* 36 ( uplo,trans, n,k,s1,m1,m2,u2,m3) _HER2K
2364* 37 ( m,n, s1,m1, s2,m3) _TRAN_
2365* 38 (side,uplo,transa, diag,m,n, s1,m1,m2 ) _TRMM, _TRSM
2366* 39 ( trans, m,n, s1,m1, s2,m3) _GEADD
2367* 40 ( uplo,trans, m,n, s1,m1, s2,m3) _TRADD
2368*
2369* -- Written on April 1, 1998 by
2370* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
2371*
2372* =====================================================================
2373*
2374* .. Parameters ..
2375 INTEGER NSUBS
2376 parameter( nsubs = 11 )
2377* ..
2378* .. Local Scalars ..
2379 LOGICAL ABRTSAV
2380 INTEGER I, ICTXT, MYCOL, MYROW, NPCOL, NPROW
2381* ..
2382* .. Local Arrays ..
2383 INTEGER SCODE( NSUBS )
2384* ..
2385* .. External Subroutines ..
2386 EXTERNAL blacs_get, blacs_gridexit, blacs_gridinfo,
2387 $ blacs_gridinit, pzdimee, pzgeadd, pzgemm,
2388 $ pzhemm, pzher2k, pzherk, pzmatee, pzoptee,
2389 $ pzsymm, pzsyr2k, pzsyrk, pztradd, pztrmm,
2390 $ pztrsm
2391* ..
2392* .. Common Blocks ..
2393 LOGICAL ABRTFLG
2394 INTEGER NOUT
2395 CHARACTER*7 SNAMES( NSUBS )
2396 COMMON /snamec/snames
2397 COMMON /pberrorc/nout, abrtflg
2398* ..
2399* .. Data Statements ..
2400 DATA scode/31, 32, 32, 33, 34, 35, 36, 38, 38, 39,
2401 $ 40/
2402* ..
2403* .. Executable Statements ..
2404*
2405* Temporarily define blacs grid to include all processes so
2406* information can be broadcast to all processes.
2407*
2408 CALL blacs_get( -1, 0, ictxt )
2409 CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
2410 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
2411*
2412* Set ABRTFLG to FALSE so that the PBLAS error handler won't abort
2413* on errors during these tests and set the output device unit for
2414* it.
2415*
2416 abrtsav = abrtflg
2417 abrtflg = .false.
2418 nout = inout
2419*
2420* Test PZGEMM
2421*
2422 i = 1
2423 IF( ltest( i ) ) THEN
2424 CALL pzoptee( ictxt, nout, pzgemm, scode( i ), snames( i ) )
2425 CALL pzdimee( ictxt, nout, pzgemm, scode( i ), snames( i ) )
2426 CALL pzmatee( ictxt, nout, pzgemm, scode( i ), snames( i ) )
2427 END IF
2428*
2429* Test PZSYMM
2430*
2431 i = i + 1
2432 IF( ltest( i ) ) THEN
2433 CALL pzoptee( ictxt, nout, pzsymm, scode( i ), snames( i ) )
2434 CALL pzdimee( ictxt, nout, pzsymm, scode( i ), snames( i ) )
2435 CALL pzmatee( ictxt, nout, pzsymm, scode( i ), snames( i ) )
2436 END IF
2437*
2438* Test PZHEMM
2439*
2440 i = i + 1
2441 IF( ltest( i ) ) THEN
2442 CALL pzoptee( ictxt, nout, pzhemm, scode( i ), snames( i ) )
2443 CALL pzdimee( ictxt, nout, pzhemm, scode( i ), snames( i ) )
2444 CALL pzmatee( ictxt, nout, pzhemm, scode( i ), snames( i ) )
2445 END IF
2446*
2447* Test PZSYRK
2448*
2449 i = i + 1
2450 IF( ltest( i ) ) THEN
2451 CALL pzoptee( ictxt, nout, pzsyrk, scode( i ), snames( i ) )
2452 CALL pzdimee( ictxt, nout, pzsyrk, scode( i ), snames( i ) )
2453 CALL pzmatee( ictxt, nout, pzsyrk, scode( i ), snames( i ) )
2454 END IF
2455*
2456* Test PZHERK
2457*
2458 i = i + 1
2459 IF( ltest( i ) ) THEN
2460 CALL pzoptee( ictxt, nout, pzherk, scode( i ), snames( i ) )
2461 CALL pzdimee( ictxt, nout, pzherk, scode( i ), snames( i ) )
2462 CALL pzmatee( ictxt, nout, pzherk, scode( i ), snames( i ) )
2463 END IF
2464*
2465* Test PZSYR2K
2466*
2467 i = i + 1
2468 IF( ltest( i ) ) THEN
2469 CALL pzoptee( ictxt, nout, pzsyr2k, scode( i ), snames( i ) )
2470 CALL pzdimee( ictxt, nout, pzsyr2k, scode( i ), snames( i ) )
2471 CALL pzmatee( ictxt, nout, pzsyr2k, scode( i ), snames( i ) )
2472 END IF
2473*
2474* Test PZHER2K
2475*
2476 i = i + 1
2477 IF( ltest( i ) ) THEN
2478 CALL pzoptee( ictxt, nout, pzher2k, scode( i ), snames( i ) )
2479 CALL pzdimee( ictxt, nout, pzher2k, scode( i ), snames( i ) )
2480 CALL pzmatee( ictxt, nout, pzher2k, scode( i ), snames( i ) )
2481 END IF
2482*
2483* Test PZTRMM
2484*
2485 i = i + 1
2486 IF( ltest( i ) ) THEN
2487 CALL pzoptee( ictxt, nout, pztrmm, scode( i ), snames( i ) )
2488 CALL pzdimee( ictxt, nout, pztrmm, scode( i ), snames( i ) )
2489 CALL pzmatee( ictxt, nout, pztrmm, scode( i ), snames( i ) )
2490 END IF
2491*
2492* Test PZTRSM
2493*
2494 i = i + 1
2495 IF( ltest( i ) ) THEN
2496 CALL pzoptee( ictxt, nout, pztrsm, scode( i ), snames( i ) )
2497 CALL pzdimee( ictxt, nout, pztrsm, scode( i ), snames( i ) )
2498 CALL pzmatee( ictxt, nout, pztrsm, scode( i ), snames( i ) )
2499 END IF
2500*
2501* Test PZGEADD
2502*
2503 i = i + 1
2504 IF( ltest( i ) ) THEN
2505 CALL pzoptee( ictxt, nout, pzgeadd, scode( i ), snames( i ) )
2506 CALL pzdimee( ictxt, nout, pzgeadd, scode( i ), snames( i ) )
2507 CALL pzmatee( ictxt, nout, pzgeadd, scode( i ), snames( i ) )
2508 END IF
2509*
2510* Test PZTRADD
2511*
2512 i = i + 1
2513 IF( ltest( i ) ) THEN
2514 CALL pzoptee( ictxt, nout, pztradd, scode( i ), snames( i ) )
2515 CALL pzdimee( ictxt, nout, pztradd, scode( i ), snames( i ) )
2516 CALL pzmatee( ictxt, nout, pztradd, scode( i ), snames( i ) )
2517 END IF
2518*
2519 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
2520 $ WRITE( nout, fmt = 9999 )
2521*
2522 CALL blacs_gridexit( ictxt )
2523*
2524* Reset ABRTFLG to the value it had before calling this routine
2525*
2526 abrtflg = abrtsav
2527*
2528 9999 FORMAT( 2x, 'Error-exit tests completed.' )
2529*
2530 RETURN
2531*
2532* End of PZBLAS3TSTCHKE
2533*
pzmatee
subroutine pzmatee(ictxt, nout, subptr, scode, sname)
Definition pzblastst.f:1190
pzoptee
subroutine pzoptee(ictxt, nout, subptr, scode, sname)
Definition pzblastst.f:2
pzdimee
subroutine pzdimee(ictxt, nout, subptr, scode, sname)
Definition pzblastst.f:455
Here is the call graph for this function:
Here is the caller graph for this function: