ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pchkxmat.f
Go to the documentation of this file.
1  SUBROUTINE pchk1mat( MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA,
2  $ DESCAPOS0, NEXTRA, EX, EXPOS, INFO )
3 *
4 * -- ScaLAPACK tools routine (version 1.7) --
5 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
6 * and University of California, Berkeley.
7 * May 1, 1997
8 *
9 * .. Scalar Arguments ..
10  INTEGER DESCAPOS0, IA, INFO, JA, MA, MAPOS0, NA,
11  $ napos0, nextra
12 * ..
13 * .. Array Arguments ..
14  INTEGER DESCA( * ), EX( NEXTRA ), EXPOS( NEXTRA )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * PCHK1MAT checks that the values associated with one distributed
21 * matrix are consistant across the entire process grid.
22 *
23 * Notes
24 * =====
25 *
26 * This routine checks that all values are the same across the grid.
27 * It does no local checking; it is therefore legal to abuse the
28 * definitions of the non-descriptor arguments, i.e., if the routine
29 * you are checking does not possess a MA value, you may pass some
30 * other integer that must be global into this argument instead.
31 *
32 * Arguments
33 * =========
34 *
35 * MA (global input) INTEGER
36 * The global number of matrix rows of A being operated on.
37 *
38 * MAPOS0 (global input) INTEGER
39 * Where in the calling routine's parameter list MA appears.
40 *
41 * NA (global input) INTEGER
42 * The global number of matrix columns of A being operated on.
43 *
44 * NAPOS0 (global input) INTEGER
45 * Where in the calling routine's parameter list NA appears.
46 *
47 * IA (global input) INTEGER
48 * The row index in the global array A indicating the first
49 * row of sub( A ).
50 *
51 * JA (global input) INTEGER
52 * The column index in the global array A indicating the
53 * first column of sub( A ).
54 *
55 * DESCA (global and local input) INTEGER array of dimension DLEN_.
56 * The array descriptor for the distributed matrix A.
57 *
58 * DESCAPOS0 (global input) INTEGER
59 * Where in the calling routine's parameter list DESCA
60 * appears. Note that we assume IA and JA are respectively 2
61 * and 1 entries behind DESCA.
62 *
63 * NEXTRA (global input) INTEGER
64 * The number of extra parameters (i.e., besides the ones
65 * above) to check. NEXTRA <= LDW - 11.
66 *
67 * EX (local input) INTEGER array of dimension (NEXTRA)
68 * The values of these extra parameters
69 *
70 * EXPOS (local input) INTEGER array of dimension (NEXTRA)
71 * The parameter list positions of these extra values.
72 *
73 * INFO (local input/global output) INTEGER
74 * = 0: successful exit
75 * < 0: If the i-th argument is an array and the j-entry had
76 * an illegal value, then INFO = -(i*100+j), if the i-th
77 * argument is a scalar and had an illegal value, then
78 * INFO = -i.
79 *
80 * =====================================================================
81 *
82 * .. Parameters ..
83  INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
84  $ lld_, mb_, m_, nb_, n_, rsrc_
85  parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
86  $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
87  $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
88  INTEGER BIGNUM, DESCMULT, LDW
89  parameter( descmult = 100, bignum = descmult * descmult,
90  $ ldw = 25 )
91 * ..
92 * .. Local Scalars ..
93  INTEGER DESCPOS, K
94 * ..
95 * .. Local Arrays ..
96  INTEGER IWORK( LDW, 2 ), IWORK2( LDW )
97 * ..
98 * .. External Subroutines ..
99  EXTERNAL globchk
100 * ..
101 * .. Executable Statements ..
102 *
103 * Want to find errors with MIN( ), so if no error, set it to a big
104 * number. If there already is an error, multiply by the the
105 * descriptor multiplier.
106 *
107  IF( info.GE.0 ) THEN
108  info = bignum
109  ELSE IF( info.LT.-descmult ) THEN
110  info = -info
111  ELSE
112  info = -info * descmult
113  END IF
114 *
115 * Pack values and their positions in the parameter list, factoring
116 * in the descriptor multiplier
117 *
118  iwork( 1, 1 ) = ma
119  iwork( 1, 2 ) = mapos0 * descmult
120  iwork( 2, 1 ) = na
121  iwork( 2, 2 ) = napos0 * descmult
122  iwork( 3, 1 ) = ia
123  iwork( 3, 2 ) = (descapos0-2) * descmult
124  iwork( 4, 1 ) = ja
125  iwork( 4, 2 ) = (descapos0-1) * descmult
126  descpos = descapos0 * descmult
127 *
128  iwork( 5, 1 ) = desca( dtype_ )
129  iwork( 5, 2 ) = descpos + dtype_
130  iwork( 6, 1 ) = desca( m_ )
131  iwork( 6, 2 ) = descpos + m_
132  iwork( 7, 1 ) = desca( n_ )
133  iwork( 7, 2 ) = descpos + n_
134  iwork( 8, 1 ) = desca( mb_ )
135  iwork( 8, 2 ) = descpos + mb_
136  iwork( 9, 1 ) = desca( nb_ )
137  iwork( 9, 2 ) = descpos + nb_
138  iwork( 10, 1 ) = desca( rsrc_ )
139  iwork( 10, 2 ) = descpos + rsrc_
140  iwork( 11, 1 ) = desca( csrc_ )
141  iwork( 11, 2 ) = descpos + csrc_
142 *
143  IF( nextra.GT.0 ) THEN
144  DO 10 k = 1, nextra
145  iwork( 11+k, 1 ) = ex( k )
146  iwork( 11+k, 2 ) = expos( k )
147  10 CONTINUE
148  END IF
149  k = 11 + nextra
150 *
151 * Get the smallest error detected anywhere (BIGNUM if no error)
152 *
153  CALL globchk( desca( ctxt_ ), k, iwork, ldw, iwork2, info )
154 *
155 * Prepare output: set info = 0 if no error, and divide by DESCMULT if
156 * error is not in a descriptor entry
157 *
158  IF( info .EQ. bignum ) THEN
159  info = 0
160  ELSE IF( mod( info, descmult ) .EQ. 0 ) THEN
161  info = -info / descmult
162  ELSE
163  info = -info
164  END IF
165 *
166  RETURN
167 *
168 * End of PCHK1MAT
169 *
170  END
171 *
172  SUBROUTINE pchk2mat( MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA,
173  $ DESCAPOS0, MB, MBPOS0, NB, NBPOS0, IB, JB,
174  $ DESCB, DESCBPOS0, NEXTRA, EX, EXPOS, INFO )
175 *
176 * -- ScaLAPACK tools routine (version 1.7) --
177 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
178 * and University of California, Berkeley.
179 * May 1, 1997
180 *
181 * .. Scalar Arguments ..
182  INTEGER DESCAPOS0, DESCBPOS0, IA, IB, INFO, JA, JB, MA,
183  $ MAPOS0, MB, MBPOS0, NA, NAPOS0, NB, NBPOS0,
184  $ NEXTRA
185 * ..
186 * .. Array Arguments ..
187  INTEGER DESCA( * ), DESCB( 8 ), EX( NEXTRA ),
188  $ EXPOS( NEXTRA )
189 * ..
190 *
191 * Purpose
192 * =======
193 *
194 * PCHK2MAT checks that the values associated with two distributed
195 * matrices are consistant across the entire process grid.
196 *
197 * Notes
198 * =====
199 *
200 * This routine checks that all values are the same across the grid.
201 * It does no local checking; it is therefore legal to abuse the
202 * definitions of the non-descriptor arguments, i.e., if the routine
203 * you are checking does not possess a MA value, you may pass some
204 * other integer that must be global into this argument instead.
205 *
206 * Arguments
207 * =========
208 *
209 * MA (global input) INTEGER
210 * The global number of matrix rows of A being operated on.
211 *
212 * MAPOS0 (global input) INTEGER
213 * Where in the calling routine's parameter list MA appears.
214 *
215 * NA (global input) INTEGER
216 * The global number of matrix columns of A being operated on.
217 *
218 * NAPOS0 (global input) INTEGER
219 * Where in the calling routine's parameter list NA appears.
220 *
221 * IA (global input) INTEGER
222 * The row index in the global array A indicating the first
223 * row of sub( A ).
224 *
225 * JA (global input) INTEGER
226 * The column index in the global array A indicating the
227 * first column of sub( A ).
228 *
229 * DESCA (global and local input) INTEGER array of dimension DLEN_.
230 * The array descriptor for the distributed matrix A.
231 *
232 * DESCAPOS0 (global input) INTEGER
233 * Where in the calling routine's parameter list DESCA
234 * appears. Note that we assume IA and JA are respectively 2
235 * and 1 entries behind DESCA.
236 *
237 * MB (global input) INTEGER
238 * The global number of matrix rows of B being operated on.
239 *
240 * MBPOS0 (global input) INTEGER
241 * Where in the calling routine's parameter list MB appears.
242 *
243 * NB (global input) INTEGER
244 * The global number of matrix columns of B being operated on.
245 *
246 * NBPOS0 (global input) INTEGER
247 * Where in the calling routine's parameter list NB appears.
248 *
249 * IB (global input) INTEGER
250 * The row index in the global array B indicating the first
251 * row of sub( B ).
252 *
253 * JB (global input) INTEGER
254 * The column index in the global array B indicating the
255 * first column of sub( B ).
256 *
257 * DESCB (global and local input) INTEGER array of dimension DLEN_.
258 * The array descriptor for the distributed matrix B.
259 *
260 * DESCBPOS0 (global input) INTEGER
261 * Where in the calling routine's parameter list DESCB
262 * appears. Note that we assume IB and JB are respectively 2
263 * and 1 entries behind DESCB.
264 *
265 * NEXTRA (global input) INTEGER
266 * The number of extra parameters (i.e., besides the ones
267 * above) to check. NEXTRA <= LDW - 22.
268 *
269 * EX (local input) INTEGER array of dimension (NEXTRA)
270 * The values of these extra parameters
271 *
272 * EXPOS (local input) INTEGER array of dimension (NEXTRA)
273 * The parameter list positions of these extra values.
274 *
275 * INFO (local input/global output) INTEGER
276 * = 0: successful exit
277 * < 0: If the i-th argument is an array and the j-entry had
278 * an illegal value, then INFO = -(i*100+j), if the i-th
279 * argument is a scalar and had an illegal value, then
280 * INFO = -i.
281 *
282 * =====================================================================
283 *
284 * .. Parameters ..
285  INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
286  $ LLD_, MB_, M_, NB_, N_, RSRC_
287  PARAMETER ( BLOCK_CYCLIC_2D = 1, dlen_ = 9, dtype_ = 1,
288  $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
289  $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
290  INTEGER DESCMULT, BIGNUM, LDW
291  PARAMETER ( DESCMULT = 100, bignum = descmult * descmult,
292  $ ldw = 35 )
293 * ..
294 * .. Local Scalars ..
295  INTEGER K, DESCPOS
296 * ..
297 * .. Local Arrays ..
298  INTEGER IWORK( LDW, 2 ), IWORK2( LDW )
299 * ..
300 * .. External Subroutines ..
301  EXTERNAL globchk
302 * ..
303 * .. Intrinsic Functions ..
304  INTRINSIC mod
305 * ..
306 * .. Executable Statements ..
307 *
308 * Want to find errors with MIN( ), so if no error, set it to a big
309 * number. If there already is an error, multiply by the the
310 * descriptor multiplier.
311 *
312  IF( info.GE.0 ) THEN
313  info = bignum
314  ELSE IF( info.LT.-descmult ) THEN
315  info = -info
316  ELSE
317  info = -info * descmult
318  END IF
319 *
320 * Pack values and their positions in the parameter list, factoring
321 * in the descriptor multiplier
322 *
323  iwork( 1, 1 ) = ma
324  iwork( 1, 2 ) = mapos0 * descmult
325  iwork( 2, 1 ) = na
326  iwork( 2, 2 ) = napos0 * descmult
327  iwork( 3, 1 ) = ia
328  iwork( 3, 2 ) = (descapos0-2) * descmult
329  iwork( 4, 1 ) = ja
330  iwork( 4, 2 ) = (descapos0-1) * descmult
331  descpos = descapos0 * descmult
332 *
333  iwork( 5, 1 ) = desca( dtype_ )
334  iwork( 5, 2 ) = descpos + dtype_
335  iwork( 6, 1 ) = desca( m_ )
336  iwork( 6, 2 ) = descpos + m_
337  iwork( 7, 1 ) = desca( n_ )
338  iwork( 7, 2 ) = descpos + n_
339  iwork( 8, 1 ) = desca( mb_ )
340  iwork( 8, 2 ) = descpos + mb_
341  iwork( 9, 1 ) = desca( nb_ )
342  iwork( 9, 2 ) = descpos + nb_
343  iwork( 10, 1 ) = desca( rsrc_ )
344  iwork( 10, 2 ) = descpos + rsrc_
345  iwork( 11, 1 ) = desca( csrc_ )
346  iwork( 11, 2 ) = descpos + csrc_
347 *
348  iwork( 12, 1 ) = mb
349  iwork( 12, 2 ) = mbpos0 * descmult
350  iwork( 13, 1 ) = nb
351  iwork( 13, 2 ) = nbpos0 * descmult
352  iwork( 14, 1 ) = ib
353  iwork( 14, 2 ) = (descbpos0-2) * descmult
354  iwork( 15, 1 ) = jb
355  iwork( 15, 2 ) = (descbpos0-1) * descmult
356  descpos = descbpos0 * descmult
357 *
358  iwork( 16, 1 ) = descb( dtype_ )
359  iwork( 16, 2 ) = descpos + dtype_
360  iwork( 17, 1 ) = descb( m_ )
361  iwork( 17, 2 ) = descpos + m_
362  iwork( 18, 1 ) = descb( n_ )
363  iwork( 18, 2 ) = descpos + n_
364  iwork( 19, 1 ) = descb( mb_ )
365  iwork( 19, 2 ) = descpos + mb_
366  iwork( 20, 1 ) = descb( nb_ )
367  iwork( 20, 2 ) = descpos + nb_
368  iwork( 21, 1 ) = descb( rsrc_ )
369  iwork( 21, 2 ) = descpos + rsrc_
370  iwork( 22, 1 ) = descb( csrc_ )
371  iwork( 22, 2 ) = descpos + csrc_
372 *
373  IF( nextra.GT.0 ) THEN
374  DO 10 k = 1, nextra
375  iwork( 22+k, 1 ) = ex( k )
376  iwork( 22+k, 2 ) = expos( k )
377  10 CONTINUE
378  END IF
379  k = 22 + nextra
380 *
381 * Get the smallest error detected anywhere (BIGNUM if no error)
382 *
383  CALL globchk( desca( ctxt_ ), k, iwork, ldw, iwork2, info )
384 *
385 * Prepare output: set info = 0 if no error, and divide by DESCMULT
386 * if error is not in a descriptor entry.
387 *
388  IF( info.EQ.bignum ) THEN
389  info = 0
390  ELSE IF( mod( info, descmult ) .EQ. 0 ) THEN
391  info = -info / descmult
392  ELSE
393  info = -info
394  END IF
395 *
396  RETURN
397 *
398 * End of PCHK2MAT
399 *
400  END
401 *
402  SUBROUTINE globchk( ICTXT, N, X, LDX, IWORK, INFO )
403 *
404 * -- ScaLAPACK tools routine (version 1.7) --
405 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
406 * and University of California, Berkeley.
407 * May 1, 1997
408 *
409 * .. Scalar Arguments ..
410  INTEGER ICTXT, INFO, LDX, N
411 * ..
412 * .. Array Arguments ..
413  INTEGER IWORK( N ), X( LDX, 2 )
414 * ..
415 *
416 * Purpose
417 * =======
418 *
419 * GLOBCHK checks that values in X(i,1) are the same on all processes
420 * in the process grid indicated by ICTXT.
421 *
422 * Arguments
423 * =========
424 *
425 * ICTXT (global input) INTEGER
426 * The BLACS context handle indicating the context over which
427 * the values are to be the same.
428 *
429 * N (global input) INTEGER
430 * The number of values to be compared.
431 *
432 * X (local input) INTEGER array, dimension (N,2)
433 * The 1st column contains the values which should be the same
434 * on all processes. The 2nd column indicates where in the
435 * calling routine's parameter list the corresponding value
436 * from column 1 came from.
437 *
438 * LDX (local input) INTEGER
439 * The leading dimension of the array X. LDX >= MAX(1,N).
440 *
441 * IWORK (local workspace) INTEGER array, dimension (N)
442 * Used to receive other processes' values for comparing with X.
443 *
444 * INFO (local input/global output) INTEGER
445 * On entry, the smallest error flag so far generated, or BIGNUM
446 * for no error. On exit:
447 * = BIGNUM : no error
448 * < 0: if INFO = -i*100, the i-th argument had an illegal
449 * value, or was different between processes.
450 *
451 * =====================================================================
452 *
453 * .. Local Scalars ..
454  INTEGER K, MYROW, MYCOL
455 * ..
456 * .. External Subroutines ..
457  EXTERNAL blacs_gridinfo, igamn2d, igebr2d, igebs2d
458 * ..
459 * .. Intrinsic Functions ..
460  INTRINSIC min
461 * ..
462 * .. Executable Statements ..
463 *
464  CALL blacs_gridinfo( ictxt, iwork, k, myrow, mycol )
465 *
466  IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
467  CALL igebs2d( ictxt, 'All', ' ', n, 1, x, n )
468  ELSE
469  CALL igebr2d( ictxt, 'All', ' ', n, 1, iwork, n, 0, 0 )
470  DO 10 k = 1, n
471  IF( x( k, 1 ).NE.iwork( k ) )
472  $ info = min( info, x( k, 2 ) )
473  10 CONTINUE
474  END IF
475 *
476  CALL igamn2d( ictxt, 'All', ' ', 1, 1, info, 1, k, k, -1, -1, 0 )
477 *
478  RETURN
479 *
480 * End GLOBCHK
481 *
482  END
globchk
subroutine globchk(ICTXT, N, X, LDX, IWORK, INFO)
Definition: pchkxmat.f:403
pchk1mat
subroutine pchk1mat(MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA, DESCAPOS0, NEXTRA, EX, EXPOS, INFO)
Definition: pchkxmat.f:3
pchk2mat
subroutine pchk2mat(MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA, DESCAPOS0, MB, MBPOS0, NB, NBPOS0, IB, JB, DESCB, DESCBPOS0, NEXTRA, EX, EXPOS, INFO)
Definition: pchkxmat.f:175
min
#define min(A, B)
Definition: pcgemr.c:181