PB_Cchkmat.c

Go to the documentation of this file.

/* ---------------------------------------------------------------------
*
*  -- PBLAS auxiliary routine (version 2.0) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     April 1, 1998
*
*  ---------------------------------------------------------------------
*/
/*
*  Include files
*/
#include "../pblas.h"
#include "../PBpblas.h"
#include "../PBtools.h"
#include "../PBblacs.h"
#include "../PBblas.h"
 
#ifdef __STDC__
void PB_Cchkmat( Int ICTXT, char * ROUT, char * MNAME, Int M, Int MPOS0,
                 Int N, Int NPOS0, Int IA, Int JA, Int * DESCA, Int DPOS0,
                 Int * INFO )
#else
void PB_Cchkmat( ICTXT, ROUT, MNAME, M, MPOS0, N, NPOS0, IA, JA, DESCA,
                 DPOS0, INFO )
/*
*  .. Scalar Arguments ..
*/
   Int            DPOS0, IA, ICTXT, * INFO, JA, M, MPOS0, N, NPOS0;
/*
*  .. Array Arguments ..
*/
   char           * MNAME, * ROUT;
   Int            * DESCA;
#endif
{
/*
*  Purpose
*  =======
*
*  PB_Cchkmat  checks the  validity of a  descriptor vector  DESCA,  the
*  related global indexes  IA, JA  from a local view point. If an incon-
*  sistency is found among its parameters IA, JA and DESCA, the  routine
*  returns 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.
*
*  ROUT    (global input) pointer to CHAR
*          On entry, ROUT specifies the name of the routine calling this
*          input error checking routine.
*
*  MNAME   (global input) pointer to CHAR
*          On entry,  MNAME specifies the name of the formal array argu-
*          ment in the calling routine.
*
*  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.
*
*  ---------------------------------------------------------------------
*/
/*
*  .. Local Scalars ..
*/
   Int            dpos, iapos, japos, mpos, mycol, myrow, np, npcol, nprow,
                  npos, nq;
/* ..
*  .. 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 >= 0 )             *INFO = BIGNUM;
   else if( *INFO < -DESCMULT ) *INFO = -(*INFO);
   else                         *INFO = -(*INFO) * DESCMULT;
/*
*  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 + 1;
/*
*  Get process grid information
*/
   Cblacs_gridinfo( ICTXT, &nprow, &npcol, &myrow, &mycol );
/*
*  Are M, N, IA, JA and DESCA legal inputs ?
*/
   if( M < 0 )
   {
/*
*  M must be at least zero
*/
      *INFO = MIN( *INFO, mpos );
      PB_Cwarn( ICTXT, -1, ROUT, "%s sub( %s ) = %d, it must be at least 0",
                "Illegal number of rows of", MNAME, M );
   }
   if( N < 0 )
   {
/*
*  N must be at least zero
*/
      *INFO = MIN( *INFO, npos );
      PB_Cwarn( ICTXT, -1, ROUT, "%s sub( %s ) = %d, it must be at least 0",
                "Illegal number of columns of", MNAME, N );
   }
 
   if( IA < 0 )
   {
/*
*  IA must be at least zero
*/
      *INFO = MIN( *INFO, iapos );
      PB_Cwarn( ICTXT, -1, ROUT, "Illegal I%s = %d, I%s must be at least 1",
                MNAME, IA+1, MNAME );
   }
   if( JA < 0 )
   {
/*
*  JA must be at least zero
*/
      *INFO = MIN( *INFO, japos );
      PB_Cwarn( ICTXT, -1, ROUT, "Illegal J%s = %d, I%s must be at least 1",
                MNAME, IA+1, MNAME );
   }
 
   if( DESCA[DTYPE_] != BLOCK_CYCLIC_2D_INB )
   {
/*
*  Internally, only the descriptor type BLOCK_CYCLIC_2D_INB is supported
*/
      *INFO = MIN( *INFO, dpos + DTYPE_ );
      PB_Cwarn( ICTXT, -1, ROUT, "%s %d for matrix %s. PBLAS accepts: %d or %d",
                "Illegal descriptor type", DESCA[DTYPE_], MNAME,
                BLOCK_CYCLIC_2D, BLOCK_CYCLIC_2D_INB );
      if( *INFO % DESCMULT == 0 ) *INFO = -( (*INFO) / DESCMULT );
      else                        *INFO = -(*INFO);
/*
*  No need to go any further ...
*/
      return;
   }
 
   if( DESCA[CTXT_] != ICTXT )
   {
/*
*  Check if the context of X match the other contexts. Only intra-context
*  operations are supported.
*/
      *INFO = MIN( *INFO, dpos + CTXT_ );
      PB_Cwarn( ICTXT, -1, ROUT, "DESC%s[CTXT_] = %d %s= %d", MNAME,
                DESCA[CTXT_], "does not match other operand's context ",
                ICTXT );
      if( *INFO % DESCMULT == 0 ) *INFO = -( (*INFO) / DESCMULT );
      else                        *INFO = -(*INFO);
/*
*  No need to go any further ...
*/
      return;
   }
 
   if( DESCA[IMB_] < 1 )
   {
/*
*  DESCA[IMB_] must be at least one
*/
      *INFO = MIN( *INFO, dpos + IMB_ );
      PB_Cwarn( ICTXT, -1, ROUT, "Illegal DESC%s[IMB_] = %d, DESC%s[IMB_] %s",
                MNAME, DESCA[IMB_], MNAME, "must be at least 1" );
   }
   if( DESCA[INB_] < 1 )
   {
/*
*  DESCA[INB_] must be at least one
*/
      *INFO = MIN( *INFO, dpos + INB_ );
      PB_Cwarn( ICTXT, -1, ROUT, "Illegal DESC%s[INB_] = %d, DESC%s[INB_] %s",
                MNAME, DESCA[INB_], MNAME, "must be at least 1" );
   }
   if( DESCA[MB_] < 1 )
   {
/*
*  DESCA[MB_] must be at least one
*/
      *INFO = MIN( *INFO, dpos + MB_ );
      PB_Cwarn( ICTXT, -1, ROUT, "Illegal DESC%s[MB_] = %d, DESC%s[MB_] %s",
                MNAME, DESCA[MB_], MNAME, "must be at least 1" );
   }
   if( DESCA[NB_] < 1 )
   {
/*
*  DESCA[NB_] must be at least one
*/
      *INFO = MIN( *INFO, dpos + NB_ );
      PB_Cwarn( ICTXT, -1, ROUT, "Illegal DESC%s[NB_] = %d, DESC%s[NB_] %s",
                MNAME, DESCA[NB_], MNAME, "must be at least 1" );
   }
 
   if( ( DESCA[RSRC_] < -1 ) || ( DESCA[RSRC_] >= nprow ) )
   {
/*
*  DESCA[RSRC_] must be either -1 (replication) or in the interval [0 .. nprow)
*/
      *INFO = MIN( *INFO, dpos + RSRC_ );
      PB_Cwarn( ICTXT, -1, ROUT,
                "Illegal DESC%s[RSRC_] = %d, DESC%s[RSRC_] %s%d", MNAME,
                DESCA[RSRC_], MNAME, "must be either -1, or >= 0 and < ",
                nprow );
   }
   if( ( DESCA[CSRC_] < -1 ) || ( DESCA[CSRC_] >= npcol ) )
   {
/*
*  DESCX[CSRC_] must be either -1 (replication) or in the interval [0 .. npcol)
*/
      *INFO = MIN( *INFO, dpos + CSRC_ );
      PB_Cwarn( ICTXT, -1, ROUT,
                "Illegal DESC%s[CSRC_] = %d, DESC%s[CSRC_] %s%d", MNAME,
                DESCA[CSRC_], MNAME, "must be either -1, or >= 0 and < ",
                npcol );
   }
 
   if( M == 0 || N == 0 )
   {
/*
*  NULL matrix, relax some checks
*/
      if( DESCA[M_] < 0 )
      {
/*
*  DESCX[M_] must be at least 0
*/
         *INFO = MIN( *INFO, dpos + M_ );
         PB_Cwarn( ICTXT, -1, ROUT, "DESC%s[M_] = %d, it must be at least 0",
                   MNAME, DESCA[M_] );
      }
      if( DESCA[N_] < 0 )
      {
/*
*  DESCX[N_] must be at least 0
*/
         *INFO = MIN( *INFO, dpos + N_ );
         PB_Cwarn( ICTXT, -1, ROUT, "DESC%s[N_] = %d, it must be at least 0",
                   MNAME, DESCA[N_] );
      }
 
      if( DESCA[LLD_] < 1 )
      {
/*
*  DESCA[LLD_] must be at least 1
*/
         *INFO = MIN( *INFO, dpos + LLD_ );
         PB_Cwarn( ICTXT, -1, ROUT, "DESC%s[LLD_] = %d, it must be at least 1",
                   MNAME, DESCA[LLD_] );
      }
   }
   else
   {
/*
*  more rigorous checks for non-degenerate matrix
*/
      if( DESCA[M_] < 1 )
      {
/*
*  DESCA[M_] must be at least 1
*/
         *INFO = MIN( *INFO, dpos + M_ );
         PB_Cwarn( ICTXT, -1, ROUT,
                   "Illegal DESC%s[M_] = %d, it must be at least 1", MNAME,
                   DESCA[M_]);
      }
      if( DESCA[N_] < 1 )
      {
/*
*  DESCA[N_] must be at least 1
*/
         *INFO = MIN( *INFO, dpos + N_ );
         PB_Cwarn( ICTXT, -1, ROUT,
                   "Illegal DESC%s[N_] = %d, it must be at least 1", MNAME,
                   DESCA[N_]);
      }
 
      if( ( DESCA[M_] >= 1 ) && ( DESCA[N_] >= 1 ) )
      {
         if( IA+M > DESCA[M_] )
         {
/*
*  IA + M must be in [ 0 ... DESCA[M_] ]
*/
            *INFO = MIN( *INFO, iapos );
            PB_Cwarn( ICTXT, -1, ROUT, "%s M = %d, I%s = %d, DESC%s[M_] = %d",
                      "Operation out of bounds:", M, MNAME, IA+1, MNAME,
                      DESCA[M_]);
         }
         if( JA+N > DESCA[N_] )
         {
/*
*  JA + N must be in [ 0 ... DESCA[N_] ]
*/
            *INFO = MIN( *INFO, japos );
            PB_Cwarn( ICTXT, -1, ROUT, "%s N = %d, J%s = %d, DESC%s[N_] = %d",
                      "Operation out of bounds:", N, MNAME, JA+1, MNAME,
                      DESCA[N_]);
         }
      }
/*
*  *INFO == BIGNUM => No errors have been found so far
*/
      if( *INFO == BIGNUM )
      {
         Mnumroc( np, DESCA[M_], 0, DESCA[IMB_], DESCA[MB_], myrow,
                  DESCA[RSRC_], nprow );
         if( DESCA[LLD_] < MAX( 1, np ) )
         {
            Mnumroc( nq, DESCA[N_], 0, DESCA[INB_], DESCA[NB_], mycol,
                     DESCA[CSRC_], npcol );
/*
*  DESCA[LLD_] must be at least 1 in order to be legal and this is enough if no
*  columns of A reside in this process.
*/
            if( DESCA[LLD_] < 1 )
            {
               *INFO = MIN( *INFO, dpos + LLD_ );
               PB_Cwarn( ICTXT, -1, ROUT,
                         "DESC%s[LLD_] = %d, it must be at least 1", MNAME,
                         DESCA[LLD_] );
            }
            else if( nq > 0 )
            {
/*
*  Some columns of A reside in this process, DESCA[LLD_] must be at least
*  MAX( 1, np ).
*/
               *INFO = MIN( *INFO, dpos + LLD_ );
               PB_Cwarn( ICTXT, -1, ROUT,
                         "DESC%s[LLD_] = %d, it must be at least %d", MNAME,
                         DESCA[LLD_], MAX( 1, np ) );
            }
         }
      }
   }
/*
*  Prepare output: set info = 0 if no error, and divide by DESCMULT if error is
*  not in a descriptor entry.
*/
   if( *INFO == BIGNUM )            *INFO = 0;
   else if( *INFO % DESCMULT == 0 ) *INFO = -( (*INFO) / DESCMULT );
   else                             *INFO = -(*INFO);
/*
*  End of PB_Cchkmat
*/
}
void PB_Cchkmat( ICTXT, ROUT, MNAME, M, MPOS0, N, NPOS0, IA, JA, DESCA, {…}