ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
PB_Cchkvec.c
Go to the documentation of this file.
1 /* ---------------------------------------------------------------------
2 *
3 * -- PBLAS auxiliary routine (version 2.0) --
4 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
5 * and University of California, Berkeley.
6 * April 1, 1998
7 *
8 * ---------------------------------------------------------------------
9 */
10 /*
11 * Include files
12 */
13 #include "../pblas.h"
14 #include "../PBpblas.h"
15 #include "../PBtools.h"
16 #include "../PBblacs.h"
17 #include "../PBblas.h"
18 
19 #ifdef __STDC__
20 void PB_Cchkvec( int ICTXT, char * ROUT, char * VNAME, int N, int NPOS0,
21  int IX, int JX, int * DESCX, int INCX, int DPOS0,
22  int * INFO )
23 #else
24 void PB_Cchkvec( ICTXT, ROUT, VNAME, N, NPOS0, IX, JX, DESCX, INCX,
25  DPOS0, INFO )
26 /*
27 * .. Scalar Arguments ..
28 */
29  int DPOS0, ICTXT, IX, * INFO, INCX, JX, N, NPOS0;
30 /*
31 * .. Array Arguments ..
32 */
33  char * ROUT, * VNAME;
34  int * DESCX;
35 #endif
36 {
37 /*
38 * Purpose
39 * =======
40 *
41 * PB_Cchkvec checks the validity of a descriptor vector DESCX, the
42 * related global indexes IX, JX and the global increment INCX. If an
43 * inconsistency is found among its parameters IX, JX, DESCX and INCX,
44 * the routine returns an error code in INFO.
45 *
46 * Arguments
47 * =========
48 *
49 * ICTXT (local input) INTEGER
50 * On entry, ICTXT specifies the BLACS context handle, indica-
51 * ting the global context of the operation. The context itself
52 * is global, but the value of ICTXT is local.
53 *
54 * ROUT (global input) pointer to CHAR
55 * On entry, ROUT specifies the name of the routine calling this
56 * input error checking routine.
57 *
58 * VNAME (global input) pointer to CHAR
59 * On entry, VNAME specifies the name of the formal array argu-
60 * ment in the calling routine.
61 *
62 * N (global input) INTEGER
63 * On entry, N specifies the length of the subvector sub( X ).
64 *
65 * NPOS0 (global input) INTEGER
66 * On entry, NPOS0 specifies the position in the calling rou-
67 * tine's parameter list where the formal parameter N appears.
68 *
69 * IX (global input) INTEGER
70 * On entry, IX specifies X's global row index, which points to
71 * the beginning of the submatrix sub( X ).
72 *
73 * JX (global input) INTEGER
74 * On entry, JX specifies X's global column index, which points
75 * to the beginning of the submatrix sub( X ).
76 *
77 * DESCX (global and local input) INTEGER array
78 * On entry, DESCX is an integer array of dimension DLEN_. This
79 * is the array descriptor for the matrix X.
80 *
81 * INCX (global input) INTEGER
82 * On entry, INCX specifies the global increment for the
83 * elements of X. Only two values of INCX are supported in
84 * this version, namely 1 and M_X. INCX must not be zero.
85 *
86 * DPOS0 (global input) INTEGER
87 * On entry, DPOS0 specifies the position in the calling rou-
88 * tine's parameter list where the formal parameter DESCX ap-
89 * pears. Note that it is assumed that IX and JX are respecti-
90 * vely 2 and 1 entries behind DESCX, and INCX is 1 entry after
91 * DESCX.
92 *
93 * INFO (local input/local output) INTEGER
94 * = 0: successful exit
95 * < 0: If the i-th argument is an array and the j-entry had an
96 * illegal value, then INFO = -(i*100+j), if the i-th
97 * argument is a scalar and had an illegal value, then
98 * INFO = -i.
99 *
100 * -- Written on April 1, 1998 by
101 * R. Clint Whaley, University of Tennessee, Knoxville 37996, USA.
102 *
103 * ---------------------------------------------------------------------
104 */
105 /*
106 * .. Local Scalars ..
107 */
108  int dpos, icpos, ixpos, jxpos, mycol, myrow, np, npcol, npos,
109  nprow, nq;
110 /* ..
111 * .. Executable Statements ..
112 *
113 */
114 /*
115 * Want to find errors with MIN(), so if no error, set it to a big number. If
116 * there already is an error, multiply by the the descriptor multiplier.
117 */
118  if( *INFO >= 0 ) *INFO = BIGNUM;
119  else if( *INFO < -DESCMULT ) *INFO = -(*INFO);
120  else *INFO = -(*INFO) * DESCMULT;
121 /*
122 * Figure where in parameter list each parameter was, factoring in descriptor
123 * multiplier
124 */
125  npos = NPOS0 * DESCMULT;
126  ixpos = ( DPOS0 - 2 ) * DESCMULT;
127  jxpos = ( DPOS0 - 1 ) * DESCMULT;
128  icpos = ( DPOS0 + 1 ) * DESCMULT;
129  dpos = DPOS0 * DESCMULT + 1;
130 /*
131 * Get process grid information
132 */
133  Cblacs_gridinfo( ICTXT, &nprow, &npcol, &myrow, &mycol );
134 /*
135 * Are N, IX, JX, DESCX and INCX legal inputs ?
136 */
137  if( N < 0 )
138  {
139 /*
140 * N must be at least zero
141 */
142  *INFO = MIN( *INFO, npos );
143  PB_Cwarn( ICTXT, -1, ROUT, "%s sub( %s ) = %d, it must be at least 0",
144  "Illegal length of", VNAME, N );
145  }
146 
147  if( IX < 0 )
148  {
149 /*
150 * IX must be at least zero
151 */
152  *INFO = MIN( *INFO, ixpos );
153  PB_Cwarn( ICTXT, -1, ROUT, "Illegal I%s = %d, I%s must be at least 1",
154  VNAME, IX+1, VNAME );
155  }
156  if( JX < 0 )
157  {
158 /*
159 * JX must be at least zero
160 */
161  *INFO = MIN( *INFO, jxpos );
162  PB_Cwarn( ICTXT, -1, ROUT, "Illegal J%s = %d, J%s must be at least 1",
163  VNAME, JX+1, VNAME );
164  }
165 
166  if( DESCX[DTYPE_] != BLOCK_CYCLIC_2D_INB )
167  {
168 /*
169 * Internally, only the descriptor type BLOCK_CYCLIC_2D_INB is supported.
170 */
171  *INFO = MIN( *INFO, dpos + DTYPE_ );
172  PB_Cwarn( ICTXT, -1, ROUT, "%s %d for matrix %s. PBLAS accepts: %d or %d",
173  "Illegal descriptor type", DESCX[DTYPE_], VNAME,
175  if( *INFO % DESCMULT == 0 ) *INFO = -( (*INFO) / DESCMULT );
176  else *INFO = -(*INFO);
177 /*
178 * No need to go any further ...
179 */
180  return;
181  }
182 
183  if( DESCX[CTXT_] != ICTXT )
184  {
185 /*
186 * Check if the context of X match the other contexts. Only intra-context
187 * operations are supported.
188 */
189  *INFO = MIN( *INFO, dpos + CTXT_ );
190  PB_Cwarn( ICTXT, -1, ROUT, "DESC%s[CTXT_] = %d %s= %d", VNAME,
191  DESCX[CTXT_], "does not match other operand's context ",
192  ICTXT );
193  if( *INFO % DESCMULT == 0 ) *INFO = -( (*INFO) / DESCMULT );
194  else *INFO = -(*INFO);
195 /*
196 * No need to go any further ...
197 */
198  return;
199  }
200 
201  if( DESCX[IMB_] < 1 )
202  {
203 /*
204 * DESCX[IMB_] must be at least one
205 */
206  *INFO = MIN( *INFO, dpos + IMB_ );
207  PB_Cwarn( ICTXT, -1, ROUT, "Illegal DESC%s[IMB_] = %d, DESC%s[IMB_] %s",
208  VNAME, DESCX[IMB_], VNAME, "must be at least 1" );
209  }
210  if( DESCX[INB_] < 1 )
211  {
212 /*
213 * DESCX[INB_] must be at least one
214 */
215  *INFO = MIN( *INFO, dpos + INB_ );
216  PB_Cwarn( ICTXT, -1, ROUT, "Illegal DESC%s[INB_] = %d, DESC%s[INB_] %s",
217  VNAME, DESCX[INB_], VNAME, "must be at least 1" );
218  }
219  if( DESCX[MB_] < 1 )
220  {
221 /*
222 * DESCX[MB_] must be at least one
223 */
224  *INFO = MIN( *INFO, dpos + MB_ );
225  PB_Cwarn( ICTXT, -1, ROUT, "Illegal DESC%s[MB_] = %d, DESC%s[MB_] %s",
226  VNAME, DESCX[MB_], VNAME, "must be at least 1" );
227  }
228  if( DESCX[NB_] < 1 )
229  {
230 /*
231 * DESCX[NB_] must be at least one
232 */
233  *INFO = MIN( *INFO, dpos + NB_ );
234  PB_Cwarn( ICTXT, -1, ROUT, "Illegal DESC%s[NB_] = %d, DESC%s[NB_] %s",
235  VNAME, DESCX[NB_], VNAME, "must be at least 1" );
236  }
237 
238  if( ( DESCX[RSRC_] < -1 ) || ( DESCX[RSRC_] >= nprow ) )
239  {
240 /*
241 * DESCX[RSRC_] must be either -1 (replication) or in the interval [0 .. nprow)
242 */
243  *INFO = MIN( *INFO, dpos + RSRC_ );
244  PB_Cwarn( ICTXT, -1, ROUT,
245  "Illegal DESC%s[RSRC_] = %d, DESC%s[RSRC_] %s%d", VNAME,
246  DESCX[RSRC_], VNAME, "must be either -1, or >= 0 and < ",
247  nprow );
248  }
249  if( ( DESCX[CSRC_] < -1 ) || ( DESCX[CSRC_] >= npcol ) )
250  {
251 /*
252 * DESCX[CSRC_] must be either -1 (replication) or in the interval [0 .. npcol)
253 */
254  *INFO = MIN( *INFO, dpos + CSRC_ );
255  PB_Cwarn( ICTXT, -1, ROUT,
256  "Illegal DESC%s[CSRC_] = %d, DESC%s[CSRC_] %s%d", VNAME,
257  DESCX[CSRC_], VNAME, "must be either -1, or >= 0 and < ",
258  npcol );
259  }
260 
261  if( INCX != 1 && INCX != DESCX[M_] )
262  {
263 /*
264 * INCX must be either 1 or DESCX[M_]
265 */
266  *INFO = MIN( *INFO, icpos );
267  PB_Cwarn( ICTXT, -1, ROUT,
268  "Illegal INC%s = %d, INC%s should be either 1 or %d", VNAME,
269  DESCX[M_], VNAME );
270  }
271 
272  if( N == 0 )
273  {
274 /*
275 * NULL vector, relax some checks
276 */
277  if( DESCX[M_] < 0 )
278  {
279 /*
280 * DESCX[M_] must be at least 0
281 */
282  *INFO = MIN( *INFO, dpos + M_ );
283  PB_Cwarn( ICTXT, -1, ROUT, "DESC%s[M_] = %d, it must be at least 0",
284  VNAME, DESCX[M_] );
285 
286  }
287  if( DESCX[N_] < 0 )
288  {
289 /*
290 * DESCX[N_] must be at least 0
291 */
292  *INFO = MIN( *INFO, dpos + N_ );
293  PB_Cwarn( ICTXT, -1, ROUT, "DESC%s[N_] = %d, it must be at least 0",
294  VNAME, DESCX[N_] );
295  }
296 
297  if( DESCX[LLD_] < 1 )
298  {
299 /*
300 * DESCX[LLD_] must be at least 1
301 */
302  *INFO = MIN( *INFO, dpos + LLD_ );
303  PB_Cwarn( ICTXT, -1, ROUT, "DESC%s[LLD_] = %d, it must be at least 1",
304  VNAME, DESCX[LLD_] );
305  }
306  }
307  else
308  {
309 /*
310 * more rigorous checks for non-degenerate vector
311 */
312  if( DESCX[M_] < 1 )
313  {
314 /*
315 * DESCX[M_] must be at least 1
316 */
317  *INFO = MIN( *INFO, dpos + M_ );
318  PB_Cwarn( ICTXT, -1, ROUT,
319  "Illegal DESC%s[M_] = %d, it must be at least 1", VNAME,
320  DESCX[M_]);
321 
322  }
323  if( DESCX[N_] < 1 )
324  {
325 /*
326 * DESCX[N_] must be at least 1
327 */
328  *INFO = MIN( *INFO, dpos + N_ );
329  PB_Cwarn( ICTXT, -1, ROUT,
330  "Illegal DESC%s[N_] = %d, it must be at least 1", VNAME,
331  DESCX[N_]);
332  }
333 
334  if( ( DESCX[M_] >= 1 ) && ( DESCX[N_] >= 1 ) )
335  {
336  if( INCX == DESCX[M_] )
337  {
338 /*
339 * sub( X ) resides in (a) process row(s)
340 */
341  if( IX >= DESCX[M_] )
342  {
343 /*
344 * IX must be in [ 0 ... DESCX[M_]-1 ]
345 */
346  *INFO = MIN( *INFO, ixpos );
347  PB_Cwarn( ICTXT, -1, ROUT, "%s I%s = %d, DESC%s[M_] = %d",
348  "Array subscript out of bounds:", VNAME, IX+1, VNAME,
349  DESCX[M_]);
350  }
351  if( JX+N > DESCX[N_] )
352  {
353 /*
354 * JX + N must be in [ 0 ... DESCX[N_]-1 ]
355 */
356  *INFO = MIN( *INFO, jxpos );
357  PB_Cwarn( ICTXT, -1, ROUT,
358  "%s N = %d, J%s = %d, DESC%s[N_] = %d",
359  "Operation out of bounds:", N, VNAME, JX+1, VNAME,
360  DESCX[N_]);
361  }
362  }
363  else
364  {
365 /*
366 * sub( X ) resides in (a) process column(s)
367 */
368  if( JX >= DESCX[N_] )
369  {
370 /*
371 * JX must be in [ 0 ... DESCX[N_] ]
372 */
373  *INFO = MIN( *INFO, jxpos );
374  PB_Cwarn( ICTXT, -1, ROUT, "%s J%s = %d, DESC%s[N_] = %d",
375  "Array subscript out of bounds:", VNAME, JX+1, VNAME,
376  DESCX[N_]);
377  }
378  if( IX+N > DESCX[M_] )
379  {
380 /*
381 * IX + N must be in [ 0 ... DESCX[M_] ]
382 */
383  *INFO = MIN( *INFO, ixpos );
384  PB_Cwarn( ICTXT, -1, ROUT,
385  "%s N = %d, I%s = %d, DESC%s[M_] = %d",
386  "Operation out of bounds:", N, VNAME, IX+1, VNAME,
387  DESCX[M_]);
388  }
389  }
390  }
391 /*
392 * *INFO == BIGNUM => No errors have been found so far
393 */
394  if( *INFO == BIGNUM )
395  {
396  Mnumroc( np, DESCX[M_], 0, DESCX[IMB_], DESCX[MB_], myrow,
397  DESCX[RSRC_], nprow );
398  if( DESCX[LLD_] < MAX( 1, np ) )
399  {
400  Mnumroc( nq, DESCX[N_], 0, DESCX[INB_], DESCX[NB_], mycol,
401  DESCX[CSRC_], npcol );
402 /*
403 * DESCX[LLD_] must be at least 1 in order to be legal and this is enough if no
404 * columns of X reside in this process
405 */
406  if( DESCX[LLD_] < 1 )
407  {
408  *INFO = MIN( *INFO, dpos + LLD_ );
409  PB_Cwarn( ICTXT, -1, ROUT,
410  "DESC%s[LLD_] = %d, it must be at least 1", VNAME,
411  DESCX[LLD_] );
412  }
413  else if( nq > 0 )
414  {
415 /*
416 * Some columns of X reside in this process, DESCX[LLD_] must be at least
417 * MAX( 1, np )
418 */
419  *INFO = MIN( *INFO, dpos + LLD_ );
420  PB_Cwarn( ICTXT, -1, ROUT,
421  "DESC%s[LLD_] = %d, it must be at least %d", VNAME,
422  DESCX[LLD_], MAX( 1, np ) );
423  }
424  }
425  }
426  }
427 /*
428 * Prepare output: set INFO = 0 if no error, and divide by DESCMULT if error is
429 * not in a descriptor entry.
430 */
431  if( *INFO == BIGNUM ) *INFO = 0;
432  else if( *INFO % DESCMULT == 0 ) *INFO = -( (*INFO) / DESCMULT );
433  else *INFO = -(*INFO);
434 /*
435 * End of PB_Cchkvec
436 */
437 }
M_
#define M_
Definition: PBtools.h:39
MB_
#define MB_
Definition: PBtools.h:43
PB_Cwarn
void PB_Cwarn()
NB_
#define NB_
Definition: PBtools.h:44
CSRC_
#define CSRC_
Definition: PBtools.h:46
PB_Cchkvec
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: PB_Cchkvec.c:24
Mnumroc
#define Mnumroc(np_, n_, i_, inb_, nb_, proc_, srcproc_, nprocs_)
Definition: PBtools.h:222
LLD_
#define LLD_
Definition: PBtools.h:47
BLOCK_CYCLIC_2D_INB
#define BLOCK_CYCLIC_2D_INB
Definition: PBtools.h:35
IMB_
#define IMB_
Definition: PBtools.h:41
RSRC_
#define RSRC_
Definition: PBtools.h:45
DTYPE_
#define DTYPE_
Definition: PBtools.h:37
N_
#define N_
Definition: PBtools.h:40
MIN
#define MIN(a_, b_)
Definition: PBtools.h:76
INB_
#define INB_
Definition: PBtools.h:42
BLOCK_CYCLIC_2D
#define BLOCK_CYCLIC_2D
Definition: PBtools.h:20
MAX
#define MAX(a_, b_)
Definition: PBtools.h:77
Cblacs_gridinfo
void Cblacs_gridinfo()
BIGNUM
#define BIGNUM
Definition: PBtools.h:69
DESCMULT
#define DESCMULT
Definition: PBtools.h:68
CTXT_
#define CTXT_
Definition: PBtools.h:38