12 real(8),
pointer:: a(:)
16 procedure,
private:: update4
17 procedure,
private:: update8
18 generic:: update => update4, update8
26 SUBROUTINE init (self, n)
30 integer(kind=MPI_ADDRESS_KIND):: nbytes
33 call trace%begin(
'mpi_global_t%init8')
35 if (self%window==0)
then 43 call mpi_win_create (self%a, nbytes, 8, mpi_info_null, mpi_comm_world, &
45 call mpi%assert (
'MPI_Win_create', mpi_err)
55 FUNCTION update4 (self, a)
RESULT (b)
57 real:: a(self%n), b(self%n)
59 b= update8(self,
real(a,kind=8))
62 FUNCTION update8 (self, a)
RESULT (b)
64 real(8):: a(self%n), b(self%n)
70 self%a(i) = self%a(i) + a(i)
74 if (mpi%size == 1)
then 77 self%a(i) = self%a(i) + a(i)
81 b = update8_real(self, a)
86 FUNCTION update8_real (self, a)
RESULT (b)
88 real(8):: a(self%n), b(self%n)
90 integer:: master=0, mpi_err
91 integer(kind=MPI_ADDRESS_KIND):: offset=0
93 call trace%begin(
'mpi_global_t%init')
95 call mpi_win_lock (mpi_lock_exclusive, master, 0, self%window, mpi_err)
96 call mpi_get_accumulate (a, self%n, mpi_real8, &
97 self%a, self%n, mpi_real8, master, offset, &
98 self%n, mpi_real8, mpi_sum, self%window, mpi_err)
99 call mpi%assert (
'MPI_Accumulate', mpi_err)
100 call mpi_win_flush (master, self%window, mpi_err)
101 if (mpi%rank == master)
then 106 call mpi_win_unlock (master, self%window, mpi_err)
109 END FUNCTION update8_real
Simple MPI global array data type.