ScaLAPACK 2.1  2.1 ScaLAPACK: Scalable Linear Algebra PACKage
pbdtrget.f
Go to the documentation of this file.
1  SUBROUTINE pbdtrget( ICONTXT, ADIST, M, N, MNB, A, LDA, MCROW,
2  \$ MCCOL, IGD, MYROW, MYCOL, NPROW, NPCOL )
3 *
4 * -- PB-BLAS routine (version 2.1) --
5 * University of Tennessee, Knoxville, Oak Ridge National Laboratory.
6 * April 28, 1996
7 *
8 * .. Scalar Arguments ..
10  INTEGER ICONTXT, IGD, LDA, M, MCCOL, MCROW, MNB, MYCOL,
11  \$ myrow, n, npcol, nprow
12 * ..
13 * .. Array Arguments ..
14  DOUBLE PRECISION A( LDA, * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * PBDTRGET forms a row block of A from scattered row subblocks if
21 * ADIST = 'R', or forms a column block of A from scattered column
22 * subblocks, if ADIST = 'C'.
23 *
24 * =====================================================================
25 *
26 * .. Parameters ..
27  REAL ONE, TWO
28  parameter( one = 1.0e+0, two = 2.0e+0 )
29 * ..
30 * .. Local Variables ..
31  INTEGER KINT, KINT2, KLEN, KMOD, KPPOS, NLEN, NNUM,
32  \$ ntlen
33  REAL TEMP
34 * ..
35 * .. External Functions ..
36  LOGICAL LSAME
37  INTEGER ICEIL, NUMROC
38  EXTERNAL lsame, iceil, numroc
39 * ..
40 * .. External Subroutines ..
41  EXTERNAL dgerv2d, dgesd2d
42 * ..
43 * .. Intrinsic Functions ..
44  INTRINSIC max, min, mod
45 *
46 * if A is a row block, it needs to communicate columnwise.
47 *
48  IF( lsame( adist, 'R' ) ) THEN
49  kppos = mod( nprow+myrow-mcrow, nprow )
50  IF( mod( kppos, igd ).EQ.0 ) THEN
51  kint = igd
52  nlen = n
53  nnum = min( nprow/igd, mnb-mccol )
54  temp = real( nnum )
55  ntlen = n * nnum
56  nnum = igd * nnum
57  IF( kppos.GE.nnum ) GO TO 30
58  kppos = mod( kppos, nprow )
59 *
60  10 CONTINUE
61  IF( temp.GT.one ) THEN
62  kint2 = 2 * kint
63  kmod = mod( kppos, kint2 )
64 *
65  IF( kmod.EQ.0 ) THEN
66  IF( kppos+kint.LT.nnum ) THEN
67  klen = ntlen - (kppos/kint2)*(kint2/igd)*n
68  klen = min( klen-nlen, nlen )
69  CALL dgerv2d( icontxt, m, klen, a(1,nlen+1), lda,
70  \$ mod(myrow+kint, nprow), mycol )
71  nlen = nlen + klen
72  END IF
73  ELSE
74  CALL dgesd2d( icontxt, m, nlen, a, lda,
75  \$ mod(nprow+myrow-kint, nprow), mycol )
76  GO TO 30
77  END IF
78 *
79  kint = kint2
80  temp = temp / two
81  GO TO 10
82  END IF
83  END IF
84 *
85 * if A is a column block, it needs to communicate rowwise.
86 *
87  ELSE IF( lsame( adist, 'C' ) ) THEN
88 *
89  kppos = mod( npcol+mycol-mccol, npcol )
90  IF( mod( kppos, igd ).EQ.0 ) THEN
91  kint = igd
92  nlen = n
93  nnum = min( npcol/igd, mnb-mcrow )
94  temp = real( nnum )
95  ntlen = n * nnum
96  nnum = igd * nnum
97  IF( kppos.GE.nnum ) GO TO 30
98  kppos = mod( kppos, npcol )
99 *
100  20 CONTINUE
101  IF( temp.GT.one ) THEN
102  kint2 = 2 * kint
103  kmod = mod( kppos, kint2 )
104 *
105  IF( kmod.EQ.0 ) THEN
106  IF( kppos+kint.LT.nnum ) THEN
107  klen = ntlen - (kppos/kint2)*(kint2/igd)*n
108  klen = min( klen-nlen, nlen )
109  CALL dgerv2d( icontxt, m, klen, a(1,nlen+1), lda,
110  \$ myrow, mod(mycol+kint, npcol) )
111  nlen = nlen + klen
112  END IF
113  ELSE
114  CALL dgesd2d( icontxt, m, nlen, a, lda, myrow,
115  \$ mod(npcol+mycol-kint, npcol) )
116  GO TO 30
117  END IF
118 *
119  kint = kint2
120  temp = temp / two
121  GO TO 20
122  END IF
123  END IF
124  END IF
125 *
126  30 CONTINUE
127 *
128  RETURN
129 *
130 * End of PBDTRGET
131 *
132  END
pbdtrget
subroutine pbdtrget(ICONTXT, ADIST, M, N, MNB, A, LDA, MCROW, MCCOL, IGD, MYROW, MYCOL, NPROW, NPCOL)
Definition: pbdtrget.f:3
max
#define max(A, B)
Definition: pcgemr.c:180
min
#define min(A, B)
Definition: pcgemr.c:181