chr*_*ris 9 memory fortran memory-management mpi openmp
我正在研究已经使用MPI的Fortan代码.
现在,我面临的情况是,一组数据变得非常大但每个进程都相同,所以我宁愿每个节点只将它存储在内存中一个节点,并且一个节点上的所有进程都访问相同的数据.
为每个进程存储一次将超出可用的RAM.
以某种方式用openMP实现类似的东西吗？
每个节点的数据共享是我唯一想要的,不需要每个节点的并行化,因为这已经通过MPI完成了.
Hri*_*iev 15
如果仅用于共享大量数据,则无需实现混合MPI + OpenMP代码.你实际需要做的是:
1)将世界通信器拆分为跨越同一主机/节点的组.如果你的MPI库实现了MPI-3.0,这真的很容易 - 所有你需要做的就是MPI_COMM_SPLIT_TYPE使用split_typeset来调用MPI_COMM_TYPE_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_COMM_SPLIT_TYPE操作,并且必须具有一定的创造性.例如,你可以用我的简单的分离由主机实现,可在Github上找到这里.
2)现在驻留在同一节点上的进程是同一个通信器的一部分hostcomm,它们可以创建一个共享内存块并使用它来交换数据.同样,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_WIN_ALLOCATE_SHARED在每个进程中分配一块共享内存.由于您希望共享一个数据块,因此仅在单个进程中分配它并且不将其分布在进程中size是有意义的,因此在进行调用时除了一个等级之外的所有数据都设置为0.MPI_WIN_SHARED_QUERY用于查找共享内存块在调用进程的虚拟地址空间中映射的地址.一个地址是已知的,C指针可以使用C_F_POINTER()子例程与Fortran指针相关联,后者可以用于访问共享存储器.完成后,必须通过破坏共享内存窗口来释放共享内存MPI_WIN_FREE.
MPI-2.2或更早版本不提供共享内存窗口.在这种情况下,一个具有使用依存于OS的API来创建共享存储器块,例如标准的POSIX序列shm_open()/ ftruncate()/ mmap().必须编写可从Fortran调用的实用程序C函数才能执行这些操作.请参阅该代码以获得一些灵感.在void *通过返回mmap()可以在被直接传递到Fortran代码C_PTR可与一个Fortran指针然后相关联的类型的变量.
有了这个答案,我想添加一个完整的运行代码示例(对于ifort 15和mvapich 2.1).MPI共享内存概念仍然很新,特别是Fortran的代码示例并不多.它是基于从斯托伊奇答案和MVAPICH邮件列表(在一个非常有用的电子邮件http://mailman.cse.ohio-state.edu/pipermail/mvapich-discuss/2014-June/005003.html).
代码示例基于我遇到的问题,并通过以下方式增加了Hristo的答案:
感谢Hristo和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