pchk2mat()

subroutine pchk2mat	(	integer	ma,
		integer	mapos0,
		integer	na,
		integer	napos0,
		integer	ia,
		integer	ja,
		integer, dimension( * )	desca,
		integer	descapos0,
		integer	mb,
		integer	mbpos0,
		integer	nb,
		integer	nbpos0,
		integer	ib,
		integer	jb,
		integer, dimension( 8 )	descb,
		integer	descbpos0,
		integer	nextra,
		integer, dimension( nextra )	ex,
		integer, dimension( nextra )	expos,
		integer	info
	)

Definition at line 172 of file pchkxmat.f.

*
*  -- ScaLAPACK tools routine (version 1.7) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     May 1, 1997
*
*     .. Scalar Arguments ..
      INTEGER            DESCAPOS0, DESCBPOS0, IA, IB, INFO, JA, JB, MA,
     $                   MAPOS0, MB, MBPOS0, NA, NAPOS0, NB, NBPOS0,
     $                   NEXTRA
*     ..
*     .. Array Arguments ..
      INTEGER            DESCA( * ), DESCB( 8 ), EX( NEXTRA ),
     $                   EXPOS( NEXTRA )
*     ..
*
*  Purpose
*  =======
*
*  PCHK2MAT checks that the values associated with two distributed
*  matrices are consistant across the entire process grid.
*
*  Notes
*  =====
*
*  This routine checks that all values are the same across the grid.
*  It does no local checking; it is therefore legal to abuse the
*  definitions of the non-descriptor arguments, i.e., if the routine
*  you are checking does not possess a MA value, you may pass some
*  other integer that must be global into this argument instead.
*
*  Arguments
*  =========
*
*  MA      (global input) INTEGER
*          The global number of matrix rows of A being operated on.
*
*  MAPOS0  (global input) INTEGER
*          Where in the calling routine's parameter list MA appears.
*
*  NA      (global input) INTEGER
*          The global number of matrix columns of A being operated on.
*
*  NAPOS0  (global input) INTEGER
*          Where in the calling routine's parameter list NA appears.
*
*  IA      (global input) INTEGER
*          The row index in the global array A indicating the first
*          row of sub( A ).
*
*  JA      (global input) INTEGER
*          The column index in the global array A indicating the
*          first column of sub( A ).
*
*  DESCA   (global and local input) INTEGER array of dimension DLEN_.
*          The array descriptor for the distributed matrix A.
*
*  DESCAPOS0 (global input) INTEGER
*          Where in the calling routine's parameter list DESCA
*          appears.  Note that we assume IA and JA are respectively 2
*          and 1 entries behind DESCA.
*
*  MB      (global input) INTEGER
*          The global number of matrix rows of B being operated on.
*
*  MBPOS0  (global input) INTEGER
*          Where in the calling routine's parameter list MB appears.
*
*  NB      (global input) INTEGER
*          The global number of matrix columns of B being operated on.
*
*  NBPOS0  (global input) INTEGER
*          Where in the calling routine's parameter list NB appears.
*
*  IB      (global input) INTEGER
*          The row index in the global array B indicating the first
*          row of sub( B ).
*
*  JB      (global input) INTEGER
*          The column index in the global array B indicating the
*          first column of sub( B ).
*
*  DESCB   (global and local input) INTEGER array of dimension DLEN_.
*          The array descriptor for the distributed matrix B.
*
*  DESCBPOS0 (global input) INTEGER
*          Where in the calling routine's parameter list DESCB
*          appears. Note that we assume IB and JB are respectively 2
*          and 1 entries behind DESCB.
*
*  NEXTRA  (global input) INTEGER
*          The number of extra parameters (i.e., besides the ones
*          above) to check.  NEXTRA <= LDW - 22.
*
*  EX      (local input) INTEGER array of dimension (NEXTRA)
*          The values of these extra parameters
*
*  EXPOS   (local input) INTEGER array of dimension (NEXTRA)
*          The parameter list positions of these extra values.
*
*  INFO    (local input/global output) INTEGER
*          = 0:  successful exit
*          < 0:  If the i-th argument is an array and the j-entry had
*                an illegal value, then INFO = -(i*100+j), if the i-th
*                argument is a scalar and had an illegal value, then
*                INFO = -i.
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
     $                   LLD_, MB_, M_, NB_, N_, RSRC_
      parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
     $                     ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
     $                     rsrc_ = 7, csrc_ = 8, lld_ = 9 )
      INTEGER            DESCMULT, BIGNUM, LDW
      parameter( descmult = 100, bignum = descmult * descmult,
     $                     ldw = 35 )
*     ..
*     .. Local Scalars ..
      INTEGER            K, DESCPOS
*     ..
*     .. Local Arrays ..
      INTEGER            IWORK( LDW, 2 ), IWORK2( LDW )
*     ..
*     .. External Subroutines ..
      EXTERNAL           globchk
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          mod
*     ..
*     .. Executable Statements ..
*
*     Want to find errors with MIN( ), so if no error, set it to a big
*     number. If there already is an error, multiply by the the
*     descriptor multiplier.
*
      IF( info.GE.0 ) THEN
         info = bignum
      ELSE IF( info.LT.-descmult ) THEN
         info = -info
      ELSE
         info = -info * descmult
      END IF
*
*     Pack values and their positions in the parameter list, factoring
*     in the descriptor multiplier
*
      iwork( 1, 1 ) = ma
      iwork( 1, 2 ) = mapos0 * descmult
      iwork( 2, 1 ) = na
      iwork( 2, 2 ) = napos0 * descmult
      iwork( 3, 1 ) = ia
      iwork( 3, 2 ) = (descapos0-2) * descmult
      iwork( 4, 1 ) = ja
      iwork( 4, 2 ) = (descapos0-1) * descmult
      descpos = descapos0 * descmult
*
      iwork(  5, 1 ) = desca( dtype_ )
      iwork(  5, 2 ) = descpos + dtype_
      iwork(  6, 1 ) = desca( m_ )
      iwork(  6, 2 ) = descpos + m_
      iwork(  7, 1 ) = desca( n_ )
      iwork(  7, 2 ) = descpos + n_
      iwork(  8, 1 ) = desca( mb_ )
      iwork(  8, 2 ) = descpos + mb_
      iwork(  9, 1 ) = desca( nb_ )
      iwork(  9, 2 ) = descpos + nb_
      iwork( 10, 1 ) = desca( rsrc_ )
      iwork( 10, 2 ) = descpos + rsrc_
      iwork( 11, 1 ) = desca( csrc_ )
      iwork( 11, 2 ) = descpos + csrc_
*
      iwork( 12, 1 ) = mb
      iwork( 12, 2 ) = mbpos0 * descmult
      iwork( 13, 1 ) = nb
      iwork( 13, 2 ) = nbpos0 * descmult
      iwork( 14, 1 ) = ib
      iwork( 14, 2 ) = (descbpos0-2) * descmult
      iwork( 15, 1 ) = jb
      iwork( 15, 2 ) = (descbpos0-1) * descmult
      descpos = descbpos0 * descmult
*
      iwork( 16, 1 ) = descb( dtype_ )
      iwork( 16, 2 ) = descpos + dtype_
      iwork( 17, 1 ) = descb( m_ )
      iwork( 17, 2 ) = descpos + m_
      iwork( 18, 1 ) = descb( n_ )
      iwork( 18, 2 ) = descpos + n_
      iwork( 19, 1 ) = descb( mb_ )
      iwork( 19, 2 ) = descpos + mb_
      iwork( 20, 1 ) = descb( nb_ )
      iwork( 20, 2 ) = descpos + nb_
      iwork( 21, 1 ) = descb( rsrc_ )
      iwork( 21, 2 ) = descpos + rsrc_
      iwork( 22, 1 ) = descb( csrc_ )
      iwork( 22, 2 ) = descpos + csrc_
*
      IF( nextra.GT.0 ) THEN
         DO 10 k = 1, nextra
            iwork( 22+k, 1 ) = ex( k )
            iwork( 22+k, 2 ) = expos( k )
   10    CONTINUE
      END IF
      k = 22 + nextra
*
*     Get the smallest error detected anywhere (BIGNUM if no error)
*
      CALL globchk( desca( ctxt_ ), k, iwork, ldw, iwork2, info )
*
*     Prepare output: set info = 0 if no error, and divide by DESCMULT
*     if error is not in a descriptor entry.
*
      IF( info.EQ.bignum ) THEN
         info = 0
      ELSE IF( mod( info, descmult ) .EQ. 0 ) THEN
         info = -info / descmult
      ELSE
         info = -info
      END IF
*
      RETURN
*
*     End of PCHK2MAT
*

Here is the call graph for this function: