pb_chkmat()

subroutine pb_chkmat	(	integer	ictxt,
		integer	m,
		integer	mpos0,
		integer	n,
		integer	npos0,
		integer	ia,
		integer	ja,
		integer, dimension( * )	desca,
		integer	dpos0,
		integer	info
	)

Definition at line 3335 of file pblastim.f.

*
*  -- PBLAS test routine (version 2.0) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     April 1, 1998
*
*     .. Scalar Arguments ..
      INTEGER            DPOS0, IA, ICTXT, INFO, JA, M, MPOS0, N, NPOS0
*     ..
*     .. Array Arguments ..
      INTEGER            DESCA( * )
*     ..
*
*  Purpose
*  =======
*
*  PB_CHKMAT  checks the validity of a descriptor vector  DESCA, the re-
*  lated global indexes  IA, JA from a local view point. If an inconsis-
*  tency is found among its parameters IA, JA and DESCA, the routine re-
*  turns an error code in INFO.
*
*  Arguments
*  =========
*
*  ICTXT   (local input) INTEGER
*          On entry,  ICTXT  specifies the BLACS context handle, indica-
*          ting the global  context of the operation. The context itself
*          is global, but the value of ICTXT is local.
*
*  M       (global input) INTEGER
*          On entry,  M  specifies  the  number  of  rows  the submatrix
*          sub( A ).
*
*  MPOS0   (global input) INTEGER
*          On entry,  MPOS0  specifies the  position in the calling rou-
*          tine's parameter list where the formal parameter M appears.
*
*  N       (global input) INTEGER
*          On entry,  N  specifies  the  number of columns the submatrix
*          sub( A ).
*
*  NPOS0   (global input) INTEGER
*          On entry,  NPOS0  specifies the  position in the calling rou-
*          tine's parameter list where the formal parameter N appears.
*
*  IA      (global input) INTEGER
*          On entry, IA  specifies A's global row index, which points to
*          the beginning of the submatrix sub( A ).
*
*  JA      (global input) INTEGER
*          On entry, JA  specifies A's global column index, which points
*          to the beginning of the submatrix sub( A ).
*
*  DESCA   (global and local input) INTEGER array
*          On entry, DESCA  is an integer array of dimension DLEN_. This
*          is the array descriptor for the matrix A.
*
*  DPOS0   (global input) INTEGER
*          On entry,  DPOS0  specifies the  position in the calling rou-
*          tine's parameter list where the formal  parameter  DESCA  ap-
*          pears.  Note that it is assumed that  IA and JA are respecti-
*          vely 2 and 1 entries behind DESCA.
*
*  INFO    (local input/local 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.
*
*  -- Written on April 1, 1998 by
*     R. Clint Whaley, University of Tennessee, Knoxville 37996, USA.
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
     $                   DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
     $                   RSRC_
      parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
     $                   dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
     $                   imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
     $                   rsrc_ = 9, csrc_ = 10, lld_ = 11 )
      INTEGER            DESCMULT, BIGNUM
      parameter( descmult = 100, bignum = descmult*descmult )
*     ..
*     .. Local Scalars ..
      INTEGER            DPOS, IAPOS, JAPOS, MP, MPOS, MYCOL, MYROW,
     $                   NPCOL, NPOS, NPROW, NQ
*     ..
*     .. Local Arrays ..
      INTEGER            DESCA2( DLEN_ )
*     ..
*     .. External Subroutines ..
      EXTERNAL           blacs_gridinfo, pb_desctrans
*     ..
*     .. External Functions ..
      INTEGER            PB_NUMROC
      EXTERNAL           pb_numroc
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          min, max
*     ..
*     .. Executable Statements ..
*
*     Convert descriptor
*
      CALL pb_desctrans( desca, desca2 )
*
*     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 des-
*     criptor multiplier
*
      IF( info.GE.0 ) THEN
         info = bignum
      ELSE IF( info.LT.-descmult ) THEN
         info = -info
      ELSE
         info = -info * descmult
      END IF
*
*     Figure where in parameter list each parameter was, factoring in
*     descriptor multiplier
*
      mpos  = mpos0 * descmult
      npos  = npos0 * descmult
      iapos = ( dpos0 - 2 ) * descmult
      japos = ( dpos0 - 1 ) * descmult
      dpos  = dpos0 * descmult
*
*     Get grid parameters
*
      CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
*
*     Check that matrix values make sense from local viewpoint
*
      IF( m.LT.0 )
     $   info = min( info, mpos )
      IF( n.LT.0 )
     $   info = min( info, npos )
      IF( ia.LT.1 )
     $   info = min( info, iapos )
      IF( ja.LT.1 )
     $   info = min( info, japos )
      IF( desca2( dtype_ ).NE.block_cyclic_2d_inb )
     $   info = min( info, dpos + dtype_ )
      IF( desca2( imb_ ).LT.1 )
     $   info = min( info, dpos + imb_ )
      IF( desca2( inb_ ).LT.1 )
     $   info = min( info, dpos + inb_ )
      IF( desca2( mb_ ).LT.1 )
     $   info = min( info, dpos + mb_ )
      IF( desca2( nb_ ).LT.1 )
     $   info = min( info, dpos + nb_ )
      IF( desca2( rsrc_ ).LT.-1 .OR. desca2( rsrc_ ).GE.nprow )
     $   info = min( info, dpos + rsrc_ )
      IF( desca2( csrc_ ).LT.-1 .OR. desca2( csrc_ ).GE.npcol )
     $   info = min( info, dpos + csrc_ )
      IF( desca2( ctxt_ ).NE.ictxt )
     $   info = min( info, dpos + ctxt_ )
*
      IF( m.EQ.0 .OR. n.EQ.0 ) THEN
*
*        NULL matrix, relax some checks
*
         IF( desca2( m_ ).LT.0 )
     $      info = min( info, dpos + m_ )
         IF( desca2( n_ ).LT.0 )
     $      info = min( info, dpos + n_ )
         IF( desca2( lld_ ).LT.1 )
     $      info = min( info, dpos + lld_ )
*
      ELSE
*
*        more rigorous checks for non-degenerate matrices
*
         mp = pb_numroc( desca2( m_ ), 1, desca2( imb_ ), desca2( mb_ ),
     $                   myrow, desca2( rsrc_ ), nprow )
*
         IF( desca2( m_ ).LT.1 )
     $      info = min( info, dpos + m_ )
         IF( desca2( n_ ).LT.1 )
     $      info = min( info, dpos + n_ )
         IF( ia.GT.desca2( m_ ) )
     $      info = min( info, iapos )
         IF( ja.GT.desca2( n_ ) )
     $      info = min( info, japos )
         IF( ia+m-1.GT.desca2( m_ ) )
     $      info = min( info, mpos )
         IF( ja+n-1.GT.desca2( n_ ) )
     $      info = min( info, npos )
*
         IF( desca2( lld_ ).LT.max( 1, mp ) ) THEN
            nq = pb_numroc( desca2( n_ ), 1, desca2( inb_ ),
     $                      desca2( nb_ ), mycol, desca2( csrc_ ),
     $                      npcol )
            IF( desca2( lld_ ).LT.1 ) THEN
               info = min( info, dpos + lld_ )
            ELSE IF( nq.GT.0 ) THEN
               info = min( info, dpos + lld_ )
            END IF
         END IF
*
      END IF
*
*     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 PB_CHKMAT
*

Here is the call graph for this function: