SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
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
min
#define min(A, B)
Definition pcgemr.c:181
pchk1mat
subroutine pchk1mat(ma, mapos0, na, napos0, ia, ja, desca, descapos0, nextra, ex, expos, info)
Definition pchkxmat.f:3
globchk
subroutine globchk(ictxt, n, x, ldx, iwork, info)
Definition pchkxmat.f:403
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