9302
9303
9304
9305
9306
9307
9308
9309 INTEGER IA, ICPRNT, IRPRNT, JA, M, N, NOUT
9310
9311
9312 CHARACTER*(*) CMATNM
9313 INTEGER DESCA( * )
9314 COMPLEX A( * ), WORK( * )
9315
9316
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 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
9441 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
9442 $ RSRC_
9443 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
9444 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
9445 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
9446 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
9447
9448
9449 INTEGER MYCOL, MYROW, NPCOL, NPROW, PCOL, PROW
9450
9451
9452 INTEGER DESCA2( DLEN_ )
9453
9454
9456
9457
9458
9459
9460
9461 IF( ( m.LE.0 ).OR.( n.LE.0 ) )
9462 $ RETURN
9463
9464
9465
9467
9468 CALL blacs_gridinfo( desca2( ctxt_ ), nprow, npcol, myrow, mycol )
9469
9470 IF( desca2( rsrc_ ).GE.0 ) THEN
9471 IF( desca2( csrc_ ).GE.0 ) THEN
9472 CALL pb_pclaprn2( m, n, a, ia, ja, desca2, irprnt, icprnt,
9473 $ cmatnm, nout, desca2( rsrc_ ),
9474 $ desca2( csrc_ ), work )
9475 ELSE
9476 DO 10 pcol = 0, npcol - 1
9477 IF( ( myrow.EQ.irprnt ).AND.( mycol.EQ.icprnt ) )
9478 $ WRITE( nout, * ) 'Colum-replicated array -- ' ,
9479 $ 'copy in process column: ', pcol
9480 CALL pb_pclaprn2( m, n, a, ia, ja, desca2, irprnt,
9481 $ icprnt, cmatnm, nout, desca2( rsrc_ ),
9482 $ pcol, work )
9483 10 CONTINUE
9484 END IF
9485 ELSE
9486 IF( desca2( csrc_ ).GE.0 ) THEN
9487 DO 20 prow = 0, nprow - 1
9488 IF( ( myrow.EQ.irprnt ).AND.( mycol.EQ.icprnt ) )
9489 $ WRITE( nout, * ) 'Row-replicated array -- ' ,
9490 $ 'copy in process row: ', prow
9491 CALL pb_pclaprn2( m, n, a, ia, ja, desca2, irprnt,
9492 $ icprnt, cmatnm, nout, prow,
9493 $ desca2( csrc_ ), work )
9494 20 CONTINUE
9495 ELSE
9496 DO 40 prow = 0, nprow - 1
9497 DO 30 pcol = 0, npcol - 1
9498 IF( ( myrow.EQ.irprnt ).AND.( mycol.EQ.icprnt ) )
9499 $ WRITE( nout, * ) 'Replicated array -- ' ,
9500 $ 'copy in process (', prow, ',', pcol, ')'
9501 CALL pb_pclaprn2( m, n, a, ia, ja, desca2, irprnt,
9502 $ icprnt, cmatnm, nout, prow, pcol,
9503 $ work )
9504 30 CONTINUE
9505 40 CONTINUE
9506 END IF
9507 END IF
9508
9509 RETURN
9510
9511
9512
subroutine pb_desctrans(descin, descout)
subroutine pb_pclaprn2(m, n, a, ia, ja, desca, irprnt, icprnt, cmatnm, nout, prow, pcol, work)