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

◆ pcchkarg3()

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

Definition at line 2535 of file pcblas3tst.f.

2539*
2540* -- PBLAS test routine (version 2.0) --
2541* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
2542* and University of California, Berkeley.
2543* April 1, 1998
2544*
2545* .. Scalar Arguments ..
2546 CHARACTER*1 DIAG, SIDE, TRANSA, TRANSB, UPLO
2547 INTEGER IA, IB, IC, ICTXT, INFO, JA, JB, JC, K, M, N,
2548 $ NOUT
2549 COMPLEX ALPHA, BETA
2550* ..
2551* .. Array Arguments ..
2552 CHARACTER*7 SNAME
2553 INTEGER DESCA( * ), DESCB( * ), DESCC( * )
2554* ..
2555*
2556* Purpose
2557* =======
2558*
2559* PCCHKARG3 checks the input-only arguments of the Level 3 PBLAS. When
2560* INFO = 0, this routine makes a copy of its arguments (which are INPUT
2561* only arguments to PBLAS routines). Otherwise, it verifies the values
2562* of these arguments against the saved copies.
2563*
2564* Arguments
2565* =========
2566*
2567* ICTXT (local input) INTEGER
2568* On entry, ICTXT specifies the BLACS context handle, indica-
2569* ting the global context of the operation. The context itself
2570* is global, but the value of ICTXT is local.
2571*
2572* NOUT (global input) INTEGER
2573* On entry, NOUT specifies the unit number for the output file.
2574* When NOUT is 6, output to screen, when NOUT is 0, output to
2575* stderr. NOUT is only defined for process 0.
2576*
2577* SNAME (global input) CHARACTER*(*)
2578* On entry, SNAME specifies the subroutine name calling this
2579* subprogram.
2580*
2581* SIDE (global input) CHARACTER*1
2582* On entry, SIDE specifies the SIDE option in the Level 3 PBLAS
2583* operation.
2584*
2585* UPLO (global input) CHARACTER*1
2586* On entry, UPLO specifies the UPLO option in the Level 3 PBLAS
2587* operation.
2588*
2589* TRANSA (global input) CHARACTER*1
2590* On entry, TRANSA specifies the TRANSA option in the Level 3
2591* PBLAS operation.
2592*
2593* TRANSB (global input) CHARACTER*1
2594* On entry, TRANSB specifies the TRANSB option in the Level 3
2595* PBLAS operation.
2596*
2597* DIAG (global input) CHARACTER*1
2598* On entry, DIAG specifies the DIAG option in the Level 3 PBLAS
2599* operation.
2600*
2601* M (global input) INTEGER
2602* On entry, M specifies the dimension of the submatrix ope-
2603* rands.
2604*
2605* N (global input) INTEGER
2606* On entry, N specifies the dimension of the submatrix ope-
2607* rands.
2608*
2609* K (global input) INTEGER
2610* On entry, K specifies the dimension of the submatrix ope-
2611* rands.
2612*
2613* ALPHA (global input) COMPLEX
2614* On entry, ALPHA specifies the scalar alpha.
2615*
2616* IA (global input) INTEGER
2617* On entry, IA specifies A's global row index, which points to
2618* the beginning of the submatrix sub( A ).
2619*
2620* JA (global input) INTEGER
2621* On entry, JA specifies A's global column index, which points
2622* to the beginning of the submatrix sub( A ).
2623*
2624* DESCA (global and local input) INTEGER array
2625* On entry, DESCA is an integer array of dimension DLEN_. This
2626* is the array descriptor for the matrix A.
2627*
2628* IB (global input) INTEGER
2629* On entry, IB specifies B's global row index, which points to
2630* the beginning of the submatrix sub( B ).
2631*
2632* JB (global input) INTEGER
2633* On entry, JB specifies B's global column index, which points
2634* to the beginning of the submatrix sub( B ).
2635*
2636* DESCB (global and local input) INTEGER array
2637* On entry, DESCB is an integer array of dimension DLEN_. This
2638* is the array descriptor for the matrix B.
2639*
2640* BETA (global input) COMPLEX
2641* On entry, BETA specifies the scalar beta.
2642*
2643* IC (global input) INTEGER
2644* On entry, IC specifies C's global row index, which points to
2645* the beginning of the submatrix sub( C ).
2646*
2647* JC (global input) INTEGER
2648* On entry, JC specifies C's global column index, which points
2649* to the beginning of the submatrix sub( C ).
2650*
2651* DESCC (global and local input) INTEGER array
2652* On entry, DESCC is an integer array of dimension DLEN_. This
2653* is the array descriptor for the matrix C.
2654*
2655* INFO (global input/global output) INTEGER
2656* When INFO = 0 on entry, the values of the arguments which are
2657* INPUT only arguments to a PBLAS routine are copied into sta-
2658* tic variables and INFO is unchanged on exit. Otherwise, the
2659* values of the arguments are compared against the saved co-
2660* pies. In case no error has been found INFO is zero on return,
2661* otherwise it is non zero.
2662*
2663* -- Written on April 1, 1998 by
2664* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
2665*
2666* =====================================================================
2667*
2668* .. Parameters ..
2669 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
2670 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
2671 $ RSRC_
2672 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
2673 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
2674 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
2675 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
2676* ..
2677* .. Local Scalars ..
2678 CHARACTER*1 DIAGREF, SIDEREF, TRANSAREF, TRANSBREF, UPLOREF
2679 INTEGER I, IAREF, IBREF, ICREF, JAREF, JBREF, JCREF,
2680 $ KREF, MREF, MYCOL, MYROW, NPCOL, NPROW, NREF
2681 COMPLEX ALPHAREF, BETAREF
2682* ..
2683* .. Local Arrays ..
2684 CHARACTER*15 ARGNAME
2685 INTEGER DESCAREF( DLEN_ ), DESCBREF( DLEN_ ),
2686 $ DESCCREF( DLEN_ )
2687* ..
2688* .. External Subroutines ..
2689 EXTERNAL blacs_gridinfo, igsum2d
2690* ..
2691* .. External Functions ..
2692 LOGICAL LSAME
2693 EXTERNAL lsame
2694* ..
2695* .. Save Statements ..
2696 SAVE
2697* ..
2698* .. Executable Statements ..
2699*
2700* Get grid parameters
2701*
2702 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
2703*
2704* Check if first call. If yes, then save.
2705*
2706 IF( info.EQ.0 ) THEN
2707*
2708 diagref = diag
2709 sideref = side
2710 transaref = transa
2711 transbref = transb
2712 uploref = uplo
2713 mref = m
2714 nref = n
2715 kref = k
2716 alpharef = alpha
2717 iaref = ia
2718 jaref = ja
2719 DO 10 i = 1, dlen_
2720 descaref( i ) = desca( i )
2721 10 CONTINUE
2722 ibref = ib
2723 jbref = jb
2724 DO 20 i = 1, dlen_
2725 descbref( i ) = descb( i )
2726 20 CONTINUE
2727 betaref = beta
2728 icref = ic
2729 jcref = jc
2730 DO 30 i = 1, dlen_
2731 desccref( i ) = descc( i )
2732 30 CONTINUE
2733*
2734 ELSE
2735*
2736* Test saved args. Return with first mismatch.
2737*
2738 argname = ' '
2739 IF( .NOT. lsame( diag, diagref ) ) THEN
2740 WRITE( argname, fmt = '(A)' ) 'DIAG'
2741 ELSE IF( .NOT. lsame( side, sideref ) ) THEN
2742 WRITE( argname, fmt = '(A)' ) 'SIDE'
2743 ELSE IF( .NOT. lsame( transa, transaref ) ) THEN
2744 WRITE( argname, fmt = '(A)' ) 'TRANSA'
2745 ELSE IF( .NOT. lsame( transb, transbref ) ) THEN
2746 WRITE( argname, fmt = '(A)' ) 'TRANSB'
2747 ELSE IF( .NOT. lsame( uplo, uploref ) ) THEN
2748 WRITE( argname, fmt = '(A)' ) 'UPLO'
2749 ELSE IF( m.NE.mref ) THEN
2750 WRITE( argname, fmt = '(A)' ) 'M'
2751 ELSE IF( n.NE.nref ) THEN
2752 WRITE( argname, fmt = '(A)' ) 'N'
2753 ELSE IF( k.NE.kref ) THEN
2754 WRITE( argname, fmt = '(A)' ) 'K'
2755 ELSE IF( alpha.NE.alpharef ) THEN
2756 WRITE( argname, fmt = '(A)' ) 'ALPHA'
2757 ELSE IF( ia.NE.iaref ) THEN
2758 WRITE( argname, fmt = '(A)' ) 'IA'
2759 ELSE IF( ja.NE.jaref ) THEN
2760 WRITE( argname, fmt = '(A)' ) 'JA'
2761 ELSE IF( desca( dtype_ ).NE.descaref( dtype_ ) ) THEN
2762 WRITE( argname, fmt = '(A)' ) 'DESCA( DTYPE_ )'
2763 ELSE IF( desca( m_ ).NE.descaref( m_ ) ) THEN
2764 WRITE( argname, fmt = '(A)' ) 'DESCA( M_ )'
2765 ELSE IF( desca( n_ ).NE.descaref( n_ ) ) THEN
2766 WRITE( argname, fmt = '(A)' ) 'DESCA( N_ )'
2767 ELSE IF( desca( imb_ ).NE.descaref( imb_ ) ) THEN
2768 WRITE( argname, fmt = '(A)' ) 'DESCA( IMB_ )'
2769 ELSE IF( desca( inb_ ).NE.descaref( inb_ ) ) THEN
2770 WRITE( argname, fmt = '(A)' ) 'DESCA( INB_ )'
2771 ELSE IF( desca( mb_ ).NE.descaref( mb_ ) ) THEN
2772 WRITE( argname, fmt = '(A)' ) 'DESCA( MB_ )'
2773 ELSE IF( desca( nb_ ).NE.descaref( nb_ ) ) THEN
2774 WRITE( argname, fmt = '(A)' ) 'DESCA( NB_ )'
2775 ELSE IF( desca( rsrc_ ).NE.descaref( rsrc_ ) ) THEN
2776 WRITE( argname, fmt = '(A)' ) 'DESCA( RSRC_ )'
2777 ELSE IF( desca( csrc_ ).NE.descaref( csrc_ ) ) THEN
2778 WRITE( argname, fmt = '(A)' ) 'DESCA( CSRC_ )'
2779 ELSE IF( desca( ctxt_ ).NE.descaref( ctxt_ ) ) THEN
2780 WRITE( argname, fmt = '(A)' ) 'DESCA( CTXT_ )'
2781 ELSE IF( desca( lld_ ).NE.descaref( lld_ ) ) THEN
2782 WRITE( argname, fmt = '(A)' ) 'DESCA( LLD_ )'
2783 ELSE IF( ib.NE.ibref ) THEN
2784 WRITE( argname, fmt = '(A)' ) 'IB'
2785 ELSE IF( jb.NE.jbref ) THEN
2786 WRITE( argname, fmt = '(A)' ) 'JB'
2787 ELSE IF( descb( dtype_ ).NE.descbref( dtype_ ) ) THEN
2788 WRITE( argname, fmt = '(A)' ) 'DESCB( DTYPE_ )'
2789 ELSE IF( descb( m_ ).NE.descbref( m_ ) ) THEN
2790 WRITE( argname, fmt = '(A)' ) 'DESCB( M_ )'
2791 ELSE IF( descb( n_ ).NE.descbref( n_ ) ) THEN
2792 WRITE( argname, fmt = '(A)' ) 'DESCB( N_ )'
2793 ELSE IF( descb( imb_ ).NE.descbref( imb_ ) ) THEN
2794 WRITE( argname, fmt = '(A)' ) 'DESCB( IMB_ )'
2795 ELSE IF( descb( inb_ ).NE.descbref( inb_ ) ) THEN
2796 WRITE( argname, fmt = '(A)' ) 'DESCB( INB_ )'
2797 ELSE IF( descb( mb_ ).NE.descbref( mb_ ) ) THEN
2798 WRITE( argname, fmt = '(A)' ) 'DESCB( MB_ )'
2799 ELSE IF( descb( nb_ ).NE.descbref( nb_ ) ) THEN
2800 WRITE( argname, fmt = '(A)' ) 'DESCB( NB_ )'
2801 ELSE IF( descb( rsrc_ ).NE.descbref( rsrc_ ) ) THEN
2802 WRITE( argname, fmt = '(A)' ) 'DESCB( RSRC_ )'
2803 ELSE IF( descb( csrc_ ).NE.descbref( csrc_ ) ) THEN
2804 WRITE( argname, fmt = '(A)' ) 'DESCB( CSRC_ )'
2805 ELSE IF( descb( ctxt_ ).NE.descbref( ctxt_ ) ) THEN
2806 WRITE( argname, fmt = '(A)' ) 'DESCB( CTXT_ )'
2807 ELSE IF( descb( lld_ ).NE.descbref( lld_ ) ) THEN
2808 WRITE( argname, fmt = '(A)' ) 'DESCB( LLD_ )'
2809 ELSE IF( beta.NE.betaref ) THEN
2810 WRITE( argname, fmt = '(A)' ) 'BETA'
2811 ELSE IF( ic.NE.icref ) THEN
2812 WRITE( argname, fmt = '(A)' ) 'IC'
2813 ELSE IF( jc.NE.jcref ) THEN
2814 WRITE( argname, fmt = '(A)' ) 'JC'
2815 ELSE IF( descc( dtype_ ).NE.desccref( dtype_ ) ) THEN
2816 WRITE( argname, fmt = '(A)' ) 'DESCC( DTYPE_ )'
2817 ELSE IF( descc( m_ ).NE.desccref( m_ ) ) THEN
2818 WRITE( argname, fmt = '(A)' ) 'DESCC( M_ )'
2819 ELSE IF( descc( n_ ).NE.desccref( n_ ) ) THEN
2820 WRITE( argname, fmt = '(A)' ) 'DESCC( N_ )'
2821 ELSE IF( descc( imb_ ).NE.desccref( imb_ ) ) THEN
2822 WRITE( argname, fmt = '(A)' ) 'DESCC( IMB_ )'
2823 ELSE IF( descc( inb_ ).NE.desccref( inb_ ) ) THEN
2824 WRITE( argname, fmt = '(A)' ) 'DESCC( INB_ )'
2825 ELSE IF( descc( mb_ ).NE.desccref( mb_ ) ) THEN
2826 WRITE( argname, fmt = '(A)' ) 'DESCC( MB_ )'
2827 ELSE IF( descc( nb_ ).NE.desccref( nb_ ) ) THEN
2828 WRITE( argname, fmt = '(A)' ) 'DESCC( NB_ )'
2829 ELSE IF( descc( rsrc_ ).NE.desccref( rsrc_ ) ) THEN
2830 WRITE( argname, fmt = '(A)' ) 'DESCC( RSRC_ )'
2831 ELSE IF( descc( csrc_ ).NE.desccref( csrc_ ) ) THEN
2832 WRITE( argname, fmt = '(A)' ) 'DESCC( CSRC_ )'
2833 ELSE IF( descc( ctxt_ ).NE.desccref( ctxt_ ) ) THEN
2834 WRITE( argname, fmt = '(A)' ) 'DESCC( CTXT_ )'
2835 ELSE IF( descc( lld_ ).NE.desccref( lld_ ) ) THEN
2836 WRITE( argname, fmt = '(A)' ) 'DESCC( LLD_ )'
2837 ELSE
2838 info = 0
2839 END IF
2840*
2841 CALL igsum2d( ictxt, 'All', ' ', 1, 1, info, 1, -1, 0 )
2842*
2843 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
2844*
2845 IF( info.NE.0 ) THEN
2846 WRITE( nout, fmt = 9999 ) argname, sname
2847 ELSE
2848 WRITE( nout, fmt = 9998 ) sname
2849 END IF
2850*
2851 END IF
2852*
2853 END IF
2854*
2855 9999 FORMAT( 2x, ' ***** Input-only parameter check: ', a,
2856 $ ' FAILED changed ', a, ' *****' )
2857 9998 FORMAT( 2x, ' ***** Input-only parameter check: ', a,
2858 $ ' PASSED *****' )
2859*
2860 RETURN
2861*
2862* End of PCCHKARG3
2863*
lsame
logical function lsame(ca, cb)
Definition tools.f:1724
Here is the caller graph for this function: