|
ScaLAPACK
2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
|
|
ScaLAPACK
2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
|
#include "../pblas.h"#include "../PBpblas.h"#include "../PBtools.h"#include "../PBblacs.h"#include "../PBblas.h"Go to the source code of this file.
Functions/Subroutines | |
| 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) |
| 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 | ||
| ) |
Definition at line 24 of file PB_Cchkmat.c.
{
/*
* 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
*/
}
