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

◆ pschkarg3()

subroutine pschkarg3 ( integer  ictxt,
integer  nout,
character*7  sname,
character*1  side,
character*1  uplo,
character*1  transa,
character*1  transb,
character*1  diag,
integer  m,
integer  n,
integer  k,
real  alpha,
integer  ia,
integer  ja,
integer, dimension( * )  desca,
integer  ib,
integer  jb,
integer, dimension( * )  descb,
real  beta,
integer  ic,
integer  jc,
integer, dimension( * )  descc,
integer  info 
)

Definition at line 2400 of file psblas3tst.f.

2404*
2405* -- PBLAS test routine (version 2.0) --
2406* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
2407* and University of California, Berkeley.
2408* April 1, 1998
2409*
2410* .. Scalar Arguments ..
2411 CHARACTER*1 DIAG, SIDE, TRANSA, TRANSB, UPLO
2412 INTEGER IA, IB, IC, ICTXT, INFO, JA, JB, JC, K, M, N,
2413 $ NOUT
2414 REAL ALPHA, BETA
2415* ..
2416* .. Array Arguments ..
2417 CHARACTER*7 SNAME
2418 INTEGER DESCA( * ), DESCB( * ), DESCC( * )
2419* ..
2420*
2421* Purpose
2422* =======
2423*
2424* PSCHKARG3 checks the input-only arguments of the Level 3 PBLAS. When
2425* INFO = 0, this routine makes a copy of its arguments (which are INPUT
2426* only arguments to PBLAS routines). Otherwise, it verifies the values
2427* of these arguments against the saved copies.
2428*
2429* Arguments
2430* =========
2431*
2432* ICTXT (local input) INTEGER
2433* On entry, ICTXT specifies the BLACS context handle, indica-
2434* ting the global context of the operation. The context itself
2435* is global, but the value of ICTXT is local.
2436*
2437* NOUT (global input) INTEGER
2438* On entry, NOUT specifies the unit number for the output file.
2439* When NOUT is 6, output to screen, when NOUT is 0, output to
2440* stderr. NOUT is only defined for process 0.
2441*
2442* SNAME (global input) CHARACTER*(*)
2443* On entry, SNAME specifies the subroutine name calling this
2444* subprogram.
2445*
2446* SIDE (global input) CHARACTER*1
2447* On entry, SIDE specifies the SIDE option in the Level 3 PBLAS
2448* operation.
2449*
2450* UPLO (global input) CHARACTER*1
2451* On entry, UPLO specifies the UPLO option in the Level 3 PBLAS
2452* operation.
2453*
2454* TRANSA (global input) CHARACTER*1
2455* On entry, TRANSA specifies the TRANSA option in the Level 3
2456* PBLAS operation.
2457*
2458* TRANSB (global input) CHARACTER*1
2459* On entry, TRANSB specifies the TRANSB option in the Level 3
2460* PBLAS operation.
2461*
2462* DIAG (global input) CHARACTER*1
2463* On entry, DIAG specifies the DIAG option in the Level 3 PBLAS
2464* operation.
2465*
2466* M (global input) INTEGER
2467* On entry, M specifies the dimension of the submatrix ope-
2468* rands.
2469*
2470* N (global input) INTEGER
2471* On entry, N specifies the dimension of the submatrix ope-
2472* rands.
2473*
2474* K (global input) INTEGER
2475* On entry, K specifies the dimension of the submatrix ope-
2476* rands.
2477*
2478* ALPHA (global input) REAL
2479* On entry, ALPHA specifies the scalar alpha.
2480*
2481* IA (global input) INTEGER
2482* On entry, IA specifies A's global row index, which points to
2483* the beginning of the submatrix sub( A ).
2484*
2485* JA (global input) INTEGER
2486* On entry, JA specifies A's global column index, which points
2487* to the beginning of the submatrix sub( A ).
2488*
2489* DESCA (global and local input) INTEGER array
2490* On entry, DESCA is an integer array of dimension DLEN_. This
2491* is the array descriptor for the matrix A.
2492*
2493* IB (global input) INTEGER
2494* On entry, IB specifies B's global row index, which points to
2495* the beginning of the submatrix sub( B ).
2496*
2497* JB (global input) INTEGER
2498* On entry, JB specifies B's global column index, which points
2499* to the beginning of the submatrix sub( B ).
2500*
2501* DESCB (global and local input) INTEGER array
2502* On entry, DESCB is an integer array of dimension DLEN_. This
2503* is the array descriptor for the matrix B.
2504*
2505* BETA (global input) REAL
2506* On entry, BETA specifies the scalar beta.
2507*
2508* IC (global input) INTEGER
2509* On entry, IC specifies C's global row index, which points to
2510* the beginning of the submatrix sub( C ).
2511*
2512* JC (global input) INTEGER
2513* On entry, JC specifies C's global column index, which points
2514* to the beginning of the submatrix sub( C ).
2515*
2516* DESCC (global and local input) INTEGER array
2517* On entry, DESCC is an integer array of dimension DLEN_. This
2518* is the array descriptor for the matrix C.
2519*
2520* INFO (global input/global output) INTEGER
2521* When INFO = 0 on entry, the values of the arguments which are
2522* INPUT only arguments to a PBLAS routine are copied into sta-
2523* tic variables and INFO is unchanged on exit. Otherwise, the
2524* values of the arguments are compared against the saved co-
2525* pies. In case no error has been found INFO is zero on return,
2526* otherwise it is non zero.
2527*
2528* -- Written on April 1, 1998 by
2529* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
2530*
2531* =====================================================================
2532*
2533* .. Parameters ..
2534 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
2535 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
2536 $ RSRC_
2537 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
2538 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
2539 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
2540 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
2541* ..
2542* .. Local Scalars ..
2543 CHARACTER*1 DIAGREF, SIDEREF, TRANSAREF, TRANSBREF, UPLOREF
2544 INTEGER I, IAREF, IBREF, ICREF, JAREF, JBREF, JCREF,
2545 $ KREF, MREF, MYCOL, MYROW, NPCOL, NPROW, NREF
2546 REAL ALPHAREF, BETAREF
2547* ..
2548* .. Local Arrays ..
2549 CHARACTER*15 ARGNAME
2550 INTEGER DESCAREF( DLEN_ ), DESCBREF( DLEN_ ),
2551 $ DESCCREF( DLEN_ )
2552* ..
2553* .. External Subroutines ..
2554 EXTERNAL blacs_gridinfo, igsum2d
2555* ..
2556* .. External Functions ..
2557 LOGICAL LSAME
2558 EXTERNAL lsame
2559* ..
2560* .. Save Statements ..
2561 SAVE
2562* ..
2563* .. Executable Statements ..
2564*
2565* Get grid parameters
2566*
2567 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
2568*
2569* Check if first call. If yes, then save.
2570*
2571 IF( info.EQ.0 ) THEN
2572*
2573 diagref = diag
2574 sideref = side
2575 transaref = transa
2576 transbref = transb
2577 uploref = uplo
2578 mref = m
2579 nref = n
2580 kref = k
2581 alpharef = alpha
2582 iaref = ia
2583 jaref = ja
2584 DO 10 i = 1, dlen_
2585 descaref( i ) = desca( i )
2586 10 CONTINUE
2587 ibref = ib
2588 jbref = jb
2589 DO 20 i = 1, dlen_
2590 descbref( i ) = descb( i )
2591 20 CONTINUE
2592 betaref = beta
2593 icref = ic
2594 jcref = jc
2595 DO 30 i = 1, dlen_
2596 desccref( i ) = descc( i )
2597 30 CONTINUE
2598*
2599 ELSE
2600*
2601* Test saved args. Return with first mismatch.
2602*
2603 argname = ' '
2604 IF( .NOT. lsame( diag, diagref ) ) THEN
2605 WRITE( argname, fmt = '(A)' ) 'DIAG'
2606 ELSE IF( .NOT. lsame( side, sideref ) ) THEN
2607 WRITE( argname, fmt = '(A)' ) 'SIDE'
2608 ELSE IF( .NOT. lsame( transa, transaref ) ) THEN
2609 WRITE( argname, fmt = '(A)' ) 'TRANSA'
2610 ELSE IF( .NOT. lsame( transb, transbref ) ) THEN
2611 WRITE( argname, fmt = '(A)' ) 'TRANSB'
2612 ELSE IF( .NOT. lsame( uplo, uploref ) ) THEN
2613 WRITE( argname, fmt = '(A)' ) 'UPLO'
2614 ELSE IF( m.NE.mref ) THEN
2615 WRITE( argname, fmt = '(A)' ) 'M'
2616 ELSE IF( n.NE.nref ) THEN
2617 WRITE( argname, fmt = '(A)' ) 'N'
2618 ELSE IF( k.NE.kref ) THEN
2619 WRITE( argname, fmt = '(A)' ) 'K'
2620 ELSE IF( alpha.NE.alpharef ) THEN
2621 WRITE( argname, fmt = '(A)' ) 'ALPHA'
2622 ELSE IF( ia.NE.iaref ) THEN
2623 WRITE( argname, fmt = '(A)' ) 'IA'
2624 ELSE IF( ja.NE.jaref ) THEN
2625 WRITE( argname, fmt = '(A)' ) 'JA'
2626 ELSE IF( desca( dtype_ ).NE.descaref( dtype_ ) ) THEN
2627 WRITE( argname, fmt = '(A)' ) 'DESCA( DTYPE_ )'
2628 ELSE IF( desca( m_ ).NE.descaref( m_ ) ) THEN
2629 WRITE( argname, fmt = '(A)' ) 'DESCA( M_ )'
2630 ELSE IF( desca( n_ ).NE.descaref( n_ ) ) THEN
2631 WRITE( argname, fmt = '(A)' ) 'DESCA( N_ )'
2632 ELSE IF( desca( imb_ ).NE.descaref( imb_ ) ) THEN
2633 WRITE( argname, fmt = '(A)' ) 'DESCA( IMB_ )'
2634 ELSE IF( desca( inb_ ).NE.descaref( inb_ ) ) THEN
2635 WRITE( argname, fmt = '(A)' ) 'DESCA( INB_ )'
2636 ELSE IF( desca( mb_ ).NE.descaref( mb_ ) ) THEN
2637 WRITE( argname, fmt = '(A)' ) 'DESCA( MB_ )'
2638 ELSE IF( desca( nb_ ).NE.descaref( nb_ ) ) THEN
2639 WRITE( argname, fmt = '(A)' ) 'DESCA( NB_ )'
2640 ELSE IF( desca( rsrc_ ).NE.descaref( rsrc_ ) ) THEN
2641 WRITE( argname, fmt = '(A)' ) 'DESCA( RSRC_ )'
2642 ELSE IF( desca( csrc_ ).NE.descaref( csrc_ ) ) THEN
2643 WRITE( argname, fmt = '(A)' ) 'DESCA( CSRC_ )'
2644 ELSE IF( desca( ctxt_ ).NE.descaref( ctxt_ ) ) THEN
2645 WRITE( argname, fmt = '(A)' ) 'DESCA( CTXT_ )'
2646 ELSE IF( desca( lld_ ).NE.descaref( lld_ ) ) THEN
2647 WRITE( argname, fmt = '(A)' ) 'DESCA( LLD_ )'
2648 ELSE IF( ib.NE.ibref ) THEN
2649 WRITE( argname, fmt = '(A)' ) 'IB'
2650 ELSE IF( jb.NE.jbref ) THEN
2651 WRITE( argname, fmt = '(A)' ) 'JB'
2652 ELSE IF( descb( dtype_ ).NE.descbref( dtype_ ) ) THEN
2653 WRITE( argname, fmt = '(A)' ) 'DESCB( DTYPE_ )'
2654 ELSE IF( descb( m_ ).NE.descbref( m_ ) ) THEN
2655 WRITE( argname, fmt = '(A)' ) 'DESCB( M_ )'
2656 ELSE IF( descb( n_ ).NE.descbref( n_ ) ) THEN
2657 WRITE( argname, fmt = '(A)' ) 'DESCB( N_ )'
2658 ELSE IF( descb( imb_ ).NE.descbref( imb_ ) ) THEN
2659 WRITE( argname, fmt = '(A)' ) 'DESCB( IMB_ )'
2660 ELSE IF( descb( inb_ ).NE.descbref( inb_ ) ) THEN
2661 WRITE( argname, fmt = '(A)' ) 'DESCB( INB_ )'
2662 ELSE IF( descb( mb_ ).NE.descbref( mb_ ) ) THEN
2663 WRITE( argname, fmt = '(A)' ) 'DESCB( MB_ )'
2664 ELSE IF( descb( nb_ ).NE.descbref( nb_ ) ) THEN
2665 WRITE( argname, fmt = '(A)' ) 'DESCB( NB_ )'
2666 ELSE IF( descb( rsrc_ ).NE.descbref( rsrc_ ) ) THEN
2667 WRITE( argname, fmt = '(A)' ) 'DESCB( RSRC_ )'
2668 ELSE IF( descb( csrc_ ).NE.descbref( csrc_ ) ) THEN
2669 WRITE( argname, fmt = '(A)' ) 'DESCB( CSRC_ )'
2670 ELSE IF( descb( ctxt_ ).NE.descbref( ctxt_ ) ) THEN
2671 WRITE( argname, fmt = '(A)' ) 'DESCB( CTXT_ )'
2672 ELSE IF( descb( lld_ ).NE.descbref( lld_ ) ) THEN
2673 WRITE( argname, fmt = '(A)' ) 'DESCB( LLD_ )'
2674 ELSE IF( beta.NE.betaref ) THEN
2675 WRITE( argname, fmt = '(A)' ) 'BETA'
2676 ELSE IF( ic.NE.icref ) THEN
2677 WRITE( argname, fmt = '(A)' ) 'IC'
2678 ELSE IF( jc.NE.jcref ) THEN
2679 WRITE( argname, fmt = '(A)' ) 'JC'
2680 ELSE IF( descc( dtype_ ).NE.desccref( dtype_ ) ) THEN
2681 WRITE( argname, fmt = '(A)' ) 'DESCC( DTYPE_ )'
2682 ELSE IF( descc( m_ ).NE.desccref( m_ ) ) THEN
2683 WRITE( argname, fmt = '(A)' ) 'DESCC( M_ )'
2684 ELSE IF( descc( n_ ).NE.desccref( n_ ) ) THEN
2685 WRITE( argname, fmt = '(A)' ) 'DESCC( N_ )'
2686 ELSE IF( descc( imb_ ).NE.desccref( imb_ ) ) THEN
2687 WRITE( argname, fmt = '(A)' ) 'DESCC( IMB_ )'
2688 ELSE IF( descc( inb_ ).NE.desccref( inb_ ) ) THEN
2689 WRITE( argname, fmt = '(A)' ) 'DESCC( INB_ )'
2690 ELSE IF( descc( mb_ ).NE.desccref( mb_ ) ) THEN
2691 WRITE( argname, fmt = '(A)' ) 'DESCC( MB_ )'
2692 ELSE IF( descc( nb_ ).NE.desccref( nb_ ) ) THEN
2693 WRITE( argname, fmt = '(A)' ) 'DESCC( NB_ )'
2694 ELSE IF( descc( rsrc_ ).NE.desccref( rsrc_ ) ) THEN
2695 WRITE( argname, fmt = '(A)' ) 'DESCC( RSRC_ )'
2696 ELSE IF( descc( csrc_ ).NE.desccref( csrc_ ) ) THEN
2697 WRITE( argname, fmt = '(A)' ) 'DESCC( CSRC_ )'
2698 ELSE IF( descc( ctxt_ ).NE.desccref( ctxt_ ) ) THEN
2699 WRITE( argname, fmt = '(A)' ) 'DESCC( CTXT_ )'
2700 ELSE IF( descc( lld_ ).NE.desccref( lld_ ) ) THEN
2701 WRITE( argname, fmt = '(A)' ) 'DESCC( LLD_ )'
2702 ELSE
2703 info = 0
2704 END IF
2705*
2706 CALL igsum2d( ictxt, 'All', ' ', 1, 1, info, 1, -1, 0 )
2707*
2708 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
2709*
2710 IF( info.NE.0 ) THEN
2711 WRITE( nout, fmt = 9999 ) argname, sname
2712 ELSE
2713 WRITE( nout, fmt = 9998 ) sname
2714 END IF
2715*
2716 END IF
2717*
2718 END IF
2719*
2720 9999 FORMAT( 2x, ' ***** Input-only parameter check: ', a,
2721 $ ' FAILED changed ', a, ' *****' )
2722 9998 FORMAT( 2x, ' ***** Input-only parameter check: ', a,
2723 $ ' PASSED *****' )
2724*
2725 RETURN
2726*
2727* End of PSCHKARG3
2728*
lsame
logical function lsame(ca, cb)
Definition tools.f:1724
Here is the caller graph for this function: