MPI Fortran code: how to share data on node via openMP?

Question

I am working on an Fortan code that already uses MPI.

Now, I am facing a situation, where a set of data grows very large but is same for every process, so I would pr

Answer 1

In the spirit of adding Fortran shared memory MPI examples, I'd like to extend ftiaronsem's code to incorporate a loop so that the behavior of MPI_Win_fence and MPI_Barrier is clearer (at least it is for me now, anyway).

Specifically, try running the code with either or both of the MPI_Win_Fence or MPI_Barrier commands in the loop commented out to see the effect. Alternatively, reverse their order.

Removing the MPI_Win_Fence allows the write statement to display memory that has not been updated yet.

Removing the MPI_Barrier allows other processes to run the next iteration and change memory before a process has the chance to write.

The previous answers really helped me implement the shared memory paradigm in my MPI code. Thanks.

program sharedmemtest
  USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_F_POINTER
  use mpi
  implicit none
  integer, parameter :: dp = selected_real_kind(14,200)
  integer :: win,win2,hostcomm,hostrank
  INTEGER(KIND=MPI_ADDRESS_KIND) :: windowsize
  INTEGER :: disp_unit,my_rank,ierr,total, i
  TYPE(C_PTR) :: baseptr,baseptr2
  real(dp), POINTER :: matrix_elementsy(:,:,:,:)
  integer,allocatable :: arrayshape(:)

  call MPI_INIT( ierr )

  call MPI_COMM_RANK(MPI_COMM_WORLD,my_rank, ierr)  !GET THE RANK OF ONE PROCESS
  call MPI_COMM_SIZE(MPI_COMM_WORLD,total,ierr)  !GET THE TOTAL PROCESSES OF THE COMM
  CALL MPI_Comm_split_type(MPI_COMM_WORLD, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL, hostcomm,ierr)
  CALL MPI_Comm_rank(hostcomm, hostrank,ierr)

  ! Gratefully based on: http://stackoverflow.com/questions/24797298/mpi-fortran-code-how-to-share-data-on-node-via-openmp
  ! and https://gcc.gnu.org/onlinedocs/gfortran/C_005fF_005fPOINTER.html
  ! We only want one process per host to allocate memory
  ! Set size to 0 in all processes but one
  allocate(arrayshape(4))
  arrayshape=(/ 10,10,10,10 /)
  if (hostrank == 0) then
     windowsize = int(10**4,MPI_ADDRESS_KIND)*8_MPI_ADDRESS_KIND !*8 for double ! Put the actual data size here
  else
     windowsize = 0_MPI_ADDRESS_KIND
  end if
  disp_unit = 1
  CALL MPI_Win_allocate_shared(windowsize, disp_unit, MPI_INFO_NULL, hostcomm, baseptr, win, ierr)

  ! Obtain the location of the memory segment
  if (hostrank /= 0) then
     CALL MPI_Win_shared_query(win, 0, windowsize, disp_unit, baseptr, ierr)
  end if

  ! baseptr can now be associated with a Fortran pointer
  ! and thus used to access the shared data
  CALL C_F_POINTER(baseptr, matrix_elementsy,arrayshape)

  !!! your code here!
  !!! sample below
  if (hostrank == 0) then
     matrix_elementsy=0.0_dp
  endif
  call MPI_WIN_FENCE(0, win, ierr)
  do i=1, 15
     if (hostrank == 0) then
        matrix_elementsy(1,2,3,4)=i * 1.0_dp
        matrix_elementsy(1,2,2,4)=i * 2.0_dp
     elseif ((hostrank > 5) .and. (hostrank < 11)) then  ! code for non-root nodes to do something different
        matrix_elementsy(1,2,hostrank, 4) = hostrank * 1.0 * i
     endif
     call MPI_WIN_FENCE(0, win, ierr)
     write(*,'(A, I4, I4, 10F7.1)') "my_rank=",my_rank, i, matrix_elementsy(1,2,:,4)
     call MPI_BARRIER(MPI_COMM_WORLD, ierr)
  enddo
  !!! end sample code

  call MPI_WIN_FENCE(0, win, ierr)
  call MPI_BARRIER(MPI_COMM_WORLD,ierr)
  call MPI_Win_free(win,ierr)
  call MPI_FINALIZE(IERR)

  end program