/* --------------------------------------------------------------------- * * -- 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_Cchkvec( int ICTXT, char * ROUT, char * VNAME, int N, int NPOS0, int IX, int JX, int * DESCX, int INCX, int DPOS0, int * INFO ) #else void PB_Cchkvec( ICTXT, ROUT, VNAME, N, NPOS0, IX, JX, DESCX, INCX, DPOS0, INFO ) /* * .. Scalar Arguments .. */ int DPOS0, ICTXT, IX, * INFO, INCX, JX, N, NPOS0; /* * .. Array Arguments .. */ char * ROUT, * VNAME; int * DESCX; #endif { /* * 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 */ }