1
subroutine m4_func_NGA_PUT(m4_test_type, m4_ndim)
9
parameter (m = (m4_n**m4_ndim)/100)
10
parameter (ndim = m4_ndim)
11
m4_data_type a(substr(m4_array, 1, eval(m4_ndim*2-1)))
12
m4_data_type b(substr(m4_array, 1, eval(m4_ndim*2-1)))
13
integer lo(ndim),hi(ndim),dims(ndim),ld(ndim)
16
integer i, total, loop
17
integer lop(ndim),hip(ndim)
18
integer elems, count_elems
26
c---------------------- initialize the GA -----------------------
27
c initialize the chunk, dims, ld, and calculate the number
34
total = total * dims(i)
37
c*** Create global arrays
38
if (.not. nga_create(m4_MT, ndim, dims, 'a', chunk, g_a))
39
$ call ga_error(' ga_create failed ',1)
43
c------------------------------- NGA_PUT ----------------------------
44
m4_print_info(nga_put)
46
proc = nproc-1 -me ! access other process memory
47
call nga_distribution(g_a, proc, lo,hi)
48
elems = count_elems(lo,hi,ndim)
49
call m4_util_init_array(m4_test_type)(a,total)
53
call nga_put(g_a,lo,hi,
54
$ a(substr(m4_lo_all, 1, eval(m4_ndim*6-1))),ld)
56
call random_range(lo,hi,lop,hip,ndim)
57
if(me.eq.0 .and. Mod(loop,10).eq.0)then
58
call print_range(loop,lop,hip,ndim)
60
call nga_put(g_a,lop,hip,
61
$ a(substr(m4_lop_all, 1, eval(m4_ndim*7-1))),ld)
64
call nga_get(g_a,lo,hi,
65
$ b(substr(m4_lo_all, 1, eval(m4_ndim*6-1))),ld)
67
call m4_util_compare_patches(m4_test_type)(0d0,total,
68
$ a,lo,hi,ndim,dims,total,b,lo,hi,ndim,dims)
70
c so that the random_range can be call the same number of times
71
c in other words, drand can generate the same number for the
72
c collective operations
74
call random_range(lo,hi,lop,hip,ndim)
84
c---------------------------
86
status= ga_destroy(g_a)