1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
|
SUBROUTINE PITREECOMB( ICTXT, SCOPE, N, MINE, RDEST0, CDEST0,
$ SUBPTR )
*
* -- ScaLAPACK tools routine (version 1.7) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* May 1, 1997
*
* .. Scalar Arguments ..
CHARACTER SCOPE
INTEGER CDEST0, ICTXT, N, RDEST0
* ..
* .. Array Arguments ..
INTEGER MINE( * )
* ..
* .. Subroutine Arguments ..
EXTERNAL SUBPTR
* ..
*
* Purpose
* =======
*
* PITREECOMB does a 1-tree parallel combine operation on scalars,
* using the subroutine indicated by SUBPTR to perform the required
* computation.
*
* Arguments
* =========
*
* ICTXT (global input) INTEGER
* The BLACS context handle, indicating the global context of
* the operation. The context itself is global.
*
* SCOPE (global input) CHARACTER
* The scope of the operation: 'Rowwise', 'Columnwise', or
* 'All'.
*
* N (global input) INTEGER
* The number of elements in MINE. N = 1 for the norm-2
* computation and 2 for the sum of square.
*
* MINE (local input/global output) @(typec) array of
* dimension at least equal to N. The local data to use in the
* combine.
*
* RDEST0 (global input) INTEGER
* The process row to receive the answer. If RDEST0 = -1,
* every process in the scope gets the answer.
*
* CDEST0 (global input) INTEGER
* The process column to receive the answer. If CDEST0 = -1,
* every process in the scope gets the answer.
*
* SUBPTR (local input) Pointer to the subroutine to call to perform
* the required combine.
*
* =====================================================================
*
* .. Local Scalars ..
LOGICAL BCAST, RSCOPE, CSCOPE
INTEGER CMSSG, DEST, DIST, HISDIST, I, IAM, MYCOL,
$ MYROW, MYDIST, MYDIST2, NP, NPCOL, NPROW,
$ RMSSG, TCDEST, TRDEST
* ..
* .. Local Arrays ..
INTEGER HIS( 2 )
* ..
* .. External Subroutines ..
EXTERNAL BLACS_GRIDINFO, IGEBR2D, IGEBS2D,
$ IGERV2D, IGESD2D
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
* ..
* .. Intrinsic Functions ..
INTRINSIC MOD
* ..
* .. Executable Statements ..
*
* See if everyone wants the answer (need to broadcast the answer)
*
BCAST = ( ( RDEST0.EQ.-1 ).OR.( CDEST0.EQ.-1 ) )
IF( BCAST ) THEN
TRDEST = 0
TCDEST = 0
ELSE
TRDEST = RDEST0
TCDEST = CDEST0
END IF
*
* Get grid parameters.
*
CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
*
* Figure scope-dependant variables, or report illegal scope
*
RSCOPE = LSAME( SCOPE, 'R' )
CSCOPE = LSAME( SCOPE, 'C' )
*
IF( RSCOPE ) THEN
IF( BCAST ) THEN
TRDEST = MYROW
ELSE IF( MYROW.NE.TRDEST ) THEN
RETURN
END IF
NP = NPCOL
MYDIST = MOD( NPCOL + MYCOL - TCDEST, NPCOL )
ELSE IF( CSCOPE ) THEN
IF( BCAST ) THEN
TCDEST = MYCOL
ELSE IF( MYCOL.NE.TCDEST ) THEN
RETURN
END IF
NP = NPROW
MYDIST = MOD( NPROW + MYROW - TRDEST, NPROW )
ELSE IF( LSAME( SCOPE, 'A' ) ) THEN
NP = NPROW * NPCOL
IAM = MYROW*NPCOL + MYCOL
DEST = TRDEST*NPCOL + TCDEST
MYDIST = MOD( NP + IAM - DEST, NP )
ELSE
RETURN
END IF
*
IF( NP.LT.2 )
$ RETURN
*
MYDIST2 = MYDIST
RMSSG = MYROW
CMSSG = MYCOL
I = 1
*
10 CONTINUE
*
IF( MOD( MYDIST, 2 ).NE.0 ) THEN
*
* If I am process that sends information
*
DIST = I * ( MYDIST - MOD( MYDIST, 2 ) )
*
* Figure coordinates of dest of message
*
IF( RSCOPE ) THEN
CMSSG = MOD( TCDEST + DIST, NP )
ELSE IF( CSCOPE ) THEN
RMSSG = MOD( TRDEST + DIST, NP )
ELSE
CMSSG = MOD( DEST + DIST, NP )
RMSSG = CMSSG / NPCOL
CMSSG = MOD( CMSSG, NPCOL )
END IF
*
CALL IGESD2D( ICTXT, N, 1, MINE, N, RMSSG, CMSSG )
*
GO TO 20
*
ELSE
*
* If I am a process receiving information, figure coordinates
* of source of message
*
DIST = MYDIST2 + I
IF( RSCOPE ) THEN
CMSSG = MOD( TCDEST + DIST, NP )
HISDIST = MOD( NP + CMSSG - TCDEST, NP )
ELSE IF( CSCOPE ) THEN
RMSSG = MOD( TRDEST + DIST, NP )
HISDIST = MOD( NP + RMSSG - TRDEST, NP )
ELSE
CMSSG = MOD( DEST + DIST, NP )
RMSSG = CMSSG / NPCOL
CMSSG = MOD( CMSSG, NPCOL )
HISDIST = MOD( NP + RMSSG*NPCOL+CMSSG - DEST, NP )
END IF
*
IF( MYDIST2.LT.HISDIST ) THEN
*
* If I have anyone sending to me
*
CALL IGERV2D( ICTXT, N, 1, HIS, N, RMSSG, CMSSG )
CALL SUBPTR( MINE, HIS )
*
END IF
MYDIST = MYDIST / 2
*
END IF
I = I * 2
*
IF( I.LT.NP )
$ GO TO 10
*
20 CONTINUE
*
IF( BCAST ) THEN
IF( MYDIST2.EQ.0 ) THEN
CALL IGEBS2D( ICTXT, SCOPE, ' ', N, 1, MINE, N )
ELSE
CALL IGEBR2D( ICTXT, SCOPE, ' ', N, 1, MINE, N,
$ TRDEST, TCDEST )
END IF
END IF
*
RETURN
*
* End of PITREECOMB
*
END
|
