4
c $Id: perform.F,v 1.9 2000-05-25 01:09:20 d3h325 Exp $
7
c*** Last modification: Fri Jan 13 12:13:27 PST 1995
10
#include "mafdecls.fh"
14
c*** Intitialize a message passing library
18
c*** Intitialize the GA package
20
if(ga_nnodes().ne.4 .and. ga_nodeid().eq.0)
21
$ call ga_error('Program requires 4 GA processes',ga_nnodes())
23
c*** Initialize the MA package
25
if (.not. ma_init(MT_DBL, heap,heap))
26
$ call ga_error('ma init failed',2*heap)
30
if(ga_nodeid().eq.0) print *, 'All tests successful'
42
#include "mafdecls.fh"
45
integer n, nn, num_chunks
46
parameter (n = 710, nn = n*n/4, num_chunks=12)
47
double precision buf(nn)
50
integer ilo, ihi, jlo, jhi
51
integer nproc, me, loop
52
integer chunk(num_chunks)
53
data chunk /1,3,4,9,16,30,64,91,128,171,256,353/
58
c*** Create global array
59
if (.not. ga_create(MT_DBL, n, n, 'a', 0, 0, g_a))
60
$ call ga_error(' ga_create failed ',1)
69
print *,'> Performance of ga_get, ga_put & ga_acc n = ', n
78
call ga_distribution(g_a, me, ilo, ihi, jlo, jhi)
80
& (g_a, n, chunk, num_chunks, buf, ilo, ihi, jlo, jhi)
84
call ga_distribution(g_a, nproc-1, ilo, ihi, jlo, jhi)
86
& (g_a, n, chunk, num_chunks, buf, ilo, ihi, jlo, jhi)
92
subroutine TestPutGetAcc
93
& (g_a, n, chunk, num_chunks, buf, ilo, ihi, jlo,jhi)
96
#include "testutil.fh"
98
integer num_chunks, chunk(num_chunks)
99
integer n, ilo, ihi, jlo,jhi,g_a
100
double precision buf(*), tg, tp, ta
101
double precision time_acc, time_get, time_put
104
integer loop, jump, count, bytes
109
write(6,'(21X,8hACCESS [,i3,1h:,i4,1h,,i3,1h:,i4,1h])')
111
write(6,*)'bytes loop get put',
117
do loop = 1, num_chunks
118
bytes = util_mdtob(1)*chunk(loop)*chunk(loop) !how much data is accessed
119
jump = n/(60*loop) ! jump distance between consecutive patches
121
c everybody touches own data
122
call ga_fill_patch(g_a, 1, n, 1, n , 1d0*me*loop)
124
tg= time_get(g_a,ilo,ihi,jlo,jhi,buf,chunk(loop),jump,count)
129
c everybody touches own data
130
call ga_fill_patch(g_a, 1, n, 1, n , 1d0*me*loop)
132
tp= time_put(g_a,ilo,ihi,jlo,jhi,buf,chunk(loop),jump,count)
137
c everybody touches own data
138
call ga_fill_patch(g_a, 1, n, 1, n , 1d0*me*loop)
140
ta= time_acc(g_a,ilo,ihi,jlo,jhi,buf,chunk(loop),jump,count)
146
write(6,77)bytes, count, tg, 1d-6*bytes/tg,
147
& tp, 1d-6*bytes/tp, ta, 1d-6*bytes/ta
152
77 format(i6, i5, 3(d10.3, d9.2,'MB/s'))
157
double precision function
158
& time_acc(g_a, is, ie, js, je, buf, chunk, jump, count)
162
#include "testutil.fh"
165
integer g_a, chunk, jump, count, is, js, ie, je
167
integer ilo, ihi, jlo, jhi
168
double precision seconds, buf
171
seconds = util_timer()
173
c distance between consecutive patches increased by jump
174
c to destroy locality of reference
175
do ilo = is, ie -chunk-jump +1, chunk+jump
177
do jlo = js, je -chunk-jump +1, chunk+jump
180
call ga_acc(g_a, ilo, ihi, jlo, jhi, buf, chunk, 1d0)
183
seconds = util_timer() - seconds
185
time_acc = seconds/count
189
double precision function
190
& time_get(g_a, is, ie, js, je, buf, chunk, jump, count)
194
#include "testutil.fh"
196
integer g_a, chunk, jump, count, is, js, ie, je
198
integer ilo, ihi, jlo, jhi
199
double precision seconds, buf
202
seconds = util_timer()
204
c distance between consecutive patches increased by jump
205
c to destroy locality of reference
206
do ilo = is, ie -chunk-jump +1, chunk+jump
208
do jlo = js, je -chunk-jump +1, chunk+jump
211
call ga_get(g_a, ilo, ihi, jlo, jhi, buf, chunk)
214
seconds = util_timer() - seconds
216
time_get = seconds/count
221
double precision function
222
& time_put(g_a, is, ie, js, je, buf, chunk, jump, count)
226
#include "testutil.fh"
228
integer g_a, chunk, jump, count, is, js, ie, je
230
integer ilo, ihi, jlo, jhi
231
double precision seconds, buf
234
seconds = util_timer()
236
c distance between consecutive patches increased by jump
237
c to destroy locality of reference
238
do ilo = is, ie -chunk-jump +1, chunk+jump
240
do jlo = js, je -chunk-jump +1, chunk+jump
243
call ga_put(g_a, ilo, ihi, jlo, jhi, buf, chunk)
246
seconds = util_timer() - seconds
248
time_put = seconds/count