9304
9305
9306
9307
9308
9309
9310
9311 INTEGER IA, ICPRNT, IRPRNT, JA, M, N, NOUT
9312
9313
9314 CHARACTER*(*) CMATNM
9315 INTEGER DESCA( * )
9316 COMPLEX*16 A( * ), WORK( * )
9317
9318
9319
9320
9321
9322
9323
9324
9325
9326
9327
9328
9329
9330
9331
9332
9333
9334
9335
9336
9337
9338
9339
9340
9341
9342
9343
9344
9345
9346
9347
9348
9349
9350
9351
9352
9353
9354
9355
9356
9357
9358
9359
9360
9361
9362
9363
9364
9365
9366
9367
9368
9369
9370
9371
9372
9373
9374
9375
9376
9377
9378
9379
9380
9381
9382
9383
9384
9385
9386
9387
9388
9389
9390
9391
9392
9393
9394
9395
9396
9397
9398
9399
9400
9401
9402
9403
9404
9405
9406
9407
9408
9409
9410
9411
9412
9413
9414
9415
9416
9417
9418
9419
9420
9421
9422
9423
9424
9425
9426
9427
9428
9429
9430
9431
9432
9433
9434
9435
9436
9437
9438
9439
9440
9441
9442 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
9443 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
9444 $ RSRC_
9445 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
9446 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
9447 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
9448 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
9449
9450
9451 INTEGER MYCOL, MYROW, NPCOL, NPROW, PCOL, PROW
9452
9453
9454 INTEGER DESCA2( DLEN_ )
9455
9456
9458
9459
9460
9461
9462
9463 IF( ( m.LE.0 ).OR.( n.LE.0 ) )
9464 $ RETURN
9465
9466
9467
9469
9470 CALL blacs_gridinfo( desca2( ctxt_ ), nprow, npcol, myrow, mycol )
9471
9472 IF( desca2( rsrc_ ).GE.0 ) THEN
9473 IF( desca2( csrc_ ).GE.0 ) THEN
9474 CALL pb_pzlaprn2( m, n, a, ia, ja, desca2, irprnt, icprnt,
9475 $ cmatnm, nout, desca2( rsrc_ ),
9476 $ desca2( csrc_ ), work )
9477 ELSE
9478 DO 10 pcol = 0, npcol - 1
9479 IF( ( myrow.EQ.irprnt ).AND.( mycol.EQ.icprnt ) )
9480 $ WRITE( nout, * ) 'Colum-replicated array -- ' ,
9481 $ 'copy in process column: ', pcol
9482 CALL pb_pzlaprn2( m, n, a, ia, ja, desca2, irprnt,
9483 $ icprnt, cmatnm, nout, desca2( rsrc_ ),
9484 $ pcol, work )
9485 10 CONTINUE
9486 END IF
9487 ELSE
9488 IF( desca2( csrc_ ).GE.0 ) THEN
9489 DO 20 prow = 0, nprow - 1
9490 IF( ( myrow.EQ.irprnt ).AND.( mycol.EQ.icprnt ) )
9491 $ WRITE( nout, * ) 'Row-replicated array -- ' ,
9492 $ 'copy in process row: ', prow
9493 CALL pb_pzlaprn2( m, n, a, ia, ja, desca2, irprnt,
9494 $ icprnt, cmatnm, nout, prow,
9495 $ desca2( csrc_ ), work )
9496 20 CONTINUE
9497 ELSE
9498 DO 40 prow = 0, nprow - 1
9499 DO 30 pcol = 0, npcol - 1
9500 IF( ( myrow.EQ.irprnt ).AND.( mycol.EQ.icprnt ) )
9501 $ WRITE( nout, * ) 'Replicated array -- ' ,
9502 $ 'copy in process (', prow, ',', pcol, ')'
9503 CALL pb_pzlaprn2( m, n, a, ia, ja, desca2, irprnt,
9504 $ icprnt, cmatnm, nout, prow, pcol,
9505 $ work )
9506 30 CONTINUE
9507 40 CONTINUE
9508 END IF
9509 END IF
9510
9511 RETURN
9512
9513
9514
subroutine pb_desctrans(descin, descout)
subroutine pb_pzlaprn2(m, n, a, ia, ja, desca, irprnt, icprnt, cmatnm, nout, prow, pcol, work)