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

Go to the source code of this file.

Functions/Subroutines

subroutine pdmatgen2 (ictxt, aform, diag, m, n, mb, nb, a, lda, iarow, iacol, iseed, iroff, irnum, icoff, icnum, myrow, mycol, nprow, npcol)

Function/Subroutine Documentation

◆ pdmatgen2()

subroutine pdmatgen2 ( integer ictxt,
character*1 aform,
character*1 diag,
integer m,
integer n,
integer mb,
integer nb,
double precision, dimension( lda, * ) a,
integer lda,
integer iarow,
integer iacol,
integer iseed,
integer iroff,
integer irnum,
integer icoff,
integer icnum,
integer myrow,
integer mycol,
integer nprow,
integer npcol )

Definition at line 1 of file pdmatgen2.f.

4*
5*
6* Modified version by K. L. Dackland (U added)
7* Modified version by Peter Poromaa, Heavy DIAG
8* Modified version by Robert Granat, R(andom) added
9*
10* .. Scalar Arguments ..
11 CHARACTER*1 AFORM, DIAG
12 INTEGER IACOL, IAROW, ICNUM, ICOFF, ICTXT, IRNUM,
13 $ IROFF, ISEED, LDA, M, MB, MYCOL, MYROW, N,
14 $ NB, NPCOL, NPROW
15* ..
16* .. Array Arguments ..
17 DOUBLE PRECISION A( LDA, * )
18* ..
19*
20* Purpose
21* =======
22*
23* PDMATGEN2 : Parallel Real Double precision MATrix GENerator.
24* Generate (or regenerate) a distributed matrix A (or sub-matrix of A).
25*
26* Arguments
27* =========
28*
29* ICTXT (global input) INTEGER
30* The BLACS context handle, indicating the global context of
31* the operation. The context itself is global.
32*
33* AFORM (global input) CHARACTER*1
34* if AFORM = 'U' : A returned is an Upper triangular matrix.
35* if AFORM = 'S' : A is returned is a symmetric matrix.
36* if AFORM = 'H' : A is returned is a Hermitian matrix.
37* if AFORM = 'T' : A is overwritten with the transpose of
38* what would normally be generated.
39* if AFORM = 'C' : A is overwritten with the conjugate trans-
40* pose of what would normally be generated.
41* if AFORM = 'R' A random matrix is generated.
42*
43* DIAG (global input) CHARACTER*1
44* if DIAG = 'D' : A is diagonally dominant.
45*
46* M (global input) INTEGER
47* The number of rows in the generated distributed matrix.
48*
49* N (global input) INTEGER
50* The number of columns in the generated distributed
51* matrix.
52*
53* MB (global input) INTEGER
54* The row blocking factor of the distributed matrix A.
55*
56* NB (global input) INTEGER
57* The column blocking factor of the distributed matrix A.
58*
59* A (local output) DOUBLE PRECISION, pointer into the local
60* memory to an array of dimension ( LDA, * ) containing the
61* local pieces of the distributed matrix.
62*
63* LDA (local input) INTEGER
64* The leading dimension of the array containing the local
65* pieces of the distributed matrix A.
66*
67* IAROW (global input) INTEGER
68* The row processor coordinate which holds the first block
69* of the distributed matrix A.
70*
71* IACOL (global input) INTEGER
72* The column processor coordinate which holds the first
73* block of the distributed matrix A.
74*
75* ISEED (global input) INTEGER
76* The seed number to generate the distributed matrix A.
77*
78* IROFF (local input) INTEGER
79* The number of local rows of A that have already been
80* generated. It should be a multiple of MB.
81*
82* IRNUM (local input) INTEGER
83* The number of local rows to be generated.
84*
85* ICOFF (local input) INTEGER
86* The number of local columns of A that have already been
87* generated. It should be a multiple of NB.
88*
89* ICNUM (local input) INTEGER
90* The number of local columns to be generated.
91*
92* MYROW (local input) INTEGER
93* The row process coordinate of the calling process.
94*
95* MYCOL (local input) INTEGER
96* The column process coordinate of the calling process.
97*
98* NPROW (global input) INTEGER
99* The number of process rows in the grid.
100*
101* NPCOL (global input) INTEGER
102* The number of process columns in the grid.
103*
104* Notes
105* =====
106*
107* The code is originally developed by David Walker, ORNL,
108* and modified by Jaeyoung Choi, ORNL.
109*
110* Reference: G. Fox et al.
111* Section 12.3 of "Solving problems on concurrent processors Vol. I"
112*
113* =====================================================================
114*
115* .. Parameters ..
116 INTEGER MULT0, MULT1, IADD0, IADD1
117 parameter( mult0=20077, mult1=16838, iadd0=12345,
118 $ iadd1=0 )
119 DOUBLE PRECISION ONE, TWO, ZERO
120 parameter( one = 1.0d+0, two = 2.0d+0, zero = 0.0d+0 )
121* ..
122* .. Local Scalars ..
123 LOGICAL SYMM, HERM, TRAN, UPPR, RANDOM
124 INTEGER I, IC, IK, INFO, IOFFC, IOFFR, IR, J, JK,
125 $ JUMP1, JUMP2, JUMP3, JUMP4, JUMP5, JUMP6,
126 $ JUMP7, MAXMN, MEND, MOFF, MP, MRCOL, MRROW,
127 $ NEND, NOFF, NPMB, NQ, NQNB
128* ..
129* .. Local Arrays ..
130 INTEGER IADD(2), IA1(2), IA2(2), IA3(2), IA4(2),
131 $ IA5(2), IB1(2), IB2(2), IB3(2), IC1(2), IC2(2),
132 $ IC3(2), IC4(2), IC5(2), IRAN1(2), IRAN2(2),
133 $ IRAN3(2), IRAN4(2), ITMP1(2), ITMP2(2),
134 $ ITMP3(2), JSEED(2), MULT(2)
135* ..
136* .. External Subroutines ..
137 EXTERNAL jumpit, pxerbla, setran, xjumpm
138* ..
139* .. Intrinsic Functions ..
140 INTRINSIC abs, max, mod
141* ..
142* .. External Functions ..
143 LOGICAL LSAME
144 INTEGER ICEIL, NUMROC
145 DOUBLE PRECISION PDRAND
146 EXTERNAL iceil, numroc, lsame, pdrand
147* ..
148* .. Executable Statements ..
149*
150* Test the input arguments
151*
152 mp = numroc( m, mb, myrow, iarow, nprow )
153 nq = numroc( n, nb, mycol, iacol, npcol )
154 symm = lsame( aform, 'S' )
155 uppr = lsame( aform, 'u' )
156 HERM = LSAME( AFORM, 'h' )
157 TRAN = LSAME( AFORM, 't' )
158 RANDOM = LSAME( AFORM, 'r' )
159*
160 INFO = 0
161.NOT..OR..OR..OR..OR..AND. IF( ( UPPRSYMMHERMTRANRANDOM )
162.NOT. $ LSAME( AFORM, 'c.AND.' )
163.NOT. $ LSAME( AFORM, 'n' ) ) THEN
164 INFO = 2
165.NOT. ELSE IF( LSAME( DIAG, 'd.AND.' )
166.NOT. $ LSAME( DIAG, 'n' ) ) THEN
167 INFO = 3
168.OR..OR. ELSE IF( UPPRSYMMHERM ) THEN
169.NE. IF( MN ) THEN
170 INFO = 5
171.NE. ELSE IF( MBNB ) THEN
172 INFO = 7
173 END IF
174.LT. ELSE IF( M0 ) THEN
175 INFO = 4
176.LT. ELSE IF( N0 ) THEN
177 INFO = 5
178.LT. ELSE IF( MB1 ) THEN
179 INFO = 6
180.LT. ELSE IF( NB1 ) THEN
181 INFO = 7
182.LT. ELSE IF( LDA0 ) THEN
183 INFO = 9
184.LT..OR..GE. ELSE IF( ( IAROW0 )( IAROWNPROW ) ) THEN
185 INFO = 10
186.LT..OR..GE. ELSE IF( ( IACOL0 )( IACOLNPCOL ) ) THEN
187 INFO = 11
188.GT. ELSE IF( MOD(IROFF,MB)0 ) THEN
189 INFO = 13
190.GT. ELSE IF( IRNUM(MP-IROFF) ) THEN
191 INFO = 14
192.GT. ELSE IF( MOD(ICOFF,NB)0 ) THEN
193 INFO = 15
194.GT. ELSE IF( ICNUM(NQ-ICOFF) ) THEN
195 INFO = 16
196.LT..OR..GE. ELSE IF( ( MYROW0 )( MYROWNPROW ) ) THEN
197 INFO = 17
198.LT..OR..GE. ELSE IF( ( MYCOL0 )( MYCOLNPCOL ) ) THEN
199 INFO = 18
200 END IF
201.NE. IF( INFO0 ) THEN
202 CALL PXERBLA( ICTXT, 'pdmatgen2', INFO )
203 RETURN
204 END IF
205 MRROW = MOD( NPROW+MYROW-IAROW, NPROW )
206 MRCOL = MOD( NPCOL+MYCOL-IACOL, NPCOL )
207 NPMB = NPROW * MB
208 NQNB = NPCOL * NB
209 MOFF = IROFF / MB
210 NOFF = ICOFF / NB
211 MEND = ICEIL(IRNUM, MB) + MOFF
212 NEND = ICEIL(ICNUM, NB) + NOFF
213*
214 MULT(1) = MULT0
215 MULT(2) = MULT1
216 IADD(1) = IADD0
217 IADD(2) = IADD1
218 JSEED(1) = ISEED
219 JSEED(2) = 0
220*
221* Symmetric or Hermitian matrix will be generated.
222*
223.OR. IF( SYMMHERM ) THEN
224*
225* First, generate the lower triangular part (with diagonal block)
226*
227 JUMP1 = 1
228 JUMP2 = NPMB
229 JUMP3 = M
230 JUMP4 = NQNB
231 JUMP5 = NB
232 JUMP6 = MRCOL
233 JUMP7 = MB*MRROW
234*
235 CALL XJUMPM( JUMP1, MULT, IADD, JSEED, IRAN1, IA1, IC1 )
236 CALL XJUMPM( JUMP2, MULT, IADD, IRAN1, ITMP1, IA2, IC2 )
237 CALL XJUMPM( JUMP3, MULT, IADD, IRAN1, ITMP1, IA3, IC3 )
238 CALL XJUMPM( JUMP4, IA3, IC3, IRAN1, ITMP1, IA4, IC4 )
239 CALL XJUMPM( JUMP5, IA3, IC3, IRAN1, ITMP1, IA5, IC5 )
240 CALL XJUMPM( JUMP6, IA5, IC5, IRAN1, ITMP3, ITMP1, ITMP2 )
241 CALL XJUMPM( JUMP7, MULT, IADD, ITMP3, IRAN1, ITMP1, ITMP2 )
242 CALL XJUMPM( NOFF, IA4, IC4, IRAN1, ITMP1, ITMP2, ITMP3 )
243 CALL XJUMPM( MOFF, IA2, IC2, ITMP1, IRAN1, ITMP2, ITMP3 )
244 CALL SETRAN( IRAN1, IA1, IC1 )
245*
246 DO 10 I = 1, 2
247 IB1(I) = IRAN1(I)
248 IB2(I) = IRAN1(I)
249 IB3(I) = IRAN1(I)
250 10 CONTINUE
251*
252 JK = 1
253 DO 80 IC = NOFF+1, NEND
254 IOFFC = ((IC-1)*NPCOL+MRCOL) * NB
255 DO 70 I = 1, NB
256.GT. IF( JK ICNUM ) GO TO 90
257*
258 IK = 1
259 DO 50 IR = MOFF+1, MEND
260 IOFFR = ((IR-1)*NPROW+MRROW) * MB
261*
262.GT. IF( IOFFR IOFFC ) THEN
263 DO 20 J = 1, MB
264.GT. IF( IK IRNUM ) GO TO 60
265 A(IK,JK) = ONE - TWO*PDRAND(0)
266 IK = IK + 1
267 20 CONTINUE
268*
269.EQ. ELSE IF( IOFFC IOFFR ) THEN
270 IK = IK + I - 1
271.GT. IF( IK IRNUM ) GO TO 60
272 DO 30 J = 1, I-1
273 A(IK,JK) = ONE - TWO*PDRAND(0)
274 30 CONTINUE
275 A(IK,JK) = ONE - TWO*PDRAND(0)
276 DO 40 J = 1, MB-I
277.GT. IF( IK+J IRNUM ) GO TO 60
278 A(IK+J,JK) = ONE - TWO*PDRAND(0)
279 A(IK,JK+J) = A(IK+J,JK)
280 40 CONTINUE
281 IK = IK + MB - I + 1
282 ELSE
283 IK = IK + MB
284 END IF
285*
286 CALL JUMPIT( IA2, IC2, IB1, IRAN2 )
287 IB1(1) = IRAN2(1)
288 IB1(2) = IRAN2(2)
289 50 CONTINUE
290*
291 60 CONTINUE
292 JK = JK + 1
293 CALL JUMPIT( IA3, IC3, IB2, IRAN3 )
294 IB1(1) = IRAN3(1)
295 IB1(2) = IRAN3(2)
296 IB2(1) = IRAN3(1)
297 IB2(2) = IRAN3(2)
298 70 CONTINUE
299*
300 CALL JUMPIT( IA4, IC4, IB3, IRAN4 )
301 IB1(1) = IRAN4(1)
302 IB1(2) = IRAN4(2)
303 IB2(1) = IRAN4(1)
304 IB2(2) = IRAN4(2)
305 IB3(1) = IRAN4(1)
306 IB3(2) = IRAN4(2)
307 80 CONTINUE
308*
309* Next, generate the upper triangular part.
310*
311 90 CONTINUE
312 MULT(1) = MULT0
313 MULT(2) = MULT1
314 IADD(1) = IADD0
315 IADD(2) = IADD1
316 JSEED(1) = ISEED
317 JSEED(2) = 0
318*
319 JUMP1 = 1
320 JUMP2 = NQNB
321 JUMP3 = N
322 JUMP4 = NPMB
323 JUMP5 = MB
324 JUMP6 = MRROW
325 JUMP7 = NB*MRCOL
326*
327 CALL XJUMPM( JUMP1, MULT, IADD, JSEED, IRAN1, IA1, IC1 )
328 CALL XJUMPM( JUMP2, MULT, IADD, IRAN1, ITMP1, IA2, IC2 )
329 CALL XJUMPM( JUMP3, MULT, IADD, IRAN1, ITMP1, IA3, IC3 )
330 CALL XJUMPM( JUMP4, IA3, IC3, IRAN1, ITMP1, IA4, IC4 )
331 CALL XJUMPM( JUMP5, IA3, IC3, IRAN1, ITMP1, IA5, IC5 )
332 CALL XJUMPM( JUMP6, IA5, IC5, IRAN1, ITMP3, ITMP1, ITMP2 )
333 CALL XJUMPM( JUMP7, MULT, IADD, ITMP3, IRAN1, ITMP1, ITMP2 )
334 CALL XJUMPM( MOFF, IA4, IC4, IRAN1, ITMP1, ITMP2, ITMP3 )
335 CALL XJUMPM( NOFF, IA2, IC2, ITMP1, IRAN1, ITMP2, ITMP3 )
336 CALL SETRAN( IRAN1, IA1, IC1 )
337*
338 DO 100 I = 1, 2
339 IB1(I) = IRAN1(I)
340 IB2(I) = IRAN1(I)
341 IB3(I) = IRAN1(I)
342 100 CONTINUE
343*
344 IK = 1
345 DO 150 IR = MOFF+1, MEND
346 IOFFR = ((IR-1)*NPROW+MRROW) * MB
347 DO 140 J = 1, MB
348.GT. IF( IK IRNUM ) GO TO 160
349 JK = 1
350 DO 120 IC = NOFF+1, NEND
351 IOFFC = ((IC-1)*NPCOL+MRCOL) * NB
352.GT. IF( IOFFC IOFFR ) THEN
353 DO 110 I = 1, NB
354.GT. IF( JK ICNUM ) GO TO 130
355 A(IK,JK) = ONE - TWO*PDRAND(0)
356 JK = JK + 1
357 110 CONTINUE
358 ELSE
359 JK = JK + NB
360 END IF
361 CALL JUMPIT( IA2, IC2, IB1, IRAN2 )
362 IB1(1) = IRAN2(1)
363 IB1(2) = IRAN2(2)
364 120 CONTINUE
365*
366 130 CONTINUE
367 IK = IK + 1
368 CALL JUMPIT( IA3, IC3, IB2, IRAN3 )
369 IB1(1) = IRAN3(1)
370 IB1(2) = IRAN3(2)
371 IB2(1) = IRAN3(1)
372 IB2(2) = IRAN3(2)
373 140 CONTINUE
374*
375 CALL JUMPIT( IA4, IC4, IB3, IRAN4 )
376 IB1(1) = IRAN4(1)
377 IB1(2) = IRAN4(2)
378 IB2(1) = IRAN4(1)
379 IB2(2) = IRAN4(2)
380 IB3(1) = IRAN4(1)
381 IB3(2) = IRAN4(2)
382 150 CONTINUE
383 160 CONTINUE
384*
385* Generate an upper triangular matrix.
386*
387 ELSE IF ( UPPR ) THEN
388 JUMP1 = 1
389 JUMP2 = NPMB
390 JUMP3 = M
391 JUMP4 = NQNB
392 JUMP5 = NB
393 JUMP6 = MRCOL
394 JUMP7 = MB*MRROW
395*
396 CALL XJUMPM( JUMP1, MULT, IADD, JSEED, IRAN1, IA1, IC1 )
397 CALL XJUMPM( JUMP2, MULT, IADD, IRAN1, ITMP1, IA2, IC2 )
398 CALL XJUMPM( JUMP3, MULT, IADD, IRAN1, ITMP1, IA3, IC3 )
399 CALL XJUMPM( JUMP4, IA3, IC3, IRAN1, ITMP1, IA4, IC4 )
400 CALL XJUMPM( JUMP5, IA3, IC3, IRAN1, ITMP1, IA5, IC5 )
401 CALL XJUMPM( JUMP6, IA5, IC5, IRAN1, ITMP3, ITMP1, ITMP2 )
402 CALL XJUMPM( JUMP7, MULT, IADD, ITMP3, IRAN1, ITMP1, ITMP2 )
403 CALL XJUMPM( NOFF, IA4, IC4, IRAN1, ITMP1, ITMP2, ITMP3 )
404 CALL XJUMPM( MOFF, IA2, IC2, ITMP1, IRAN1, ITMP2, ITMP3 )
405 CALL SETRAN( IRAN1, IA1, IC1 )
406*
407 DO 1000 I = 1, 2
408 IB1(I) = IRAN1(I)
409 IB2(I) = IRAN1(I)
410 IB3(I) = IRAN1(I)
411 1000 CONTINUE
412*
413 JK = 1
414 DO 8000 IC = NOFF+1, NEND
415 IOFFC = ((IC-1)*NPCOL+MRCOL) * NB
416 DO 7000 I = 1, NB
417.GT. IF( JK ICNUM ) GO TO 8000
418*
419 IK = 1
420 DO 5000 IR = MOFF+1, MEND
421 IOFFR = ((IR-1)*NPROW+MRROW) * MB
422*
423.EQ. IF( IOFFC IOFFR ) THEN
424 IK = IK + I - 1
425.GT. IF( IK IRNUM ) GO TO 6000
426 DO 3000 J = 1, I-1
427 A(IK,JK) = ONE - TWO*PDRAND(0)
428 3000 CONTINUE
429 A(IK,JK) = ONE - TWO*PDRAND(0)
430 DO 4000 J = 1, MB-I
431.GT. IF( IK+J IRNUM ) GO TO 6000
432 A(IK,JK+J) = ONE - TWO*PDRAND(0)
433 4000 CONTINUE
434 IK = IK + MB - I + 1
435 ELSE
436 IK = IK + MB
437 END IF
438*
439 CALL JUMPIT( IA2, IC2, IB1, IRAN2 )
440 IB1(1) = IRAN2(1)
441 IB1(2) = IRAN2(2)
442 5000 CONTINUE
443*
444 6000 CONTINUE
445 JK = JK + 1
446 CALL JUMPIT( IA3, IC3, IB2, IRAN3 )
447 IB1(1) = IRAN3(1)
448 IB1(2) = IRAN3(2)
449 IB2(1) = IRAN3(1)
450 IB2(2) = IRAN3(2)
451 7000 CONTINUE
452*
453 CALL JUMPIT( IA4, IC4, IB3, IRAN4 )
454 IB1(1) = IRAN4(1)
455 IB1(2) = IRAN4(2)
456 IB2(1) = IRAN4(1)
457 IB2(2) = IRAN4(2)
458 IB3(1) = IRAN4(1)
459 IB3(2) = IRAN4(2)
460 8000 CONTINUE
461 MULT(1) = MULT0
462 MULT(2) = MULT1
463 IADD(1) = IADD0
464 IADD(2) = IADD1
465 JSEED(1) = ISEED
466 JSEED(2) = 0
467*
468 JUMP1 = 1
469 JUMP2 = NQNB
470 JUMP3 = N
471 JUMP4 = NPMB
472 JUMP5 = MB
473 JUMP6 = MRROW
474 JUMP7 = NB*MRCOL
475*
476 CALL XJUMPM( JUMP1, MULT, IADD, JSEED, IRAN1, IA1, IC1 )
477 CALL XJUMPM( JUMP2, MULT, IADD, IRAN1, ITMP1, IA2, IC2 )
478 CALL XJUMPM( JUMP3, MULT, IADD, IRAN1, ITMP1, IA3, IC3 )
479 CALL XJUMPM( JUMP4, IA3, IC3, IRAN1, ITMP1, IA4, IC4 )
480 CALL XJUMPM( JUMP5, IA3, IC3, IRAN1, ITMP1, IA5, IC5 )
481 CALL XJUMPM( JUMP6, IA5, IC5, IRAN1, ITMP3, ITMP1, ITMP2 )
482 CALL XJUMPM( JUMP7, MULT, IADD, ITMP3, IRAN1, ITMP1, ITMP2 )
483 CALL XJUMPM( MOFF, IA4, IC4, IRAN1, ITMP1, ITMP2, ITMP3 )
484 CALL XJUMPM( NOFF, IA2, IC2, ITMP1, IRAN1, ITMP2, ITMP3 )
485 CALL SETRAN( IRAN1, IA1, IC1 )
486*
487 DO 1110 I = 1, 2
488 IB1(I) = IRAN1(I)
489 IB2(I) = IRAN1(I)
490 IB3(I) = IRAN1(I)
491 1110 CONTINUE
492*
493 IK = 1
494 DO 1500 IR = MOFF+1, MEND
495 IOFFR = ((IR-1)*NPROW+MRROW) * MB
496 DO 1400 J = 1, MB
497.GT. IF( IK IRNUM ) GO TO 1600
498 JK = 1
499 DO 1200 IC = NOFF+1, NEND
500 IOFFC = ((IC-1)*NPCOL+MRCOL) * NB
501.GT. IF( IOFFC IOFFR ) THEN
502 DO 1100 I = 1, NB
503.GT. IF( JK ICNUM ) GO TO 1300
504 A(IK,JK) = ONE - TWO*PDRAND(0)
505 JK = JK + 1
506 1100 CONTINUE
507 ELSE
508 JK = JK + NB
509 END IF
510 CALL JUMPIT( IA2, IC2, IB1, IRAN2 )
511 IB1(1) = IRAN2(1)
512 IB1(2) = IRAN2(2)
513 1200 CONTINUE
514*
515 1300 CONTINUE
516 IK = IK + 1
517 CALL JUMPIT( IA3, IC3, IB2, IRAN3 )
518 IB1(1) = IRAN3(1)
519 IB1(2) = IRAN3(2)
520 IB2(1) = IRAN3(1)
521 IB2(2) = IRAN3(2)
522 1400 CONTINUE
523*
524 CALL JUMPIT( IA4, IC4, IB3, IRAN4 )
525 IB1(1) = IRAN4(1)
526 IB1(2) = IRAN4(2)
527 IB2(1) = IRAN4(1)
528 IB2(2) = IRAN4(2)
529 IB3(1) = IRAN4(1)
530 IB3(2) = IRAN4(2)
531 1500 CONTINUE
532 1600 CONTINUE
533*
534* (Conjugate) Transposed matrix A will be generated.
535*
536.OR. ELSE IF( TRAN LSAME( AFORM, 'c' ) ) THEN
537*
538 jump1 = 1
539 jump2 = nqnb
540 jump3 = n
541 jump4 = npmb
542 jump5 = mb
543 jump6 = mrrow
544 jump7 = nb*mrcol
545*
546 CALL xjumpm( jump1, mult, iadd, jseed, iran1, ia1, ic1 )
547 CALL xjumpm( jump2, mult, iadd, iran1, itmp1, ia2, ic2 )
548 CALL xjumpm( jump3, mult, iadd, iran1, itmp1, ia3, ic3 )
549 CALL xjumpm( jump4, ia3, ic3, iran1, itmp1, ia4, ic4 )
550 CALL xjumpm( jump5, ia3, ic3, iran1, itmp1, ia5, ic5 )
551 CALL xjumpm( jump6, ia5, ic5, iran1, itmp3, itmp1, itmp2 )
552 CALL xjumpm( jump7, mult, iadd, itmp3, iran1, itmp1, itmp2 )
553 CALL xjumpm( moff, ia4, ic4, iran1, itmp1, itmp2, itmp3 )
554 CALL xjumpm( noff, ia2, ic2, itmp1, iran1, itmp2, itmp3 )
555 CALL setran( iran1, ia1, ic1 )
556*
557 DO 170 i = 1, 2
558 ib1(i) = iran1(i)
559 ib2(i) = iran1(i)
560 ib3(i) = iran1(i)
561 170 CONTINUE
562*
563 ik = 1
564 DO 220 ir = moff+1, mend
565 ioffr = ((ir-1)*nprow+mrrow) * mb
566 DO 210 j = 1, mb
567 IF( ik .GT. irnum ) GO TO 230
568 jk = 1
569 DO 190 ic = noff+1, nend
570 ioffc = ((ic-1)*npcol+mrcol) * nb
571 DO 180 i = 1, nb
572 IF( jk .GT. icnum ) GO TO 200
573 a(ik,jk) = one - two*pdrand(0)
574 jk = jk + 1
575 180 CONTINUE
576 CALL jumpit( ia2, ic2, ib1, iran2 )
577 ib1(1) = iran2(1)
578 ib1(2) = iran2(2)
579 190 CONTINUE
580*
581 200 CONTINUE
582 ik = ik + 1
583 CALL jumpit( ia3, ic3, ib2, iran3 )
584 ib1(1) = iran3(1)
585 ib1(2) = iran3(2)
586 ib2(1) = iran3(1)
587 ib2(2) = iran3(2)
588 210 CONTINUE
589*
590 CALL jumpit( ia4, ic4, ib3, iran4 )
591 ib1(1) = iran4(1)
592 ib1(2) = iran4(2)
593 ib2(1) = iran4(1)
594 ib2(2) = iran4(2)
595 ib3(1) = iran4(1)
596 ib3(2) = iran4(2)
597 220 CONTINUE
598 230 CONTINUE
599*
600* A random matrix is generated.
601*
602 ELSEIF( random ) THEN
603*
604 jump1 = 1
605 jump2 = npmb
606 jump3 = m
607 jump4 = nqnb
608 jump5 = nb
609 jump6 = mrcol
610 jump7 = mb*mrrow
611*
612 CALL xjumpm( jump1, mult, iadd, jseed, iran1, ia1, ic1 )
613 CALL xjumpm( jump2, mult, iadd, iran1, itmp1, ia2, ic2 )
614 CALL xjumpm( jump3, mult, iadd, iran1, itmp1, ia3, ic3 )
615 CALL xjumpm( jump4, ia3, ic3, iran1, itmp1, ia4, ic4 )
616 CALL xjumpm( jump5, ia3, ic3, iran1, itmp1, ia5, ic5 )
617 CALL xjumpm( jump6, ia5, ic5, iran1, itmp3, itmp1, itmp2 )
618 CALL xjumpm( jump7, mult, iadd, itmp3, iran1, itmp1, itmp2 )
619 CALL xjumpm( noff, ia4, ic4, iran1, itmp1, itmp2, itmp3 )
620 CALL xjumpm( moff, ia2, ic2, itmp1, iran1, itmp2, itmp3 )
621 CALL setran( iran1, ia1, ic1 )
622*
623 DO 240 i = 1, 2
624 ib1(i) = iran1(i)
625 ib2(i) = iran1(i)
626 ib3(i) = iran1(i)
627 240 CONTINUE
628*
629 jk = 1
630 DO 290 ic = noff+1, nend
631 ioffc = ((ic-1)*npcol+mrcol) * nb
632 DO 280 i = 1, nb
633 IF( jk .GT. icnum ) GO TO 300
634 ik = 1
635 DO 260 ir = moff+1, mend
636 ioffr = ((ir-1)*nprow+mrrow) * mb
637 DO 250 j = 1, mb
638 IF( ik .GT. irnum ) GO TO 270
639 a(ik,jk) = one - two*pdrand(0)
640 ik = ik + 1
641 250 CONTINUE
642 CALL jumpit( ia2, ic2, ib1, iran2 )
643 ib1(1) = iran2(1)
644 ib1(2) = iran2(2)
645 260 CONTINUE
646*
647 270 CONTINUE
648 jk = jk + 1
649 CALL jumpit( ia3, ic3, ib2, iran3 )
650 ib1(1) = iran3(1)
651 ib1(2) = iran3(2)
652 ib2(1) = iran3(1)
653 ib2(2) = iran3(2)
654 280 CONTINUE
655*
656 CALL jumpit( ia4, ic4, ib3, iran4 )
657 ib1(1) = iran4(1)
658 ib1(2) = iran4(2)
659 ib2(1) = iran4(1)
660 ib2(2) = iran4(2)
661 ib3(1) = iran4(1)
662 ib3(2) = iran4(2)
663 290 CONTINUE
664 300 CONTINUE
665 END IF
666*
667* Diagonally dominant matrix will be generated.
668*
669 IF( lsame( diag, 'D' ) ) THEN
670 IF( mb.NE.nb ) THEN
671 WRITE(*,*) 'Diagonally dominant matrices with rowNB not'//
672 $ ' equal colNB is not supported!'
673 RETURN
674 END IF
675*
676 maxmn = max(m, n)
677 jk = 1
678 DO 340 ic = noff+1, nend
679 ioffc = ((ic-1)*npcol+mrcol) * nb
680 ik = 1
681 DO 320 ir = moff+1, mend
682 ioffr = ((ir-1)*nprow+mrrow) * mb
683 IF( ioffc.EQ.ioffr ) THEN
684 DO 310 j = 0, mb-1
685 IF( ik .GT. irnum ) GO TO 330
686 a(ik,jk+j) = abs(a(ik,jk+j)) + maxmn
687 ik = ik + 1
688 310 CONTINUE
689 ELSE
690 ik = ik + mb
691 END IF
692 320 CONTINUE
693 330 CONTINUE
694 jk = jk + nb
695 340 CONTINUE
696 END IF
697*
698 RETURN
699*
700* End of PDMATGEN2
701*
pdrand
double precision function pdrand(idumm)
Definition pmatgeninc.f:272
jumpit
subroutine jumpit(mult, iadd, irann, iranm)
Definition pmatgeninc.f:183
xjumpm
subroutine xjumpm(jumpm, mult, iadd, irann, iranm, iam, icm)
Definition pmatgeninc.f:85
setran
subroutine setran(iran, ia, ic)
Definition pmatgeninc.f:142
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:53
iceil
integer function iceil(inum, idenom)
Definition iceil.f:2
max
#define max(a, b)
Definition macros.h:21
pxerbla
subroutine pxerbla(contxt, srname, info)
Definition mpi.f:1600
numroc
integer function numroc(n, nb, iproc, isrcproc, nprocs)
Definition mpi.f:786
pdmatgen2
subroutine pdmatgen2(ictxt, aform, diag, m, n, mb, nb, a, lda, iarow, iacol, iseed, iroff, irnum, icoff, icnum, myrow, mycol, nprow, npcol)
Definition pdmatgen2.f:4