chk1mat.f

Go to the documentation of this file.

      SUBROUTINE chk1mat( MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA,
     $                    DESCAPOS0, INFO )
*
*  -- 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, IA, INFO, JA, MA, MAPOS0, NA, NAPOS0
*     ..
*     .. Array Arguments ..
      INTEGER            DESCA( * )
*     ..
*
*  Purpose
*  =======
*
*  CHK1MAT checks that the values associated with one distributed matrix
*  make sense from a local viewpoint
*
*  Arguments
*  =========
*
*  MA      (global input) INTEGER
*          The number or 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 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.
*
*  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.
*
*  =====================================================================
*
*     .. 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
      parameter( descmult = 100, bignum = descmult*descmult )
*     ..
*     .. Local Scalars ..
      INTEGER            DESCAPOS, IAPOS, JAPOS, MAPOS, NAPOS, MYCOL,
     $                   myrow, npcol, nprow
*     ..
*     .. External Subroutines ..
      EXTERNAL           blacs_gridinfo
*     ..
*     .. External Functions ..
      INTEGER            NUMROC
      EXTERNAL           numroc
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          min, max
*     ..
*     .. 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 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
*
      mapos = mapos0 * descmult
      napos = napos0 * descmult
      iapos = (descapos0-2) * descmult
      japos = (descapos0-1) * descmult
      descapos = descapos0 * descmult
*
*     Get grid parameters
*
      CALL blacs_gridinfo( desca( ctxt_ ), nprow, npcol, myrow, mycol )
*
*     Check that matrix values make sense from local viewpoint
*
      IF( desca( dtype_ ) .NE. block_cyclic_2d ) THEN
         info = min( info, descapos+dtype_ )
      ELSE IF( ma.LT.0 ) THEN
         info = min( info, mapos )
      ELSE IF( na.LT.0 ) THEN
         info = min( info, napos )
      ELSE IF( ia.LT.1 ) THEN
         info = min( info, iapos )
      ELSE IF( ja.LT.1 ) THEN
         info = min( info, japos )
      ELSE IF( desca( mb_ ).LT.1 ) THEN
         info = min( info, descapos+mb_ )
      ELSE IF( desca( nb_ ).LT.1 ) THEN
         info = min( info, descapos+nb_ )
      ELSE IF( desca( rsrc_ ).LT.0 .OR. desca( rsrc_ ).GE.nprow ) THEN
         info = min( info, descapos+rsrc_ )
      ELSE IF( desca( csrc_ ).LT.0 .OR. desca( csrc_ ).GE.npcol ) THEN
         info = min( info, descapos+csrc_ )
      ELSE IF( desca( lld_ ).LT.1 ) THEN
            info = min( info, descapos+lld_ )
      ELSE IF( desca( lld_ ) .LT.
     $         numroc( desca( m_ ), desca( mb_ ), myrow, desca(rsrc_),
     $                 nprow ) ) THEN
         IF( numroc( desca( n_ ), desca( nb_ ), mycol, desca( csrc_ ),
     $               npcol ) .GT. 0 )
     $      info = min( info, descapos+lld_ )
      END IF
*
      IF( ma.EQ.0 .OR. na.EQ.0 ) THEN
*
*        NULL matrix, relax some checks
*
         IF( desca(m_).LT.0 )
     $      info = min( info, descapos+m_ )
         IF( desca(n_).LT.0 )
     $      info = min( info, descapos+n_ )
*
      ELSE
*
*        more rigorous checks for non-degenerate matrices
*
         IF( desca( m_ ).LT.1 ) THEN
            info = min( info, descapos+m_ )
         ELSE IF( desca( n_ ).LT.1 ) THEN
            info = min( info, descapos+n_ )
         ELSE
            IF( ia.GT.desca( m_ ) ) THEN
               info = min( info, iapos )
            ELSE IF( ja.GT.desca( n_ ) ) THEN
               info = min( info, japos )
            ELSE
               IF( ia+ma-1.GT.desca( m_ ) )
     $            info = min( info, mapos )
               IF( ja+na-1.GT.desca( n_ ) )
     $            info = min( info, napos )
            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 CHK1MAT
*
      END