1 SUBROUTINE pdlamve( UPLO, M, N, A, IA, JA, DESCA, B, IB, JB,
15 INTEGER IA, IB, JA, JB, M, N
18 INTEGER DESCA( * ), DESCB( * )
19 DOUBLE PRECISION A( * ), B( * ), DWORK( * )
143 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
144 $ lld_, mb_, m_, nb_, n_, rsrc_
145 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
146 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
147 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
150 LOGICAL UPPER, LOWER, FULL
151 INTEGER ICTXT, NPROW, NPCOL, MYROW, MYCOL, MYPROC,
152 $ nprocs, arows, acols, k, sproc, srsrc, scsrc,
153 $ rproc, rrsrc, rcsrc, count, j, i, iia, jja,
154 $ iib, jjb, brsrc, bcsrc, rarows, racols,
155 $ index, idum, numrec, numsnd
162 INTEGER ICEIL, NUMROC, INDXL2G
163 EXTERNAL iceil, lsame, numroc, indxl2g
172 ictxt = desca( ctxt_ )
173 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
177 upper = lsame( uplo,
'U' )
178 IF( .NOT. upper ) lower = lsame( uplo,
'L' )
179 full = (.NOT. upper) .AND. (.NOT. lower)
187 IF( nprocs.EQ.1 )
THEN
188 CALL dlamov( uplo, m, n, a((ja-1)*desca(lld_)+ia),
189 $ desca(lld_), b((jb-1)*descb(lld_)+ib),
192 CALL pdgemr2d( m, n, a, ia, ja, desca, b, ib, jb, descb,
195 CALL pdgemr2d( m, n, a, ia, ja, desca, dwork, ib, jb, descb,
197 CALL pdlacpy( uplo, m, n, dwork, ib, jb, descb, b, ib, jb,