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

◆ pdchkarg2()

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

Definition at line 2195 of file pdblas2tst.f.

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