Memory MPI Fortran代码：如何通过openMP在节点上共享数据？

我正在编写一个已经使用MPI的Fortan代码

现在，我面临一种情况，一组数据增长非常大，但每个进程都是相同的，因此我更希望每个节点只在内存中存储一次，并且一个节点上的所有进程都访问相同的数据

为每个进程存储一次将超出可用RAM的范围

是否有可能通过openMP实现类似的功能

---

每个节点的数据共享是我唯一想要的，不需要其他的每个节点并行，因为这已经通过MPI完成。

如果只是为了共享数据块，您不需要实现混合MPI+OpenMP代码。你实际上要做的是：

1） 将world communicator拆分为跨同一主机/节点的组。如果您的MPI库实现了MPI-3.0，那么这真的很容易-您只需调用

MPI\u COMM\u SPLIT\u TYPE

，并将

SPLIT\u TYPE

设置为

MPI\u COMM\u SHARED

：

USE mpi_f08

TYPE(MPI_Comm) :: hostcomm

CALL MPI_Comm_split_type(MPI_COMM_WORLD, MPI_COMM_TYPE_SHARED, 0, &
                         MPI_INFO_NULL, hostcomm)

MPI-2.2或更早版本不提供

MPI\u COMM\u SPLIT\u类型

操作，必须有一定的创造性。例如，您可以使用可以在Github上找到的我的简单按主机拆分实现

2） 既然驻留在同一节点上的进程是同一通信器的一部分，它们就可以创建共享内存块并使用它来交换数据。同样，MPI-3.0提供了一种（相对）简单且可移植的方法：

USE mpi_f08
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_F_POINTER

INTEGER :: hostrank

INTEGER(KIND=MPI_ADDRESS_KIND) :: size
INTEGER :: disp_unit
TYPE(C_PTR) :: baseptr
TYPE(MPI_Win) :: win

TYPE(MY_DATA_TYPE), POINTER :: shared_data

! We only want one process per host to allocate memory
! Set size to 0 in all processes but one
CALL MPI_Comm_rank(hostcomm, hostrank)
if (hostrank == 0) then
   size = 10000000 ! Put the actual data size here
else
   size = 0
end if
disp_unit = 1
CALL MPI_Win_allocate_shared(size, disp_unit, MPI_INFO_NULL, &
                             hostcomm, baseptr, win)

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

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

! Use shared_data as if it was ALLOCATE'd
! ...

! Destroy the shared memory window
CALL MPI_Win_free(win)

代码的工作方式是使用MPI-3.0功能分配共享内存窗口

MPI\u WIN\u ALLOCATE\u SHARED

在每个进程中分配一块共享内存。由于您希望共享一个数据块，因此只有在单个进程中分配数据块才有意义，而不是让数据块分散在各个进程中，因此在进行调用时，除一个列组外，所有列组的

size

都设置为0

MPI\u WIN\u SHARED\u QUERY

用于查找在调用进程的虚拟地址空间中映射该共享内存块的地址。如果地址已知，可以使用

C\u F\u pointer（）

子例程将C指针与Fortran指针关联，后者可用于访问共享内存。完成后，必须通过使用MPI_WIN_FREE销毁共享内存窗口来释放共享内存

---

MPI-2.2或更早版本不提供共享内存窗口。在这种情况下，必须使用依赖操作系统的API来创建共享内存块，例如标准POSIX序列

shm_open（）

/

ftruncate（）

/

mmap（）

。为了执行这些操作，必须编写一个可从Fortran调用的实用程序C函数。看看有没有灵感。通过

mmap（）

返回的

void*

可以直接传递到

C_PTR

类型变量中的Fortran代码，然后该变量可以与Fortran指针关联。

对于这个答案，我想添加一个完整的运行代码示例（对于ifort 15和mvapich 2.1）。MPI共享内存的概念仍然很新，特别是对于Fortran来说，没有太多的代码示例。它基于Hristo的答案和mvapich邮件列表（）上的一封非常有用的电子邮件

代码示例基于我遇到的问题，并通过以下方式添加到Hristo的答案中：

• 使用mpi而不是mpi_f08（某些库尚未提供完整的fortran 2008接口）
• ierr是否已添加到相应的MPI调用中
• WindowsSize元素的显式计算*elementsize
• 如何使用C_F_指针将共享内存映射到多维数组
• 在修改共享内存后提醒使用MPI_WIN_FENCE
• 英特尔mpi（5.0.1.035）需要在mpi_防护墙之后增加一个mpi_屏障，因为它只保证“在两次mpi_Win_防护墙调用之间，所有RMA操作都已完成。”（）

赫里斯托和迈克尔·拉赫纳获得了荣誉

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

---

本着添加Fortran共享内存MPI示例的精神，我想扩展ftiaronsem的代码以合并一个循环，这样MPI_Win_fence和MPI_Barrier的行为就更清晰了（至少现在对我来说是这样）

具体来说，试着在注释掉的循环中使用MPI_Win_Fence或MPI_Barrier命令中的一个或两个来运行代码，以查看效果。或者，颠倒顺序

移除MPI_Win_围栏允许write语句显示尚未更新的内存

移除MPI_屏障允许其他进程在进程有机会写入之前运行下一次迭代并更改内存

前面的答案确实帮助我在MPI代码中实现了共享内存范例。谢谢

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

程序共享emtest
用法，内在：：ISO_C_绑定，仅限：C_PTR，C_F_指针
使用mpi
隐式无
整数，参数：：dp=所选的实际种类（14200）
整数：：win、win2、hostcomm、hostrank
整数（种类=MPI\U地址\U种类）：：WindowsSize
整数：：显示单位，我的排名，ierr，total，i
类型（C_PTR）：：baseptr，baseptr2
实数（dp），指针：：矩阵元素（：，：，：，：，：）
整数，可分配：：arrayshape（：）
调用MPI_INIT（ierr）
呼叫MPI通信等级（MPI通信等级，世界，我的等级，ierr）！获取一个进程的排名
调用MPI_COMM_SIZE（MPI_COMM_WORLD，total，ierr）！获取通信的总进程
调用MPI_Comm_split_type（MPI_Comm_WORLD，MPI_Comm_type_SHARED，0，MPI_INFO_NULL，hostcomm，ierr）
呼叫MPI_通信等级（hostcomm，hostrank，ierr）
! 感激地基于：http://stackoverflow.com/questions/24797298/mpi-fortran-code-how-to-share-data-on-node-via-openmp
! 及https://gcc.gnu.org/onlinedocs/gfortran/C_005fF_005fPOINTER.html
! 我们只希望每个主机有一个进程来分配内存
! 在除一个进程外的所有进程中将大小设置为0
分配（阵列形状（4））
阵列形状=（/10,10,10,10/）
如果（hostrank==0），则
WindowsSize=int（10**4，