ScaLAPACK 2.1  2.1 ScaLAPACK: Scalable Linear Algebra PACKage
pctreecomb.f
Go to the documentation of this file.
1  SUBROUTINE pctreecomb( ICTXT, SCOPE, N, MINE, RDEST0, CDEST0,
2  \$ SUBPTR )
3 *
4 * -- ScaLAPACK tools routine (version 1.7) --
5 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
6 * and University of California, Berkeley.
7 * May 1, 1997
8 *
9 * .. Scalar Arguments ..
10  CHARACTER SCOPE
11  INTEGER CDEST0, ICTXT, N, RDEST0
12 * ..
13 * .. Array Arguments ..
14  COMPLEX MINE( * )
15 * ..
16 * .. Subroutine Arguments ..
17  EXTERNAL subptr
18 * ..
19 *
20 * Purpose
21 * =======
22 *
23 * PCTREECOMB does a 1-tree parallel combine operation on scalars,
24 * using the subroutine indicated by SUBPTR to perform the required
25 * computation.
26 *
27 * Arguments
28 * =========
29 *
30 * ICTXT (global input) INTEGER
31 * The BLACS context handle, indicating the global context of
32 * the operation. The context itself is global.
33 *
34 * SCOPE (global input) CHARACTER
35 * The scope of the operation: 'Rowwise', 'Columnwise', or
36 * 'All'.
37 *
38 * N (global input) INTEGER
39 * The number of elements in MINE. N = 1 for the norm-2
40 * computation and 2 for the sum of square.
41 *
42 * MINE (local input/global output) COMPLEX array of
43 * dimension at least equal to N. The local data to use in the
44 * combine.
45 *
46 * RDEST0 (global input) INTEGER
47 * The process row to receive the answer. If RDEST0 = -1,
48 * every process in the scope gets the answer.
49 *
50 * CDEST0 (global input) INTEGER
51 * The process column to receive the answer. If CDEST0 = -1,
52 * every process in the scope gets the answer.
53 *
54 * SUBPTR (local input) Pointer to the subroutine to call to perform
55 * the required combine.
56 *
57 * =====================================================================
58 *
59 * .. Local Scalars ..
60  LOGICAL BCAST, RSCOPE, CSCOPE
61  INTEGER CMSSG, DEST, DIST, HISDIST, I, IAM, MYCOL,
62  \$ myrow, mydist, mydist2, np, npcol, nprow,
63  \$ rmssg, tcdest, trdest
64 * ..
65 * .. Local Arrays ..
66  COMPLEX HIS( 2 )
67 * ..
68 * .. External Subroutines ..
69  EXTERNAL blacs_gridinfo, cgebr2d, cgebs2d,
70  \$ cgerv2d, cgesd2d
71 * ..
72 * .. External Functions ..
73  LOGICAL LSAME
74  EXTERNAL lsame
75 * ..
76 * .. Intrinsic Functions ..
77  INTRINSIC mod
78 * ..
79 * .. Executable Statements ..
80 *
81  dest = 0
82 *
84 *
85  bcast = ( ( rdest0.EQ.-1 ).OR.( cdest0.EQ.-1 ) )
86  IF( bcast ) THEN
87  trdest = 0
88  tcdest = 0
89  ELSE
90  trdest = rdest0
91  tcdest = cdest0
92  END IF
93 *
94 * Get grid parameters.
95 *
96  CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
97 *
98 * Figure scope-dependant variables, or report illegal scope
99 *
100  rscope = lsame( scope, 'R' )
101  cscope = lsame( scope, 'C' )
102 *
103  IF( rscope ) THEN
104  IF( bcast ) THEN
105  trdest = myrow
106  ELSE IF( myrow.NE.trdest ) THEN
107  RETURN
108  END IF
109  np = npcol
110  mydist = mod( npcol + mycol - tcdest, npcol )
111  ELSE IF( cscope ) THEN
112  IF( bcast ) THEN
113  tcdest = mycol
114  ELSE IF( mycol.NE.tcdest ) THEN
115  RETURN
116  END IF
117  np = nprow
118  mydist = mod( nprow + myrow - trdest, nprow )
119  ELSE IF( lsame( scope, 'A' ) ) THEN
120  np = nprow * npcol
121  iam = myrow*npcol + mycol
122  dest = trdest*npcol + tcdest
123  mydist = mod( np + iam - dest, np )
124  ELSE
125  RETURN
126  END IF
127 *
128  IF( np.LT.2 )
129  \$ RETURN
130 *
131  mydist2 = mydist
132  rmssg = myrow
133  cmssg = mycol
134  i = 1
135 *
136  10 CONTINUE
137 *
138  IF( mod( mydist, 2 ).NE.0 ) THEN
139 *
140 * If I am process that sends information
141 *
142  dist = i * ( mydist - mod( mydist, 2 ) )
143 *
144 * Figure coordinates of dest of message
145 *
146  IF( rscope ) THEN
147  cmssg = mod( tcdest + dist, np )
148  ELSE IF( cscope ) THEN
149  rmssg = mod( trdest + dist, np )
150  ELSE
151  cmssg = mod( dest + dist, np )
152  rmssg = cmssg / npcol
153  cmssg = mod( cmssg, npcol )
154  END IF
155 *
156  CALL cgesd2d( ictxt, n, 1, mine, n, rmssg, cmssg )
157 *
158  GO TO 20
159 *
160  ELSE
161 *
162 * If I am a process receiving information, figure coordinates
163 * of source of message
164 *
165  dist = mydist2 + i
166  IF( rscope ) THEN
167  cmssg = mod( tcdest + dist, np )
168  hisdist = mod( np + cmssg - tcdest, np )
169  ELSE IF( cscope ) THEN
170  rmssg = mod( trdest + dist, np )
171  hisdist = mod( np + rmssg - trdest, np )
172  ELSE
173  cmssg = mod( dest + dist, np )
174  rmssg = cmssg / npcol
175  cmssg = mod( cmssg, npcol )
176  hisdist = mod( np + rmssg*npcol+cmssg - dest, np )
177  END IF
178 *
179  IF( mydist2.LT.hisdist ) THEN
180 *
181 * If I have anyone sending to me
182 *
183  CALL cgerv2d( ictxt, n, 1, his, n, rmssg, cmssg )
184  CALL subptr( mine, his )
185 *
186  END IF
187  mydist = mydist / 2
188 *
189  END IF
190  i = i * 2
191 *
192  IF( i.LT.np )
193  \$ GO TO 10
194 *
195  20 CONTINUE
196 *
197  IF( bcast ) THEN
198  IF( mydist2.EQ.0 ) THEN
199  CALL cgebs2d( ictxt, scope, ' ', n, 1, mine, n )
200  ELSE
201  CALL cgebr2d( ictxt, scope, ' ', n, 1, mine, n,
202  \$ trdest, tcdest )
203  END IF
204  END IF
205 *
206  RETURN
207 *
208 * End of PCTREECOMB
209 *
210  END
211 *
212  SUBROUTINE ccombamax( V1, V2 )
213 *
214 * -- ScaLAPACK tools routine (version 1.7) --
215 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
216 * and University of California, Berkeley.
217 * May 1, 1997
218 *
219 * .. Array Arguments ..
220  COMPLEX V1( 2 ), V2( 2 )
221 * ..
222 *
223 * Purpose
224 * =======
225 *
226 * CCOMBAMAX finds the element having max. absolute value as well
227 * as its corresponding globl index.
228 *
229 * Arguments
230 * =========
231 *
232 * V1 (local input/local output) COMPLEX array of
233 * dimension 2. The first maximum absolute value element and
234 * its global index. V1(1) = AMAX, V1(2) = INDX.
235 *
236 * V2 (local input) COMPLEX array of dimension 2.
237 * The second maximum absolute value element and its global
238 * index. V2(1) = AMAX, V2(2) = INDX.
239 *
240 * =====================================================================
241 *
242 * .. Intrinsic Functions ..
243  INTRINSIC abs, real, aimag
244 * ..
245 * .. Statement Functions ..
246  COMPLEX ZDUM
247  REAL CABS1
248  cabs1(zdum) = abs(real(zdum)) + abs(aimag(zdum))
249 * ..
250 * .. Executable Statements ..
251 *
252  IF( cabs1( v1( 1 ) ).LT.cabs1( v2( 1 ) ) ) THEN
253  v1( 1 ) = v2( 1 )
254  v1( 2 ) = v2( 2 )
255  END IF
256 *
257  RETURN
258 *
259 * End of CCOMBAMAX
260 *
261  END
pctreecomb
subroutine pctreecomb(ICTXT, SCOPE, N, MINE, RDEST0, CDEST0, SUBPTR)
Definition: pctreecomb.f:3
ccombamax
subroutine ccombamax(V1, V2)
Definition: pctreecomb.f:213