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__
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)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,
186 BLOCK_CYCLIC_2D, BLOCK_CYCLIC_2D_INB );
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 }
403