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

◆ pschkarg2()

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

Definition at line 2193 of file psblas2tst.f.

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