1 SUBROUTINE pcmatgen( ICTXT, AFORM, DIAG, M, N, MB, NB, A, LDA,
2 $ IAROW, IACOL, ISEED, IROFF, IRNUM, ICOFF,
3 $ ICNUM, MYROW, MYCOL, NPROW, NPCOL )
11 CHARACTER*1 AFORM, DIAG
12 INTEGER IACOL, IAROW, ICNUM, ICOFF, ICTXT, IRNUM,
13 $ iroff, iseed, lda, m, mb, mycol, myrow, n,
115 INTEGER MULT0, MULT1, IADD0, IADD1
116 PARAMETER ( MULT0=20077, mult1=16838, iadd0=12345,
119 PARAMETER ( ONE = 1.0e+0, two = 2.0e+0, zero = 0.0e+0 )
122 LOGICAL SYMM, HERM, TRAN
123 INTEGER , IC, IK, INFO, IOFFC, IOFFR, IR, J, JK,
124 $ jump1, jump2, jump3, jump4, jump5, jump6,
125 $ jump7, maxmn, mend, moff, mp, mrcol, mrrow,
126 $ nend, noff, npmb, nq, nqnb
130 INTEGER IADD(2), IA1(2), IA2(2), IA3(2), IA4(2),
131 $ IA5(2), IB1(2), IB2(2), IB3(2), IC1(2),
133 $ iran3(2), iran4(2), itmp1(2), itmp2(2),
134 $ itmp3(2), jseed(2), mult(2)
140 INTRINSIC abs, aimag,
cmplx, conjg,
max, mod, real
144 INTEGER ICEIL, NUMROC
146 EXTERNAL iceil, numroc, lsame, psrand
152 mp = numroc( m, mb, myrow, iarow, nprow )
153 nq = numroc( n, nb, mycol, iacol, npcol )
154 symm = lsame( aform,
'S' )
155 herm = lsame( aform,
'H' )
156 tran = lsame( aform,
'T' )
159 IF( .NOT.lsame( diag,
'D' ) .AND.
160 $ .NOT.lsame( diag,
'N' ) )
THEN
162 ELSE IF( symm.OR.herm )
THEN
165 ELSE IF( mb.NE.nb )
THEN
168 ELSE IF( m.LT.0 )
THEN
170 ELSE IF( n.LT.0 )
THEN
172 ELSE IF( mb.LT.1 )
THEN
174 ELSE IF( nb.LT.1 )
THEN
176 ELSE IF( lda.LT.0 )
THEN
178 ELSE IF( ( iarow.LT.0 ).OR.( iarow.GE.nprow ) )
THEN
180 ELSE IF( ( iacol.LT.0 ).OR.( iacol.GE.npcol ) )
THEN
182 ELSE IF( mod(iroff,mb).GT.0 )
THEN
184 ELSE IF( irnum.GT.(mp-iroff) )
THEN
186 ELSE IF( mod(icoff,nb).GT.0 )
THEN
188 ELSE IF( icnum.GT.(nq-icoff) )
THEN
190 ELSE IF( ( myrow.LT.0 ).OR.( myrow.GE.nprow ) )
THEN
192 ELSE IF( ( mycol.LT.0 ).OR.( mycol.GE.npcol ) )
THEN
200 MRROW = MOD( NPROW+MYROW-IAROW, NPROW )
201 MRCOL = MOD( NPCOL+MYCOL-IACOL, NPCOL )
206 MEND = ICEIL(IRNUM, MB) + MOFF
207 NEND = ICEIL(ICNUM, NB) + NOFF
218.OR.
IF( SYMMHERM ) THEN
230 CALL XJUMPM( JUMP1, MULT, IADD, JSEED, IRAN1, IA1, IC1 )
231 CALL XJUMPM( JUMP2, MULT, IADD, IRAN1, ITMP1, IA2, IC2 )
232 CALL XJUMPM( JUMP3, MULT, IADD, IRAN1, ITMP1, IA3, IC3 )
233 CALL XJUMPM( JUMP4, IA3, IC3, IRAN1, ITMP1, IA4, IC4 )
234 CALL XJUMPM( JUMP5, IA3, IC3, IRAN1, ITMP1, IA5, IC5 )
235 CALL XJUMPM( JUMP6, IA5, IC5, IRAN1, ITMP3, ITMP1, ITMP2 )
236 CALL XJUMPM( JUMP7, MULT, IADD, ITMP3, IRAN1, ITMP1, ITMP2 )
237 CALL XJUMPM( NOFF, IA4, IC4, IRAN1, ITMP1, ITMP2, ITMP3 )
238 CALL XJUMPM( MOFF, IA2, IC2, ITMP1, IRAN1, ITMP2, ITMP3 )
239 CALL SETRAN( IRAN1, IA1, IC1 )
248 DO 80 IC = NOFF+1, NEND
249 IOFFC = ((IC-1)*NPCOL+MRCOL) * NB
251.GT.
IF( JK ICNUM ) GO TO 90
254 DO 50 IR = MOFF+1, MEND
255 IOFFR = ((IR-1)*NPROW+MRROW) * MB
257.GT.
IF( IOFFR IOFFC ) THEN
259.GT.
IF( IK IRNUM ) GO TO 60
260 A(IK,JK) = CMPLX( ONE - TWO*PSRAND(0),
261 $ ONE - TWO*PSRAND(0) )
265.EQ.
ELSE IF( IOFFC IOFFR ) THEN
267.GT.
IF( IK IRNUM ) GO TO 60
269 A(IK,JK) = CMPLX( PSRAND(0), PSRAND(0) )
272 A(IK,JK) = CMPLX( ONE - TWO*PSRAND(0),
273 $ ONE - TWO*PSRAND(0) )
275 A(IK,JK) = CMPLX( ONE - TWO*PSRAND(0), ZERO )
279.GT.
IF( IK+J IRNUM ) GO TO 60
280 A(IK+J,JK) = CMPLX( ONE - TWO*PSRAND(0),
281 $ ONE - TWO*PSRAND(0) )
283 A(IK,JK+J) = CONJG( A(IK+J,JK) )
285 A(IK,JK+J) = A(IK+J,JK)
293 CALL JUMPIT( IA2, IC2, IB1, IRAN2 )
300 CALL JUMPIT( IA3, IC3, IB2, IRAN3 )
307 CALL JUMPIT( IA4, IC4, IB3, IRAN4 )
334 CALL XJUMPM( JUMP1, MULT, IADD, JSEED, IRAN1, IA1, IC1 )
335 CALL XJUMPM( JUMP2, MULT, IADD, IRAN1, ITMP1, IA2, IC2 )
336 CALL XJUMPM( JUMP3, MULT, IADD, IRAN1, ITMP1, IA3, IC3 )
337 CALL XJUMPM( JUMP4, IA3, IC3, IRAN1, ITMP1, IA4, IC4 )
338 CALL XJUMPM( JUMP5, IA3, IC3, IRAN1, ITMP1, IA5, IC5 )
339 CALL XJUMPM( JUMP6, IA5, IC5, IRAN1, ITMP3, ITMP1, ITMP2 )
340 CALL XJUMPM( JUMP7, MULT, IADD, ITMP3, IRAN1, ITMP1, ITMP2 )
341 CALL XJUMPM( MOFF, IA4, IC4, IRAN1, ITMP1, ITMP2, ITMP3 )
342 CALL XJUMPM( NOFF, IA2, IC2, ITMP1, IRAN1, ITMP2, ITMP3 )
343 CALL SETRAN( IRAN1, IA1, IC1 )
352 DO 150 IR = MOFF+1, MEND
353 IOFFR = ((IR-1)*NPROW+MRROW) * MB
355.GT.
IF( IK IRNUM ) GO TO 160
357 DO 120 IC = NOFF+1, NEND
358 IOFFC = ((IC-1)*NPCOL+MRCOL) * NB
359.GT.
IF( IOFFC IOFFR ) THEN
361.GT.
IF( JK ICNUM ) GO TO 130
363 A(IK,JK) = CMPLX( ONE - TWO*PSRAND(0),
364 $ ONE - TWO*PSRAND(0) )
366 A(IK,JK) = CMPLX( ONE - TWO*PSRAND(0),
367 $ TWO*PSRAND(0) - ONE )
374 CALL JUMPIT( IA2, IC2, IB1, IRAN2 )
381 CALL JUMPIT( IA3, IC3, IB2, IRAN3 )
388 CALL JUMPIT( IA4, IC4, IB3, IRAN4 )
400.OR.
ELSE IF( TRAN LSAME( AFORM, 'c
' ) ) THEN
410 CALL XJUMPM( JUMP1, MULT, IADD, JSEED, IRAN1, IA1, IC1 )
411 CALL XJUMPM( JUMP2, MULT, IADD, IRAN1, ITMP1, IA2, IC2 )
412 CALL XJUMPM( JUMP3, MULT, IADD, IRAN1, ITMP1, IA3, IC3 )
413 CALL XJUMPM( JUMP4, IA3, IC3, IRAN1, ITMP1, IA4, IC4 )
414 CALL XJUMPM( JUMP5, IA3, IC3, IRAN1, ITMP1, IA5, IC5 )
415 CALL XJUMPM( JUMP6, IA5, IC5, IRAN1, ITMP3, ITMP1, ITMP2 )
416 CALL XJUMPM( JUMP7, MULT, IADD, ITMP3, IRAN1, ITMP1, ITMP2 )
417 CALL XJUMPM( MOFF, IA4, IC4, IRAN1, ITMP1, ITMP2, ITMP3 )
418 CALL XJUMPM( NOFF, IA2, IC2, ITMP1, IRAN1, ITMP2, ITMP3 )
419 CALL SETRAN( IRAN1, IA1, IC1 )
428 DO 220 IR = MOFF+1, MEND
429 IOFFR = ((IR-1)*NPROW+MRROW) * MB
431.GT.
IF( IK IRNUM ) GO TO 230
433 DO 190 IC = NOFF+1, NEND
434 IOFFC = ((IC-1)*NPCOL+MRCOL) * NB
436.GT.
IF( JK ICNUM ) GO TO 200
438 A(IK,JK) = CMPLX( ONE - TWO*PSRAND(0),
439 $ ONE - TWO*PSRAND(0) )
441 A(IK,JK) = CMPLX( ONE - TWO*PSRAND(0),
442 $ TWO*PSRAND(0) - ONE )
446 CALL JUMPIT( IA2, IC2, IB1, IRAN2 )
453 CALL JUMPIT( IA3, IC3, IB2, IRAN3 )
460 CALL JUMPIT( IA4, IC4, IB3, IRAN4 )
482 CALL XJUMPM( JUMP1, MULT, IADD, JSEED, IRAN1, IA1, IC1 )
483 CALL XJUMPM( JUMP2, MULT, IADD, IRAN1, ITMP1, IA2, IC2 )
484 CALL XJUMPM( JUMP3, MULT, IADD, IRAN1, ITMP1, IA3, IC3 )
485 CALL XJUMPM( JUMP4, IA3, IC3, IRAN1, ITMP1, IA4, IC4 )
486 CALL XJUMPM( JUMP5, IA3, IC3, IRAN1, ITMP1, IA5, IC5 )
487 CALL XJUMPM( JUMP6, IA5, IC5, IRAN1, ITMP3, ITMP1, ITMP2 )
488 CALL XJUMPM( JUMP7, MULT, IADD, ITMP3, IRAN1, ITMP1, ITMP2 )
489 CALL XJUMPM( NOFF, IA4, IC4, IRAN1, ITMP1, ITMP2, ITMP3 )
490 CALL XJUMPM( MOFF, IA2, IC2, ITMP1, IRAN1, ITMP2, ITMP3 )
491 CALL SETRAN( IRAN1, IA1, IC1 )
500 DO 290 IC = NOFF+1, NEND
501 IOFFC = ((IC-1)*NPCOL+MRCOL) * NB
503.GT.
IF( JK ICNUM ) GO TO 300
505 DO 260 IR = MOFF+1, MEND
506 IOFFR = ((IR-1)*NPROW+MRROW) * MB
508.GT.
IF( IK IRNUM ) GO TO 270
509 A(IK,JK) = CMPLX( ONE - TWO*PSRAND(0),
510 $ ONE - TWO*PSRAND(0) )
513 CALL JUMPIT( IA2, IC2, IB1, IRAN2 )
520 CALL JUMPIT( IA3, IC3, IB2, IRAN3 )
527 CALL JUMPIT( IA4, IC4, IB3, IRAN4 )
540 IF( LSAME( DIAG, 'd
' ) ) THEN
542 WRITE(*,*) 'diagonally dominant matrices with rownb not
'//
543 $ ' equal colnb is not supported
549 DO 340 ic = noff+1, nend
550 ioffc = ((ic-1)*npcol+mrcol) * nb
552 DO 320 ir = moff+1, mend
553 ioffr = ((ir-1)*nprow+mrrow) * mb
554 IF( ioffc.EQ.ioffr )
THEN
556 IF( ik .GT. irnum )
GO TO 330
559 $ abs(real(a(ik,jk+j)))+2*maxmn, zero )
561 a(ik,jk+j) =
cmplx( abs(real(a(ik,jk+j)))+maxmn,
562 $ abs(aimag(a(ik,jk+j)))+ maxmn )
subroutine pcmatgen(ictxt, aform, diag, m, n, mb, nb, a, lda, iarow, iacol, iseed, iroff, irnum, icoff, icnum, myrow, mycol, nprow, npcol)