      program test

      use, intrinsic :: iso_fortran_env
      use, intrinsic :: iso_c_binding

      implicit none
      include 'mpif.h'
      character(8) :: arg
      real(real64), pointer, contiguous :: vec(:)
      real(real64) :: rdum
      integer      :: Mrank,Msize,Nrank,Nsize,Mcomm,Ncomm,Msplit,Merr
      integer      :: i,win_vec,disp,n,j
      integer(kind=mpi_address_kind) :: size
      type(c_ptr)  :: ptr

      nullify(vec)

      call mpi_init(Merr)
      call mpi_comm_size(mpi_comm_world,Msize,Merr)
      call mpi_comm_rank(mpi_comm_world,Mrank,Merr)
      Mcomm = mpi_comm_world

      call mpi_comm_split_type(Mcomm,mpi_comm_type_shared,0,
     &  mpi_info_null,Ncomm,Merr)
      call mpi_comm_size(Ncomm,Nsize,Merr)
      call mpi_comm_rank(Ncomm,Nrank,Merr)

      if(Nrank==0) then ; size = 10_mpi_address_kind
      else              ; size = 0_mpi_address_kind
      endif
      disp = 1
      call mpi_win_allocate_shared(size,disp,mpi_info_null,Ncomm,ptr,
     &  win_vec,Merr)
      if(Nrank/=0) call mpi_win_shared_query(win_vec,0,size,disp,ptr,
     &  Merr)
      
      call c_f_pointer(ptr,vec,(/10/))

      call donothing(vec)
      call mpi_win_fence(0,win_vec,Merr)
      call donothing(vec)

      if(Mrank==0) then
        call getarg(1,arg)
        read(arg,*) n
      endif
      call mpi_bcast(n,1,mpi_integer,0,mpi_comm_world,Merr)

      if(Nrank==0) vec = 0

      call donothing(vec)
      call mpi_win_fence(0,win_vec,Merr)
      call donothing(vec)

      do j = 1,n
        do i = 1,10
          rdum = i*1d0
c          vec(i) = vec(i) + rdum ! yields correct result with 1 process
          call mpi_accumulate(rdum,1,MPI_DOUBLE_PRECISION,0,
     &      (i-1)*8_MPI_ADDRESS_KIND,1,MPI_DOUBLE_PRECISION,
     &      MPI_SUM,win_vec,Merr)
        enddo
      enddo

      call donothing(vec)
      call mpi_win_fence(0,win_vec,Merr)
      call donothing(vec)

      if(Mrank==0) write(*,*) vec

      call donothing(vec)
      call mpi_win_fence(0,win_vec,Merr)
      call donothing(vec)

      nullify(vec)
      call mpi_win_free(win_vec,Merr)
      call mpi_comm_free(Ncomm,Merr)
      call mpi_finalize(Merr)

      end

