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
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
|
c
c $Id: frsg.f,v 1.3 1999/03/15 19:04:45 pvmsrc Exp $
c
c*----------------------------------------------------------------------
c* Example of group Reduce, Scatter, and Gather functions - J.M. Donato
c*
c* This example calculates the sum of squares of the first N integers
c* in three different ways where
c*
c* N = (number of processors)*(number of elements per row)
c*
c* Note: This is obviously not an efficient way to compute the
c* sum of squares, but it is a cutesy example and test case.
c*----------------------------------------------------------------------
program main
implicit none
include '../include/fpvm3.h'
external PvmMin
external PvmMax
external PvmSum
external PvmProduct
external MaxWithLoc
integer MAXNDATA, MAXNPROCS, DFLTNDATA, DFLTNPROCS
character*10 GROUP, TASK_NAME
parameter (MAXNDATA = 20, MAXNPROCS = 16,
& DFLTNDATA = 5, DFLTNPROCS = 4,
& GROUP = 'grp_frsg', TASK_NAME = 'frsg')
integer myginst, i, j, gsize, count, nprocs, msgtag, datatype,
& buffer, info, info_product, info_user,
& tids(MAXNPROCS), myrow(MAXNDATA), matrix(MAXNDATA*MAXNPROCS),
& midpoint, bigN, Sum1, Sum2, SumSquares, rootginst,
& PSum, PartSums(MAXNPROCS), dupls(MAXNDATA)
double precision values(2)
data Sum1/0/, Sum2/0/
c* join the group
call PvmfJoinGroup(GROUP, myginst)
c* I am the first group member, get input, start up copies of myself
if ( myginst.eq.0 ) then
call PvmfMyTid(tids(1))
call PvmfParent(i)
if (i .eq. PvmNoParent) then
print *, '/ * Example: PVM Reduce, Scatter, and Gather * ',
& '/ Number of processors to use (1-', MAXNPROCS,')? : '
read *, nprocs
if (nprocs.gt.MAXNPROCS) nprocs = MAXNPROCS
print *, ' Number of elements per row to use (1-',
& MAXNDATA, ')? : '
read *, count
if (count.gt.MAXNDATA) count = MAXNDATA
else
nprocs = DFLTNPROCS
count = DFLTNDATA
endif
print *, ' INPUT values: nprocs = ', nprocs, ', count = ', count
if ( nprocs.gt.1 ) then
call PvmfSpawn(TASK_NAME, PvmDefault, '*',
& nprocs-1, tids(2), info)
c* wait until they have all started, then send input values
call PvmfGsize(GROUP, gsize)
9000 continue
if ( gsize.lt.nprocs) then
call PvmfSleep(1)
call PvmfGsize(GROUP, gsize)
go to 9000
end if
call PvmfInitsend(PvmDataDefault, buffer)
call PvmfPack(INTEGER4, nprocs, 1, 1, info)
call PvmfPack(INTEGER4, count, 1, 1, info)
msgtag = 17
call PvmfBcast(GROUP, msgtag, info)
end if
else
c* receive the input values if child node
msgtag = 17
call PvmfRecv(-1, msgtag, info)
call PvmfUnpack(INTEGER4, nprocs, 1, 1, info)
call PvmfUnpack(INTEGER4, count, 1, 1, info)
end if
c* determine the group root
rootginst = 0
c* init the matrix values on the root processor
if ( myginst.eq.rootginst ) then
do j=1, nprocs
do i=1, count
matrix((j-1)*count + i) = (j-1)*count + i
end do
end do
end if
c* scatter rows of matrix to each processor
msgtag = 19
call PvmfScatter(myrow, matrix, count, INTEGER4, msgtag,
& GROUP, rootginst, info)
c* this should end up squaring each value on each processor
do i=1, count
dupls(i) = myginst*count + i
end do
datatype = INTEGER4
call PvmProduct(datatype, myrow, dupls, count, info_product)
if ((myginst.eq.rootginst).and.(info_product.lt.0))
& print *, ' ERROR: ', info_product, ' on PvmProduct call '
c* do partial sum on each proc
do i=1, count
PSum = PSum + myrow(i)
end do
c* gather partial sums to the rootginst
msgtag = 21
call PvmfGather(PartSums, PSum, 1, INTEGER4, msgtag,
& GROUP, rootginst, info)
c* do a global sum over myrow, the result goes to rootginst
msgtag = 23
call PvmfReduce(PvmSum, myrow, count, INTEGER4, msgtag,
& GROUP, rootginst, info)
c* init values and include location information on each processor
midpoint = nprocs/2
values(1) = -(myginst - midpoint)*(myginst-midpoint) + count
values(2) = myginst
c* use a user-defined function in reduce, send answer to rootginst
msgtag = 25
call PvmfReduce(MaxWithLoc, values, 2, REAL8,
& msgtag, GROUP, rootginst, info_user)
bigN = nprocs*count
if (myginst.eq.rootginst) then
c* Complete the Sum of Squares using different methods
do i=1, nprocs
Sum1 = Sum1 + PartSums(i)
end do
do i=1, count
Sum2 = Sum2 + myrow(i)
end do
SumSquares = bigN*(bigN+1)*(2*bigN+1)/6
if ( (Sum1.eq.SumSquares) .and. (Sum2.eq.SumSquares)) then
print *, '/ Test OK: Sum of Squares of first ', bigN,
& ' integers is ', Sum1
else
print *, '/ ERROR: The Sum of Squares of the first ', bigN,
& ' integers / was calculated by Sum1 as ', Sum1,
& ' and by Sum2 as ', Sum2,
& ' for both it should have been ', SumSquares
end if
if (info_user.lt.0)
& print *, ' ERROR: ', info_user, ' on User Reduce Function'
if ((values(1).ne.count) .or. (values(2).ne.midpoint)) then
print *, ' ERROR: Should have (', count, ', ', midpoint,
& '), but have (', values(1), ',', values(2)
else
print *, ' Test Ok: Received (', values(1), ',',
& values(2), ') '
end if
end if
c* sync up again, leave group, exit pvm
call PvmfBarrier(GROUP, nprocs, info)
call PvmfLvgroup(GROUP, info)
call PvmfExit(info)
stop
end
c*
c* This function returns the elementwise maximum of two vectors
c* along with location information.
c*
c* The first num/2 values of x and y are the data values to compare.
c* The second num/2 values of x and y are location information
c* which is kept with the maximum value determined.
c*
c* In the case of a tie in data values, the smaller location
c* is kept to insure the associativity of the operation.
c*
subroutine MaxWithLoc(datatype, x, y, num, info)
implicit none
integer datatype, num, info
double precision x(*), y(*)
include '../include/fpvm3.h'
integer i, count
count = num/2
if (datatype.ne.REAL8) then
info = PvmBadParam
return
end if
do i=1, count
if (y(i).gt.x(i)) then
x(i) = y(i)
x(i+count) = y(i+count)
elseif (y(i).eq.x(i)) then
x(i+count) = min(x(i+count), y(i+count))
end if
end do
info = PvmOk
return
end
|
