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

With this answer I want to add a complete running code example (for ifort 15 and mvapich 2.1). The MPI shared memory concept is still pretty new and in particular for Fortran there aren't many code examples out there. It is based on the answer from Hristo and a very useful email on the mvapich mailing list (http://mailman.cse.ohio-state.edu/pipermail/mvapich-discuss/2014-June/005003.html).

The code example is based on the problems I ran into and adds to Hristo's answer in the following ways:

• uses mpi instead of mpi_f08 (some libraries do not provide a full fortran 2008 interface yet)
• Has ierr added to the respective MPI calls
• Explicit calculation of the windowsize elements*elementsize
• How to use C_F_POINTER to map the shared memory to a multi dimensional array
• Reminds to use MPI_WIN_FENCE after modifying the shared memory
• Intel mpi (5.0.1.035) needs an additional MPI_BARRIER after the MPI_FENCE since it only guarantees that between "between two MPI_Win_fence calls, all RMA operations are completed." (https://software.intel.com/en-us/blogs/2014/08/06/one-sided-communication)

Kudos go to Hristo and Michael Rachner.

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
  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
     matrix_elementsy(1,2,3,4)=1.0_dp
  end if
  CALL MPI_WIN_FENCE(0, win, ierr)

  print *,"my_rank=",my_rank,matrix_elementsy(1,2,3,4),matrix_elementsy(1,2,3,5)

  !!! 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