|
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_Cchkvec (int ICTXT, char *ROUT, char *VNAME, int N, int NPOS0, int IX, int JX, int *DESCX, int INCX, int DPOS0, int *INFO) |
| void PB_Cchkvec | ( | int | ICTXT, |
| char * | ROUT, | ||
| char * | VNAME, | ||
| int | N, | ||
| int | NPOS0, | ||
| int | IX, | ||
| int | JX, | ||
| int * | DESCX, | ||
| int | INCX, | ||
| int | DPOS0, | ||
| int * | INFO | ||
| ) |
Definition at line 24 of file PB_Cchkvec.c.
{
/*
* Purpose
* =======
*
* PB_Cchkvec checks the validity of a descriptor vector DESCX, the
* related global indexes IX, JX and the global increment INCX. If an
* inconsistency is found among its parameters IX, JX, DESCX and INCX,
* 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.
*
* VNAME (global input) pointer to CHAR
* On entry, VNAME specifies the name of the formal array argu-
* ment in the calling routine.
*
* N (global input) INTEGER
* On entry, N specifies the length of the subvector sub( X ).
*
* NPOS0 (global input) INTEGER
* On entry, NPOS0 specifies the position in the calling rou-
* tine's parameter list where the formal parameter N appears.
*
* IX (global input) INTEGER
* On entry, IX specifies X's global row index, which points to
* the beginning of the submatrix sub( X ).
*
* JX (global input) INTEGER
* On entry, JX specifies X's global column index, which points
* to the beginning of the submatrix sub( X ).
*
* DESCX (global and local input) INTEGER array
* On entry, DESCX is an integer array of dimension DLEN_. This
* is the array descriptor for the matrix X.
*
* INCX (global input) INTEGER
* On entry, INCX specifies the global increment for the
* elements of X. Only two values of INCX are supported in
* this version, namely 1 and M_X. INCX must not be zero.
*
* DPOS0 (global input) INTEGER
* On entry, DPOS0 specifies the position in the calling rou-
* tine's parameter list where the formal parameter DESCX ap-
* pears. Note that it is assumed that IX and JX are respecti-
* vely 2 and 1 entries behind DESCX, and INCX is 1 entry after
* DESCX.
*
* 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, icpos, ixpos, jxpos, mycol, myrow, np, npcol, npos,
nprow, 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
*/
npos = NPOS0 * DESCMULT;
ixpos = ( DPOS0 - 2 ) * DESCMULT;
jxpos = ( DPOS0 - 1 ) * DESCMULT;
icpos = ( DPOS0 + 1 ) * DESCMULT;
dpos = DPOS0 * DESCMULT + 1;
/*
* Get process grid information
*/
Cblacs_gridinfo( ICTXT, &nprow, &npcol, &myrow, &mycol );
/*
* Are N, IX, JX, DESCX and INCX legal inputs ?
*/
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 length of", VNAME, N );
}
if( IX < 0 )
{
/*
* IX must be at least zero
*/
*INFO = MIN( *INFO, ixpos );
PB_Cwarn( ICTXT, -1, ROUT, "Illegal I%s = %d, I%s must be at least 1",
VNAME, IX+1, VNAME );
}
if( JX < 0 )
{
/*
* JX must be at least zero
*/
*INFO = MIN( *INFO, jxpos );
PB_Cwarn( ICTXT, -1, ROUT, "Illegal J%s = %d, J%s must be at least 1",
VNAME, JX+1, VNAME );
}
if( DESCX[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", DESCX[DTYPE_], VNAME,
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( DESCX[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", VNAME,
DESCX[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( DESCX[IMB_] < 1 )
{
/*
* DESCX[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",
VNAME, DESCX[IMB_], VNAME, "must be at least 1" );
}
if( DESCX[INB_] < 1 )
{
/*
* DESCX[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",
VNAME, DESCX[INB_], VNAME, "must be at least 1" );
}
if( DESCX[MB_] < 1 )
{
/*
* DESCX[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",
VNAME, DESCX[MB_], VNAME, "must be at least 1" );
}
if( DESCX[NB_] < 1 )
{
/*
* DESCX[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",
VNAME, DESCX[NB_], VNAME, "must be at least 1" );
}
if( ( DESCX[RSRC_] < -1 ) || ( DESCX[RSRC_] >= nprow ) )
{
/*
* DESCX[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", VNAME,
DESCX[RSRC_], VNAME, "must be either -1, or >= 0 and < ",
nprow );
}
if( ( DESCX[CSRC_] < -1 ) || ( DESCX[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", VNAME,
DESCX[CSRC_], VNAME, "must be either -1, or >= 0 and < ",
npcol );
}
if( INCX != 1 && INCX != DESCX[M_] )
{
/*
* INCX must be either 1 or DESCX[M_]
*/
*INFO = MIN( *INFO, icpos );
PB_Cwarn( ICTXT, -1, ROUT,
"Illegal INC%s = %d, INC%s should be either 1 or %d", VNAME,
DESCX[M_], VNAME );
}
if( N == 0 )
{
/*
* NULL vector, relax some checks
*/
if( DESCX[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",
VNAME, DESCX[M_] );
}
if( DESCX[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",
VNAME, DESCX[N_] );
}
if( DESCX[LLD_] < 1 )
{
/*
* DESCX[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",
VNAME, DESCX[LLD_] );
}
}
else
{
/*
* more rigorous checks for non-degenerate vector
*/
if( DESCX[M_] < 1 )
{
/*
* DESCX[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", VNAME,
DESCX[M_]);
}
if( DESCX[N_] < 1 )
{
/*
* DESCX[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", VNAME,
DESCX[N_]);
}
if( ( DESCX[M_] >= 1 ) && ( DESCX[N_] >= 1 ) )
{
if( INCX == DESCX[M_] )
{
/*
* sub( X ) resides in (a) process row(s)
*/
if( IX >= DESCX[M_] )
{
/*
* IX must be in [ 0 ... DESCX[M_]-1 ]
*/
*INFO = MIN( *INFO, ixpos );
PB_Cwarn( ICTXT, -1, ROUT, "%s I%s = %d, DESC%s[M_] = %d",
"Array subscript out of bounds:", VNAME, IX+1, VNAME,
DESCX[M_]);
}
if( JX+N > DESCX[N_] )
{
/*
* JX + N must be in [ 0 ... DESCX[N_]-1 ]
*/
*INFO = MIN( *INFO, jxpos );
PB_Cwarn( ICTXT, -1, ROUT,
"%s N = %d, J%s = %d, DESC%s[N_] = %d",
"Operation out of bounds:", N, VNAME, JX+1, VNAME,
DESCX[N_]);
}
}
else
{
/*
* sub( X ) resides in (a) process column(s)
*/
if( JX >= DESCX[N_] )
{
/*
* JX must be in [ 0 ... DESCX[N_] ]
*/
*INFO = MIN( *INFO, jxpos );
PB_Cwarn( ICTXT, -1, ROUT, "%s J%s = %d, DESC%s[N_] = %d",
"Array subscript out of bounds:", VNAME, JX+1, VNAME,
DESCX[N_]);
}
if( IX+N > DESCX[M_] )
{
/*
* IX + N must be in [ 0 ... DESCX[M_] ]
*/
*INFO = MIN( *INFO, ixpos );
PB_Cwarn( ICTXT, -1, ROUT,
"%s N = %d, I%s = %d, DESC%s[M_] = %d",
"Operation out of bounds:", N, VNAME, IX+1, VNAME,
DESCX[M_]);
}
}
}
/*
* *INFO == BIGNUM => No errors have been found so far
*/
if( *INFO == BIGNUM )
{
Mnumroc( np, DESCX[M_], 0, DESCX[IMB_], DESCX[MB_], myrow,
DESCX[RSRC_], nprow );
if( DESCX[LLD_] < MAX( 1, np ) )
{
Mnumroc( nq, DESCX[N_], 0, DESCX[INB_], DESCX[NB_], mycol,
DESCX[CSRC_], npcol );
/*
* DESCX[LLD_] must be at least 1 in order to be legal and this is enough if no
* columns of X reside in this process
*/
if( DESCX[LLD_] < 1 )
{
*INFO = MIN( *INFO, dpos + LLD_ );
PB_Cwarn( ICTXT, -1, ROUT,
"DESC%s[LLD_] = %d, it must be at least 1", VNAME,
DESCX[LLD_] );
}
else if( nq > 0 )
{
/*
* Some columns of X reside in this process, DESCX[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", VNAME,
DESCX[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_Cchkvec
*/
}
