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

◆ pdblas3tstchke()

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

Definition at line 2193 of file pdblas3tst.f.

2194*
2195* -- PBLAS test routine (version 2.0) --
2196* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
2197* and University of California, Berkeley.
2198* April 1, 1998
2199*
2200* .. Scalar Arguments ..
2201 INTEGER INOUT, NPROCS
2202* ..
2203* .. Array Arguments ..
2204 LOGICAL LTEST( * )
2205* ..
2206*
2207* Purpose
2208* =======
2209*
2210* PDBLAS3TSTCHKE tests the error exits of the Level 3 PBLAS.
2211*
2212* Arguments
2213* =========
2214*
2215* LTEST (global input) LOGICAL array
2216* On entry, LTEST is an array of dimension at least 7 (NSUBS).
2217* If LTEST( 1 ) is .TRUE., PDGEMM will be tested;
2218* If LTEST( 2 ) is .TRUE., PDSYMM will be tested;
2219* If LTEST( 3 ) is .TRUE., PDSYRK will be tested;
2220* If LTEST( 4 ) is .TRUE., PDSYR2K will be tested;
2221* If LTEST( 5 ) is .TRUE., PDTRMM will be tested;
2222* If LTEST( 6 ) is .TRUE., PDTRSM will be tested;
2223* If LTEST( 7 ) is .TRUE., PDGEADD will be tested;
2224* If LTEST( 8 ) is .TRUE., PDTRADD will be tested;
2225*
2226* INOUT (global input) INTEGER
2227* On entry, INOUT specifies the unit number for output file.
2228* When INOUT is 6, output to screen, when INOUT = 0, output to
2229* stderr. INOUT is only defined in process 0.
2230*
2231* NPROCS (global input) INTEGER
2232* On entry, NPROCS specifies the total number of processes cal-
2233* ling this routine.
2234*
2235* Calling sequence encodings
2236* ==========================
2237*
2238* code Formal argument list Examples
2239*
2240* 11 (n, v1,v2) _SWAP, _COPY
2241* 12 (n,s1, v1 ) _SCAL, _SCAL
2242* 13 (n,s1, v1,v2) _AXPY, _DOT_
2243* 14 (n,s1,i1,v1 ) _AMAX
2244* 15 (n,u1, v1 ) _ASUM, _NRM2
2245*
2246* 21 ( trans, m,n,s1,m1,v1,s2,v2) _GEMV
2247* 22 (uplo, n,s1,m1,v1,s2,v2) _SYMV, _HEMV
2248* 23 (uplo,trans,diag, n, m1,v1 ) _TRMV, _TRSV
2249* 24 ( m,n,s1,v1,v2,m1) _GER_
2250* 25 (uplo, n,s1,v1, m1) _SYR
2251* 26 (uplo, n,u1,v1, m1) _HER
2252* 27 (uplo, n,s1,v1,v2,m1) _SYR2, _HER2
2253*
2254* 31 ( transa,transb, m,n,k,s1,m1,m2,s2,m3) _GEMM
2255* 32 (side,uplo, m,n, s1,m1,m2,s2,m3) _SYMM, _HEMM
2256* 33 ( uplo,trans, n,k,s1,m1, s2,m3) _SYRK
2257* 34 ( uplo,trans, n,k,u1,m1, u2,m3) _HERK
2258* 35 ( uplo,trans, n,k,s1,m1,m2,s2,m3) _SYR2K
2259* 36 ( uplo,trans, n,k,s1,m1,m2,u2,m3) _HER2K
2260* 37 ( m,n, s1,m1, s2,m3) _TRAN_
2261* 38 (side,uplo,transa, diag,m,n, s1,m1,m2 ) _TRMM, _TRSM
2262* 39 ( trans, m,n, s1,m1, s2,m3) _GEADD
2263* 40 ( uplo,trans, m,n, s1,m1, s2,m3) _TRADD
2264*
2265* -- Written on April 1, 1998 by
2266* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
2267*
2268* =====================================================================
2269*
2270* .. Parameters ..
2271 INTEGER NSUBS
2272 parameter( nsubs = 8 )
2273* ..
2274* .. Local Scalars ..
2275 LOGICAL ABRTSAV
2276 INTEGER I, ICTXT, MYCOL, MYROW, NPCOL, NPROW
2277* ..
2278* .. Local Arrays ..
2279 INTEGER SCODE( NSUBS )
2280* ..
2281* .. External Subroutines ..
2282 EXTERNAL blacs_get, blacs_gridexit, blacs_gridinfo,
2283 $ blacs_gridinit, pddimee, pdgeadd, pdgemm,
2284 $ pdmatee, pdoptee, pdsymm, pdsyr2k, pdsyrk,
2285 $ pdtradd, pdtrmm, pdtrsm
2286* ..
2287* .. Common Blocks ..
2288 LOGICAL ABRTFLG
2289 INTEGER NOUT
2290 CHARACTER*7 SNAMES( NSUBS )
2291 COMMON /snamec/snames
2292 COMMON /pberrorc/nout, abrtflg
2293* ..
2294* .. Data Statements ..
2295 DATA scode/31, 32, 33, 35, 38, 38, 39, 40/
2296* ..
2297* .. Executable Statements ..
2298*
2299* Temporarily define blacs grid to include all processes so
2300* information can be broadcast to all processes.
2301*
2302 CALL blacs_get( -1, 0, ictxt )
2303 CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
2304 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
2305*
2306* Set ABRTFLG to FALSE so that the PBLAS error handler won't abort
2307* on errors during these tests and set the output device unit for
2308* it.
2309*
2310 abrtsav = abrtflg
2311 abrtflg = .false.
2312 nout = inout
2313*
2314* Test PDGEMM
2315*
2316 i = 1
2317 IF( ltest( i ) ) THEN
2318 CALL pdoptee( ictxt, nout, pdgemm, scode( i ), snames( i ) )
2319 CALL pddimee( ictxt, nout, pdgemm, scode( i ), snames( i ) )
2320 CALL pdmatee( ictxt, nout, pdgemm, scode( i ), snames( i ) )
2321 END IF
2322*
2323* Test PDSYMM
2324*
2325 i = i + 1
2326 IF( ltest( i ) ) THEN
2327 CALL pdoptee( ictxt, nout, pdsymm, scode( i ), snames( i ) )
2328 CALL pddimee( ictxt, nout, pdsymm, scode( i ), snames( i ) )
2329 CALL pdmatee( ictxt, nout, pdsymm, scode( i ), snames( i ) )
2330 END IF
2331*
2332* Test PDSYRK
2333*
2334 i = i + 1
2335 IF( ltest( i ) ) THEN
2336 CALL pdoptee( ictxt, nout, pdsyrk, scode( i ), snames( i ) )
2337 CALL pddimee( ictxt, nout, pdsyrk, scode( i ), snames( i ) )
2338 CALL pdmatee( ictxt, nout, pdsyrk, scode( i ), snames( i ) )
2339 END IF
2340*
2341* Test PDSYR2K
2342*
2343 i = i + 1
2344 IF( ltest( i ) ) THEN
2345 CALL pdoptee( ictxt, nout, pdsyr2k, scode( i ), snames( i ) )
2346 CALL pddimee( ictxt, nout, pdsyr2k, scode( i ), snames( i ) )
2347 CALL pdmatee( ictxt, nout, pdsyr2k, scode( i ), snames( i ) )
2348 END IF
2349*
2350* Test PDTRMM
2351*
2352 i = i + 1
2353 IF( ltest( i ) ) THEN
2354 CALL pdoptee( ictxt, nout, pdtrmm, scode( i ), snames( i ) )
2355 CALL pddimee( ictxt, nout, pdtrmm, scode( i ), snames( i ) )
2356 CALL pdmatee( ictxt, nout, pdtrmm, scode( i ), snames( i ) )
2357 END IF
2358*
2359* Test PDTRSM
2360*
2361 i = i + 1
2362 IF( ltest( i ) ) THEN
2363 CALL pdoptee( ictxt, nout, pdtrsm, scode( i ), snames( i ) )
2364 CALL pddimee( ictxt, nout, pdtrsm, scode( i ), snames( i ) )
2365 CALL pdmatee( ictxt, nout, pdtrsm, scode( i ), snames( i ) )
2366 END IF
2367*
2368* Test PDGEADD
2369*
2370 i = i + 1
2371 IF( ltest( i ) ) THEN
2372 CALL pdoptee( ictxt, nout, pdgeadd, scode( i ), snames( i ) )
2373 CALL pddimee( ictxt, nout, pdgeadd, scode( i ), snames( i ) )
2374 CALL pdmatee( ictxt, nout, pdgeadd, scode( i ), snames( i ) )
2375 END IF
2376*
2377* Test PDTRADD
2378*
2379 i = i + 1
2380 IF( ltest( i ) ) THEN
2381 CALL pdoptee( ictxt, nout, pdtradd, scode( i ), snames( i ) )
2382 CALL pddimee( ictxt, nout, pdtradd, scode( i ), snames( i ) )
2383 CALL pdmatee( ictxt, nout, pdtradd, scode( i ), snames( i ) )
2384 END IF
2385*
2386 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
2387 $ WRITE( nout, fmt = 9999 )
2388*
2389 CALL blacs_gridexit( ictxt )
2390*
2391* Reset ABRTFLG to the value it had before calling this routine
2392*
2393 abrtflg = abrtsav
2394*
2395 9999 FORMAT( 2x, 'Error-exit tests completed.' )
2396*
2397 RETURN
2398*
2399* End of PDBLAS3TSTCHKE
2400*
subroutine pdoptee(ictxt, nout, subptr, scode, sname)
Definition pdblastst.f:2
subroutine pdmatee(ictxt, nout, subptr, scode, sname)
Definition pdblastst.f:1190
subroutine pddimee(ictxt, nout, subptr, scode, sname)
Definition pdblastst.f:455
Here is the call graph for this function:
Here is the caller graph for this function: