13
c**** You can change dimension of the array and duration of the test here
14
parameter (dim=500, minutes =90)
25
status = ma_init(MT_DBL, stack, heap)
26
if (.not. status) call ga_error( 'ma_init failed',stack+heap)
30
print *, 'Testing random gets and puts'
31
print *, ' array: ',dim,' x ',dim
32
print *, ' using ',proc, ' process(es)'
33
print *, ' test should run for ',minutes,' minutes'
37
call check_dbl(dim, minutes)
40
print *, 'Test completed succesfuly'
43
if(ga_nodeid().eq.0)call ga_print_stats()
49
subroutine check_dbl(dim, minutes)
51
#include "mafdecls.fh"
53
#include "testutil.fh"
58
double precision a(n,n)
59
double precision t0, elapsed
62
integer iran, i,j, loop, maxloop, ilo, ihi, jlo, jhi, range
66
c**** maxloop determines number of puts/gest done before checking the clock
68
parameter (maxloop = 100000)
70
iran(i) = int(drand(0)*real(i-1)) + 1
74
crap = drand(real(me)) !different seed for each process
75
if(n .gt. dim) call ga_error('insufficient dimension',dim)
77
status = ga_create(MT_DBL, dim, dim, 'a', 0, 0, g_a)
78
if (.not. status) then
79
write(6,*) ' ga_create failed'
81
call ga_error('... exiting ',0)
84
c initialize array in place
85
call ga_distribution(g_a,me,ilo, ihi, jlo, jhi)
86
call ga_access(g_a, ilo,ihi,jlo,jhi, index, ld)
87
* print *, 'DBL_MB=', DBL_MB(1), index
88
call fill_local(DBL_MB(index), ihi-ilo+1, jhi-jlo+1, ilo, jlo, ld)
95
21 format(/'> Start ... ')
104
c always get 100x100 patches
110
call ga_get(g_a, ilo, ihi, jlo, jhi, a, n)
113
call check_data(a,n,n, ilo, jlo, n)
116
call ga_put(g_a, ilo, ihi, jlo, jhi, a, n)
118
print *, me, 'OK', ilo, ihi, jlo, jhi
122
elapsed = util_timer() -t0
125
print *, int(100* elapsed/(minutes*60)),'% done'
129
if(elapsed .lt. real(minutes * 60)) goto 100
135
write(6,*) ' everything looks OK'
140
status = ga_destroy(g_a)
144
subroutine fill_local(a, n,m, x, y , ld)
147
double precision a(ld,*)
152
a(i,j)= real(x+y+i+j-2)
157
subroutine check_data(a,n,m, x,y, ld)
161
double precision a(ld,*)
166
if(a(i,j) .ne. real(x+y+i+j-2))then
167
print *, 'error:',i+x-1, j+y-1, a(i,j)
168
call ga_error("failed",1)