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)