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

◆ pcchkarg2()

subroutine pcchkarg2 ( integer  ictxt,
integer  nout,
character*(*)  sname,
character*1  uplo,
character*1  trans,
character*1  diag,
integer  m,
integer  n,
complex  alpha,
integer  ia,
integer  ja,
integer, dimension( * )  desca,
integer  ix,
integer  jx,
integer, dimension( * )  descx,
integer  incx,
complex  beta,
integer  iy,
integer  jy,
integer, dimension( * )  descy,
integer  incy,
integer  info 
)

Definition at line 2238 of file pcblas2tst.f.

2241*
2242* -- PBLAS test routine (version 2.0) --
2243* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
2244* and University of California, Berkeley.
2245* April 1, 1998
2246*
2247* .. Scalar Arguments ..
2248 CHARACTER*1 DIAG, TRANS, UPLO
2249 INTEGER IA, ICTXT, INCX, INCY, INFO, IX, IY, JA, JX,
2250 $ JY, M, N, NOUT
2251 COMPLEX ALPHA, BETA
2252* ..
2253* .. Array Arguments ..
2254 CHARACTER*(*) SNAME
2255 INTEGER DESCA( * ), DESCX( * ), DESCY( * )
2256* ..
2257*
2258* Purpose
2259* =======
2260*
2261* PCCHKARG2 checks the input-only arguments of the Level 2 PBLAS. When
2262* INFO = 0, this routine makes a copy of its arguments (which are INPUT
2263* only arguments to PBLAS routines). Otherwise, it verifies the values
2264* of these arguments against the saved copies.
2265*
2266* Arguments
2267* =========
2268*
2269* ICTXT (local input) INTEGER
2270* On entry, ICTXT specifies the BLACS context handle, indica-
2271* ting the global context of the operation. The context itself
2272* is global, but the value of ICTXT is local.
2273*
2274* NOUT (global input) INTEGER
2275* On entry, NOUT specifies the unit number for the output file.
2276* When NOUT is 6, output to screen, when NOUT is 0, output to
2277* stderr. NOUT is only defined for process 0.
2278*
2279* SNAME (global input) CHARACTER*(*)
2280* On entry, SNAME specifies the subroutine name calling this
2281* subprogram.
2282*
2283* UPLO (global input) CHARACTER*1
2284* On entry, UPLO specifies the UPLO option in the Level 2 PBLAS
2285* operation.
2286*
2287* TRANS (global input) CHARACTER*1
2288* On entry, TRANS specifies the TRANS option in the Level 2
2289* PBLAS operation.
2290*
2291* DIAG (global input) CHARACTER*1
2292* On entry, DIAG specifies the DIAG option in the Level 2 PBLAS
2293* operation.
2294*
2295* M (global input) INTEGER
2296* On entry, M specifies the dimension of the submatrix ope-
2297* rands.
2298*
2299* N (global input) INTEGER
2300* On entry, N specifies the dimension of the submatrix ope-
2301* rands.
2302*
2303* ALPHA (global input) COMPLEX
2304* On entry, ALPHA specifies the scalar alpha.
2305*
2306* IA (global input) INTEGER
2307* On entry, IA specifies A's global row index, which points to
2308* the beginning of the submatrix sub( A ).
2309*
2310* JA (global input) INTEGER
2311* On entry, JA specifies A's global column index, which points
2312* to the beginning of the submatrix sub( A ).
2313*
2314* DESCA (global and local input) INTEGER array
2315* On entry, DESCA is an integer array of dimension DLEN_. This
2316* is the array descriptor for the matrix A.
2317*
2318* IX (global input) INTEGER
2319* On entry, IX specifies X's global row index, which points to
2320* the beginning of the submatrix sub( X ).
2321*
2322* JX (global input) INTEGER
2323* On entry, JX specifies X's global column index, which points
2324* to the beginning of the submatrix sub( X ).
2325*
2326* DESCX (global and local input) INTEGER array
2327* On entry, DESCX is an integer array of dimension DLEN_. This
2328* is the array descriptor for the matrix X.
2329*
2330* INCX (global input) INTEGER
2331* On entry, INCX specifies the global increment for the
2332* elements of X. Only two values of INCX are supported in
2333* this version, namely 1 and M_X. INCX must not be zero.
2334*
2335* BETA (global input) COMPLEX
2336* On entry, BETA specifies the scalar beta.
2337*
2338* IY (global input) INTEGER
2339* On entry, IY specifies Y's global row index, which points to
2340* the beginning of the submatrix sub( Y ).
2341*
2342* JY (global input) INTEGER
2343* On entry, JY specifies Y's global column index, which points
2344* to the beginning of the submatrix sub( Y ).
2345*
2346* DESCY (global and local input) INTEGER array
2347* On entry, DESCY is an integer array of dimension DLEN_. This
2348* is the array descriptor for the matrix Y.
2349*
2350* INCY (global input) INTEGER
2351* On entry, INCY specifies the global increment for the
2352* elements of Y. Only two values of INCY are supported in
2353* this version, namely 1 and M_Y. INCY must not be zero.
2354*
2355* INFO (global input/global output) INTEGER
2356* When INFO = 0 on entry, the values of the arguments which are
2357* INPUT only arguments to a PBLAS routine are copied into sta-
2358* tic variables and INFO is unchanged on exit. Otherwise, the
2359* values of the arguments are compared against the saved co-
2360* pies. In case no error has been found INFO is zero on return,
2361* otherwise it is non zero.
2362*
2363* -- Written on April 1, 1998 by
2364* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
2365*
2366* =====================================================================
2367*
2368* .. Parameters ..
2369 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
2370 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
2371 $ RSRC_
2372 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
2373 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
2374 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
2375 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
2376* ..
2377* .. Local Scalars ..
2378 CHARACTER*1 DIAGREF, TRANSREF, UPLOREF
2379 INTEGER I, IAREF, INCXREF, INCYREF, IXREF, IYREF,
2380 $ JAREF, JXREF, JYREF, MREF, MYCOL, MYROW, NPCOL,
2381 $ NPROW, NREF
2382 COMPLEX ALPHAREF, BETAREF
2383* ..
2384* .. Local Arrays ..
2385 CHARACTER*15 ARGNAME
2386 INTEGER DESCAREF( DLEN_ ), DESCXREF( DLEN_ ),
2387 $ DESCYREF( DLEN_ )
2388* ..
2389* .. External Subroutines ..
2390 EXTERNAL blacs_gridinfo, igsum2d
2391* ..
2392* .. External Functions ..
2393 LOGICAL LSAME
2394 EXTERNAL lsame
2395* ..
2396* .. Save Statements ..
2397 SAVE
2398* ..
2399* .. Executable Statements ..
2400*
2401* Get grid parameters
2402*
2403 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
2404*
2405* Check if first call. If yes, then save.
2406*
2407 IF( info.EQ.0 ) THEN
2408*
2409 diagref = diag
2410 transref = trans
2411 uploref = uplo
2412 mref = m
2413 nref = n
2414 alpharef = alpha
2415 iaref = ia
2416 jaref = ja
2417 DO 10 i = 1, dlen_
2418 descaref( i ) = desca( i )
2419 10 CONTINUE
2420 ixref = ix
2421 jxref = jx
2422 DO 20 i = 1, dlen_
2423 descxref( i ) = descx( i )
2424 20 CONTINUE
2425 incxref = incx
2426 betaref = beta
2427 iyref = iy
2428 jyref = jy
2429 DO 30 i = 1, dlen_
2430 descyref( i ) = descy( i )
2431 30 CONTINUE
2432 incyref = incy
2433*
2434 ELSE
2435*
2436* Test saved args. Return with first mismatch.
2437*
2438 argname = ' '
2439 IF( .NOT. lsame( diag, diagref ) ) THEN
2440 WRITE( argname, fmt = '(A)' ) 'DIAG'
2441 ELSE IF( .NOT. lsame( trans, transref ) ) THEN
2442 WRITE( argname, fmt = '(A)' ) 'TRANS'
2443 ELSE IF( .NOT. lsame( uplo, uploref ) ) THEN
2444 WRITE( argname, fmt = '(A)' ) 'UPLO'
2445 ELSE IF( m.NE.mref ) THEN
2446 WRITE( argname, fmt = '(A)' ) 'M'
2447 ELSE IF( n.NE.nref ) THEN
2448 WRITE( argname, fmt = '(A)' ) 'N'
2449 ELSE IF( alpha.NE.alpharef ) THEN
2450 WRITE( argname, fmt = '(A)' ) 'ALPHA'
2451 ELSE IF( ia.NE.iaref ) THEN
2452 WRITE( argname, fmt = '(A)' ) 'IA'
2453 ELSE IF( ja.NE.jaref ) THEN
2454 WRITE( argname, fmt = '(A)' ) 'JA'
2455 ELSE IF( desca( dtype_ ).NE.descaref( dtype_ ) ) THEN
2456 WRITE( argname, fmt = '(A)' ) 'DESCA( DTYPE_ )'
2457 ELSE IF( desca( m_ ).NE.descaref( m_ ) ) THEN
2458 WRITE( argname, fmt = '(A)' ) 'DESCA( M_ )'
2459 ELSE IF( desca( n_ ).NE.descaref( n_ ) ) THEN
2460 WRITE( argname, fmt = '(A)' ) 'DESCA( N_ )'
2461 ELSE IF( desca( imb_ ).NE.descaref( imb_ ) ) THEN
2462 WRITE( argname, fmt = '(A)' ) 'DESCA( IMB_ )'
2463 ELSE IF( desca( inb_ ).NE.descaref( inb_ ) ) THEN
2464 WRITE( argname, fmt = '(A)' ) 'DESCA( INB_ )'
2465 ELSE IF( desca( mb_ ).NE.descaref( mb_ ) ) THEN
2466 WRITE( argname, fmt = '(A)' ) 'DESCA( MB_ )'
2467 ELSE IF( desca( nb_ ).NE.descaref( nb_ ) ) THEN
2468 WRITE( argname, fmt = '(A)' ) 'DESCA( NB_ )'
2469 ELSE IF( desca( rsrc_ ).NE.descaref( rsrc_ ) ) THEN
2470 WRITE( argname, fmt = '(A)' ) 'DESCA( RSRC_ )'
2471 ELSE IF( desca( csrc_ ).NE.descaref( csrc_ ) ) THEN
2472 WRITE( argname, fmt = '(A)' ) 'DESCA( CSRC_ )'
2473 ELSE IF( desca( ctxt_ ).NE.descaref( ctxt_ ) ) THEN
2474 WRITE( argname, fmt = '(A)' ) 'DESCA( CTXT_ )'
2475 ELSE IF( desca( lld_ ).NE.descaref( lld_ ) ) THEN
2476 WRITE( argname, fmt = '(A)' ) 'DESCA( LLD_ )'
2477 ELSE IF( ix.NE.ixref ) THEN
2478 WRITE( argname, fmt = '(A)' ) 'IX'
2479 ELSE IF( jx.NE.jxref ) THEN
2480 WRITE( argname, fmt = '(A)' ) 'JX'
2481 ELSE IF( descx( dtype_ ).NE.descxref( dtype_ ) ) THEN
2482 WRITE( argname, fmt = '(A)' ) 'DESCX( DTYPE_ )'
2483 ELSE IF( descx( m_ ).NE.descxref( m_ ) ) THEN
2484 WRITE( argname, fmt = '(A)' ) 'DESCX( M_ )'
2485 ELSE IF( descx( n_ ).NE.descxref( n_ ) ) THEN
2486 WRITE( argname, fmt = '(A)' ) 'DESCX( N_ )'
2487 ELSE IF( descx( imb_ ).NE.descxref( imb_ ) ) THEN
2488 WRITE( argname, fmt = '(A)' ) 'DESCX( IMB_ )'
2489 ELSE IF( descx( inb_ ).NE.descxref( inb_ ) ) THEN
2490 WRITE( argname, fmt = '(A)' ) 'DESCX( INB_ )'
2491 ELSE IF( descx( mb_ ).NE.descxref( mb_ ) ) THEN
2492 WRITE( argname, fmt = '(A)' ) 'DESCX( MB_ )'
2493 ELSE IF( descx( nb_ ).NE.descxref( nb_ ) ) THEN
2494 WRITE( argname, fmt = '(A)' ) 'DESCX( NB_ )'
2495 ELSE IF( descx( rsrc_ ).NE.descxref( rsrc_ ) ) THEN
2496 WRITE( argname, fmt = '(A)' ) 'DESCX( RSRC_ )'
2497 ELSE IF( descx( csrc_ ).NE.descxref( csrc_ ) ) THEN
2498 WRITE( argname, fmt = '(A)' ) 'DESCX( CSRC_ )'
2499 ELSE IF( descx( ctxt_ ).NE.descxref( ctxt_ ) ) THEN
2500 WRITE( argname, fmt = '(A)' ) 'DESCX( CTXT_ )'
2501 ELSE IF( descx( lld_ ).NE.descxref( lld_ ) ) THEN
2502 WRITE( argname, fmt = '(A)' ) 'DESCX( LLD_ )'
2503 ELSE IF( incx.NE.incxref ) THEN
2504 WRITE( argname, fmt = '(A)' ) 'INCX'
2505 ELSE IF( beta.NE.betaref ) THEN
2506 WRITE( argname, fmt = '(A)' ) 'BETA'
2507 ELSE IF( iy.NE.iyref ) THEN
2508 WRITE( argname, fmt = '(A)' ) 'IY'
2509 ELSE IF( jy.NE.jyref ) THEN
2510 WRITE( argname, fmt = '(A)' ) 'JY'
2511 ELSE IF( descy( dtype_ ).NE.descyref( dtype_ ) ) THEN
2512 WRITE( argname, fmt = '(A)' ) 'DESCY( DTYPE_ )'
2513 ELSE IF( descy( m_ ).NE.descyref( m_ ) ) THEN
2514 WRITE( argname, fmt = '(A)' ) 'DESCY( M_ )'
2515 ELSE IF( descy( n_ ).NE.descyref( n_ ) ) THEN
2516 WRITE( argname, fmt = '(A)' ) 'DESCY( N_ )'
2517 ELSE IF( descy( imb_ ).NE.descyref( imb_ ) ) THEN
2518 WRITE( argname, fmt = '(A)' ) 'DESCY( IMB_ )'
2519 ELSE IF( descy( inb_ ).NE.descyref( inb_ ) ) THEN
2520 WRITE( argname, fmt = '(A)' ) 'DESCY( INB_ )'
2521 ELSE IF( descy( mb_ ).NE.descyref( mb_ ) ) THEN
2522 WRITE( argname, fmt = '(A)' ) 'DESCY( MB_ )'
2523 ELSE IF( descy( nb_ ).NE.descyref( nb_ ) ) THEN
2524 WRITE( argname, fmt = '(A)' ) 'DESCY( NB_ )'
2525 ELSE IF( descy( rsrc_ ).NE.descyref( rsrc_ ) ) THEN
2526 WRITE( argname, fmt = '(A)' ) 'DESCY( RSRC_ )'
2527 ELSE IF( descy( csrc_ ).NE.descyref( csrc_ ) ) THEN
2528 WRITE( argname, fmt = '(A)' ) 'DESCY( CSRC_ )'
2529 ELSE IF( descy( ctxt_ ).NE.descyref( ctxt_ ) ) THEN
2530 WRITE( argname, fmt = '(A)' ) 'DESCY( CTXT_ )'
2531 ELSE IF( descy( lld_ ).NE.descyref( lld_ ) ) THEN
2532 WRITE( argname, fmt = '(A)' ) 'DESCY( LLD_ )'
2533 ELSE IF( incy.NE.incyref ) THEN
2534 WRITE( argname, fmt = '(A)' ) 'INCY'
2535 ELSE
2536 info = 0
2537 END IF
2538*
2539 CALL igsum2d( ictxt, 'All', ' ', 1, 1, info, 1, -1, 0 )
2540*
2541 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
2542*
2543 IF( info.NE.0 ) THEN
2544 WRITE( nout, fmt = 9999 ) argname, sname
2545 ELSE
2546 WRITE( nout, fmt = 9998 ) sname
2547 END IF
2548*
2549 END IF
2550*
2551 END IF
2552*
2553 9999 FORMAT( 2x, ' ***** Input-only parameter check: ', a,
2554 $ ' FAILED changed ', a, ' *****' )
2555 9998 FORMAT( 2x, ' ***** Input-only parameter check: ', a,
2556 $ ' PASSED *****' )
2557*
2558 RETURN
2559*
2560* End of PCCHKARG2
2561*
lsame
logical function lsame(ca, cb)
Definition tools.f:1724
Here is the caller graph for this function: