2194
2195
2196
2197
2198
2199
2200
2201 INTEGER INOUT, NPROCS
2202
2203
2204 LOGICAL LTEST( * )
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271 INTEGER NSUBS
2272 parameter( nsubs = 8 )
2273
2274
2275 LOGICAL ABRTSAV
2276 INTEGER I, ICTXT, MYCOL, MYROW, NPCOL, NPROW
2277
2278
2279 INTEGER SCODE( NSUBS )
2280
2281
2282 EXTERNAL blacs_get, blacs_gridexit, blacs_gridinfo,
2283 $ blacs_gridinit,
pddimee, pdgeadd, pdgemm,
2285 $ pdtradd, pdtrmm, pdtrsm
2286
2287
2288 LOGICAL ABRTFLG
2289 INTEGER NOUT
2290 CHARACTER*7 SNAMES( NSUBS )
2291 COMMON /snamec/snames
2292 COMMON /pberrorc/nout, abrtflg
2293
2294
2295 DATA scode/31, 32, 33, 35, 38, 38, 39, 40/
2296
2297
2298
2299
2300
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
2307
2308
2309
2310 abrtsav = abrtflg
2311 abrtflg = .false.
2312 nout = inout
2313
2314
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
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
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
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
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
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
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
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
2392
2393 abrtflg = abrtsav
2394
2395 9999 FORMAT( 2x, 'Error-exit tests completed.' )
2396
2397 RETURN
2398
2399
2400
subroutine pdoptee(ictxt, nout, subptr, scode, sname)
subroutine pdmatee(ictxt, nout, subptr, scode, sname)
subroutine pddimee(ictxt, nout, subptr, scode, sname)