1 SUBROUTINE pbctrget( ICONTXT, ADIST, M, N, MNB, A, LDA, MCROW,
2 $ MCCOL, IGD, MYROW, MYCOL, NPROW, NPCOL )
10 INTEGER ICONTXT, IGD, LDA, M, MCCOL, MCROW, MNB, MYCOL,
11 $ myrow, n, npcol, nprow
28 parameter( one = 1.0e+0, two = 2.0e+0 )
31 INTEGER KINT, KINT2, KLEN, KMOD, KPPOS, NLEN, NNUM,
38 EXTERNAL lsame, iceil, numroc
41 EXTERNAL cgerv2d, cgesd2d
48 IF( lsame( adist,
'R' ) )
THEN
49 kppos = mod( nprow+myrow-mcrow, nprow )
50 IF( mod( kppos, igd ).EQ.0 )
THEN
53 nnum =
min( nprow/igd, mnb-mccol )
57 IF( kppos.GE.nnum )
GO TO 30
58 kppos = mod( kppos, nprow )
61 IF( temp.GT.one )
THEN
63 kmod = mod( kppos, kint2 )
66 IF( kppos+kint.LT.nnum )
THEN
67 klen = ntlen - (kppos/kint2)*(kint2/igd)*n
68 klen =
min( klen-nlen, nlen )
69 CALL cgerv2d( icontxt, m, klen, a(1,nlen+1), lda,
70 $ mod(myrow+kint, nprow), mycol )
74 CALL cgesd2d( icontxt, m, nlen, a, lda,
75 $ mod(nprow+myrow-kint, nprow), mycol )
87 ELSE IF( lsame( adist,
'C' ) )
THEN
89 kppos = mod( npcol+mycol-mccol, npcol )
90 IF( mod( kppos, igd ).EQ.0 )
THEN
93 nnum =
min( npcol/igd, mnb-mcrow )
97 IF( kppos.GE.nnum )
GO TO 30
98 kppos = mod( kppos, npcol )
101 IF( temp.GT.one )
THEN
103 kmod = mod( kppos, kint2 )
106 IF( kppos+kint.LT.nnum )
THEN
107 klen = ntlen - (kppos/kint2)*(kint2/igd)*n
108 klen =
min( klen-nlen, nlen )
109 CALL cgerv2d( icontxt, m, klen, a(1,nlen+1), lda,
110 $ myrow, mod(mycol+kint, npcol) )
114 CALL cgesd2d( icontxt, m, nlen, a, lda, myrow,
115 $ mod(npcol+mycol-kint, npcol) )