OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pchkxmat.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine pchk1mat (ma, mapos0, na, napos0, ia, ja, desca, descapos0, nextra, ex, expos, info)
subroutine pchk2mat (ma, mapos0, na, napos0, ia, ja, desca, descapos0, mb, mbpos0, nb, nbpos0, ib, jb, descb, descbpos0, nextra, ex, expos, info)
subroutine globchk (ictxt, n, x, ldx, iwork, info)

Function/Subroutine Documentation

◆ globchk()

subroutine globchk ( integer ictxt,
integer n,
integer, dimension( ldx, 2 ) x,
integer ldx,
integer, dimension( n ) iwork,
integer info )

Definition at line 402 of file pchkxmat.f.

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*
min
#define min(a, b)
Definition macros.h:20
blacs_gridinfo
subroutine blacs_gridinfo(cntxt, nprow, npcol, myrow, mycol)
Definition mpi.f:754

◆ pchk1mat()

subroutine pchk1mat ( integer ma,
integer mapos0,
integer na,
integer napos0,
integer ia,
integer ja,
integer, dimension( * ) desca,
integer descapos0,
integer nextra,
integer, dimension( nextra ) ex,
integer, dimension( nextra ) expos,
integer info )

Definition at line 1 of file pchkxmat.f.

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*
globchk
subroutine globchk(ictxt, n, x, ldx, iwork, info)
Definition pchkxmat.f:403

◆ pchk2mat()

subroutine pchk2mat ( integer ma,
integer mapos0,
integer na,
integer napos0,
integer ia,
integer ja,
integer, dimension( * ) desca,
integer descapos0,
integer mb,
integer mbpos0,
integer nb,
integer nbpos0,
integer ib,
integer jb,
integer, dimension( 8 ) descb,
integer descbpos0,
integer nextra,
integer, dimension( nextra ) ex,
integer, dimension( nextra ) expos,
integer info )

Definition at line 172 of file pchkxmat.f.

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*