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

◆ pdchkarg3()

subroutine pdchkarg3 ( 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,
double precision  alpha,
integer  ia,
integer  ja,
integer, dimension( * )  desca,
integer  ib,
integer  jb,
integer, dimension( * )  descb,
double precision  beta,
integer  ic,
integer  jc,
integer, dimension( * )  descc,
integer  info 
)

Definition at line 2402 of file pdblas3tst.f.

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