ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
PB_Cchkmat.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_Cchkmat( int ICTXT, char * ROUT, char * MNAME, int M, int MPOS0,
21  int N, int NPOS0, int IA, int JA, int * DESCA, int DPOS0,
22  int * INFO )
23 #else
24 void PB_Cchkmat( ICTXT, ROUT, MNAME, M, MPOS0, N, NPOS0, IA, JA, DESCA,
25  DPOS0, INFO )
26 /*
27 * .. Scalar Arguments ..
28 */
29  int DPOS0, IA, ICTXT, * INFO, JA, M, MPOS0, N, NPOS0;
30 /*
31 * .. Array Arguments ..
32 */
33  char * MNAME, * ROUT;
34  int * DESCA;
35 #endif
36 {
37 /*
38 * Purpose
39 * =======
40 *
41 * PB_Cchkmat checks the validity of a descriptor vector DESCA, the
42 * related global indexes IA, JA from a local view point. If an incon-
43 * sistency is found among its parameters IA, JA and DESCA, the routine
44 * 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 * MNAME (global input) pointer to CHAR
59 * On entry, MNAME specifies the name of the formal array argu-
60 * ment in the calling routine.
61 *
62 * M (global input) INTEGER
63 * On entry, M specifies the number of rows the submatrix
64 * sub( A ).
65 *
66 * MPOS0 (global input) INTEGER
67 * On entry, MPOS0 specifies the position in the calling rou-
68 * tine's parameter list where the formal parameter M appears.
69 *
70 * N (global input) INTEGER
71 * On entry, N specifies the number of columns the submatrix
72 * sub( A ).
73 *
74 * NPOS0 (global input) INTEGER
75 * On entry, NPOS0 specifies the position in the calling rou-
76 * tine's parameter list where the formal parameter N appears.
77 *
78 * IA (global input) INTEGER
79 * On entry, IA specifies A's global row index, which points to
80 * the beginning of the submatrix sub( A ).
81 *
82 * JA (global input) INTEGER
83 * On entry, JA specifies A's global column index, which points
84 * to the beginning of the submatrix sub( A ).
85 *
86 * DESCA (global and local input) INTEGER array
87 * On entry, DESCA is an integer array of dimension DLEN_. This
88 * is the array descriptor for the matrix A.
89 *
90 * DPOS0 (global input) INTEGER
91 * On entry, DPOS0 specifies the position in the calling rou-
92 * tine's parameter list where the formal parameter DESCA ap-
93 * pears. Note that it is assumed that IA and JA are respecti-
94 * vely 2 and 1 entries behind DESCA.
95 *
96 * INFO (local input/local output) INTEGER
97 * = 0: successful exit
98 * < 0: If the i-th argument is an array and the j-entry had an
99 * illegal value, then INFO = -(i*100+j), if the i-th
100 * argument is a scalar and had an illegal value, then
101 * INFO = -i.
102 *
103 * -- Written on April 1, 1998 by
104 * R. Clint Whaley, University of Tennessee, Knoxville 37996, USA.
105 *
106 * ---------------------------------------------------------------------
107 */
108 /*
109 * .. Local Scalars ..
110 */
111  int dpos, iapos, japos, mpos, mycol, myrow, np, npcol, nprow,
112  npos, nq;
113 /* ..
114 * .. Executable Statements ..
115 *
116 */
117 /*
118 * Want to find errors with MIN( ), so if no error, set it to a big number. If
119 * there already is an error, multiply by the the descriptor multiplier.
120 */
121  if( *INFO >= 0 ) *INFO = BIGNUM;
122  else if( *INFO < -DESCMULT ) *INFO = -(*INFO);
123  else *INFO = -(*INFO) * DESCMULT;
124 /*
125 * Figure where in parameter list each parameter was, factoring in descriptor
126 * multiplier
127 */
128  mpos = MPOS0 * DESCMULT;
129  npos = NPOS0 * DESCMULT;
130  iapos = ( DPOS0 - 2 ) * DESCMULT;
131  japos = ( DPOS0 - 1 ) * DESCMULT;
132  dpos = DPOS0 * DESCMULT + 1;
133 /*
134 * Get process grid information
135 */
136  Cblacs_gridinfo( ICTXT, &nprow, &npcol, &myrow, &mycol );
137 /*
138 * Are M, N, IA, JA and DESCA legal inputs ?
139 */
140  if( M < 0 )
141  {
142 /*
143 * M must be at least zero
144 */
145  *INFO = MIN( *INFO, mpos );
146  PB_Cwarn( ICTXT, -1, ROUT, "%s sub( %s ) = %d, it must be at least 0",
147  "Illegal number of rows of", MNAME, M );
148  }
149  if( N < 0 )
150  {
151 /*
152 * N must be at least zero
153 */
154  *INFO = MIN( *INFO, npos );
155  PB_Cwarn( ICTXT, -1, ROUT, "%s sub( %s ) = %d, it must be at least 0",
156  "Illegal number of columns of", MNAME, N );
157  }
158 
159  if( IA < 0 )
160  {
161 /*
162 * IA must be at least zero
163 */
164  *INFO = MIN( *INFO, iapos );
165  PB_Cwarn( ICTXT, -1, ROUT, "Illegal I%s = %d, I%s must be at least 1",
166  MNAME, IA+1, MNAME );
167  }
168  if( JA < 0 )
169  {
170 /*
171 * JA must be at least zero
172 */
173  *INFO = MIN( *INFO, japos );
174  PB_Cwarn( ICTXT, -1, ROUT, "Illegal J%s = %d, I%s must be at least 1",
175  MNAME, IA+1, MNAME );
176  }
177 
178  if( DESCA[DTYPE_] != BLOCK_CYCLIC_2D_INB )
179  {
180 /*
181 * Internally, only the descriptor type BLOCK_CYCLIC_2D_INB is supported
182 */
183  *INFO = MIN( *INFO, dpos + DTYPE_ );
184  PB_Cwarn( ICTXT, -1, ROUT, "%s %d for matrix %s. PBLAS accepts: %d or %d",
185  "Illegal descriptor type", DESCA[DTYPE_], MNAME,
187  if( *INFO % DESCMULT == 0 ) *INFO = -( (*INFO) / DESCMULT );
188  else *INFO = -(*INFO);
189 /*
190 * No need to go any further ...
191 */
192  return;
193  }
194 
195  if( DESCA[CTXT_] != ICTXT )
196  {
197 /*
198 * Check if the context of X match the other contexts. Only intra-context
199 * operations are supported.
200 */
201  *INFO = MIN( *INFO, dpos + CTXT_ );
202  PB_Cwarn( ICTXT, -1, ROUT, "DESC%s[CTXT_] = %d %s= %d", MNAME,
203  DESCA[CTXT_], "does not match other operand's context ",
204  ICTXT );
205  if( *INFO % DESCMULT == 0 ) *INFO = -( (*INFO) / DESCMULT );
206  else *INFO = -(*INFO);
207 /*
208 * No need to go any further ...
209 */
210  return;
211  }
212 
213  if( DESCA[IMB_] < 1 )
214  {
215 /*
216 * DESCA[IMB_] must be at least one
217 */
218  *INFO = MIN( *INFO, dpos + IMB_ );
219  PB_Cwarn( ICTXT, -1, ROUT, "Illegal DESC%s[IMB_] = %d, DESC%s[IMB_] %s",
220  MNAME, DESCA[IMB_], MNAME, "must be at least 1" );
221  }
222  if( DESCA[INB_] < 1 )
223  {
224 /*
225 * DESCA[INB_] must be at least one
226 */
227  *INFO = MIN( *INFO, dpos + INB_ );
228  PB_Cwarn( ICTXT, -1, ROUT, "Illegal DESC%s[INB_] = %d, DESC%s[INB_] %s",
229  MNAME, DESCA[INB_], MNAME, "must be at least 1" );
230  }
231  if( DESCA[MB_] < 1 )
232  {
233 /*
234 * DESCA[MB_] must be at least one
235 */
236  *INFO = MIN( *INFO, dpos + MB_ );
237  PB_Cwarn( ICTXT, -1, ROUT, "Illegal DESC%s[MB_] = %d, DESC%s[MB_] %s",
238  MNAME, DESCA[MB_], MNAME, "must be at least 1" );
239  }
240  if( DESCA[NB_] < 1 )
241  {
242 /*
243 * DESCA[NB_] must be at least one
244 */
245  *INFO = MIN( *INFO, dpos + NB_ );
246  PB_Cwarn( ICTXT, -1, ROUT, "Illegal DESC%s[NB_] = %d, DESC%s[NB_] %s",
247  MNAME, DESCA[NB_], MNAME, "must be at least 1" );
248  }
249 
250  if( ( DESCA[RSRC_] < -1 ) || ( DESCA[RSRC_] >= nprow ) )
251  {
252 /*
253 * DESCA[RSRC_] must be either -1 (replication) or in the interval [0 .. nprow)
254 */
255  *INFO = MIN( *INFO, dpos + RSRC_ );
256  PB_Cwarn( ICTXT, -1, ROUT,
257  "Illegal DESC%s[RSRC_] = %d, DESC%s[RSRC_] %s%d", MNAME,
258  DESCA[RSRC_], MNAME, "must be either -1, or >= 0 and < ",
259  nprow );
260  }
261  if( ( DESCA[CSRC_] < -1 ) || ( DESCA[CSRC_] >= npcol ) )
262  {
263 /*
264 * DESCX[CSRC_] must be either -1 (replication) or in the interval [0 .. npcol)
265 */
266  *INFO = MIN( *INFO, dpos + CSRC_ );
267  PB_Cwarn( ICTXT, -1, ROUT,
268  "Illegal DESC%s[CSRC_] = %d, DESC%s[CSRC_] %s%d", MNAME,
269  DESCA[CSRC_], MNAME, "must be either -1, or >= 0 and < ",
270  npcol );
271  }
272 
273  if( M == 0 || N == 0 )
274  {
275 /*
276 * NULL matrix, relax some checks
277 */
278  if( DESCA[M_] < 0 )
279  {
280 /*
281 * DESCX[M_] must be at least 0
282 */
283  *INFO = MIN( *INFO, dpos + M_ );
284  PB_Cwarn( ICTXT, -1, ROUT, "DESC%s[M_] = %d, it must be at least 0",
285  MNAME, DESCA[M_] );
286  }
287  if( DESCA[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  MNAME, DESCA[N_] );
295  }
296 
297  if( DESCA[LLD_] < 1 )
298  {
299 /*
300 * DESCA[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  MNAME, DESCA[LLD_] );
305  }
306  }
307  else
308  {
309 /*
310 * more rigorous checks for non-degenerate matrix
311 */
312  if( DESCA[M_] < 1 )
313  {
314 /*
315 * DESCA[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", MNAME,
320  DESCA[M_]);
321  }
322  if( DESCA[N_] < 1 )
323  {
324 /*
325 * DESCA[N_] must be at least 1
326 */
327  *INFO = MIN( *INFO, dpos + N_ );
328  PB_Cwarn( ICTXT, -1, ROUT,
329  "Illegal DESC%s[N_] = %d, it must be at least 1", MNAME,
330  DESCA[N_]);
331  }
332 
333  if( ( DESCA[M_] >= 1 ) && ( DESCA[N_] >= 1 ) )
334  {
335  if( IA+M > DESCA[M_] )
336  {
337 /*
338 * IA + M must be in [ 0 ... DESCA[M_] ]
339 */
340  *INFO = MIN( *INFO, iapos );
341  PB_Cwarn( ICTXT, -1, ROUT, "%s M = %d, I%s = %d, DESC%s[M_] = %d",
342  "Operation out of bounds:", M, MNAME, IA+1, MNAME,
343  DESCA[M_]);
344  }
345  if( JA+N > DESCA[N_] )
346  {
347 /*
348 * JA + N must be in [ 0 ... DESCA[N_] ]
349 */
350  *INFO = MIN( *INFO, japos );
351  PB_Cwarn( ICTXT, -1, ROUT, "%s N = %d, J%s = %d, DESC%s[N_] = %d",
352  "Operation out of bounds:", N, MNAME, JA+1, MNAME,
353  DESCA[N_]);
354  }
355  }
356 /*
357 * *INFO == BIGNUM => No errors have been found so far
358 */
359  if( *INFO == BIGNUM )
360  {
361  Mnumroc( np, DESCA[M_], 0, DESCA[IMB_], DESCA[MB_], myrow,
362  DESCA[RSRC_], nprow );
363  if( DESCA[LLD_] < MAX( 1, np ) )
364  {
365  Mnumroc( nq, DESCA[N_], 0, DESCA[INB_], DESCA[NB_], mycol,
366  DESCA[CSRC_], npcol );
367 /*
368 * DESCA[LLD_] must be at least 1 in order to be legal and this is enough if no
369 * columns of A reside in this process.
370 */
371  if( DESCA[LLD_] < 1 )
372  {
373  *INFO = MIN( *INFO, dpos + LLD_ );
374  PB_Cwarn( ICTXT, -1, ROUT,
375  "DESC%s[LLD_] = %d, it must be at least 1", MNAME,
376  DESCA[LLD_] );
377  }
378  else if( nq > 0 )
379  {
380 /*
381 * Some columns of A reside in this process, DESCA[LLD_] must be at least
382 * MAX( 1, np ).
383 */
384  *INFO = MIN( *INFO, dpos + LLD_ );
385  PB_Cwarn( ICTXT, -1, ROUT,
386  "DESC%s[LLD_] = %d, it must be at least %d", MNAME,
387  DESCA[LLD_], MAX( 1, np ) );
388  }
389  }
390  }
391  }
392 /*
393 * Prepare output: set info = 0 if no error, and divide by DESCMULT if error is
394 * not in a descriptor entry.
395 */
396  if( *INFO == BIGNUM ) *INFO = 0;
397  else if( *INFO % DESCMULT == 0 ) *INFO = -( (*INFO) / DESCMULT );
398  else *INFO = -(*INFO);
399 /*
400 * End of PB_Cchkmat
401 */
402 }
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
Mnumroc
#define Mnumroc(np_, n_, i_, inb_, nb_, proc_, srcproc_, nprocs_)
Definition: PBtools.h:222
PB_Cchkmat
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: PB_Cchkmat.c:24
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