Question

我正在尝试在Fortran中重现this C示例。我的代码到目前为止：

use mpi

implicit none
integer, parameter :: maxn = 8
integer, allocatable :: xlocal(:,:)

integer :: i, j, lsize, errcnt, toterr, buff

integer :: ierror, nproc, pid, root = 0, nreq = 0
integer, allocatable :: request(:), status(:,:)

call MPI_INIT(ierror)
call MPI_COMM_SIZE(MPI_COMM_WORLD, nproc, ierror)
call MPI_COMM_RANK(MPI_COMM_WORLD, pid, ierror)

if (mod(maxn, nproc) /= 0) then
    write(*,*) 'Array size (maxn) should be a multiple of the number of processes'
    call MPI_ABORT(MPI_COMM_WORLD, 1, ierror)
end if

lsize = maxn/nproc

allocate(xlocal(0:lsize+1, maxn))
allocate(request(nproc))
allocate(status(MPI_STATUS_SIZE,nproc))

xlocal(0,:) = -1
xlocal(1:lsize,:) = pid
xlocal(lsize+1,:) = -1

! send down unless on bottom
if (pid < nproc-1) then
    nreq = nreq + 1
    call MPI_ISEND(xlocal(lsize,:), maxn, MPI_INTEGER, &
                  pid+1, 0, MPI_COMM_WORLD, request(nreq), ierror)
    write(*,'(2(A,I1),A)') 'process ', pid, ' sent to process ', pid+1, ':'
    write(*,*) xlocal(lsize,:)
end if

if (pid > 0) then
    nreq = nreq + 1
    call MPI_IRECV(xlocal(0,:), maxn, MPI_INTEGER, &
                  pid-1, 0, MPI_COMM_WORLD, request(nreq), ierror)
    write(*,'(2(A,I1),A)') 'process ', pid, ' received from process ', pid-1, ':'
    write(*,*) xlocal(0,:)
end if

! send up unless on top
if (pid > 0) then
    nreq = nreq + 1
    call MPI_ISEND(xlocal(1,:), maxn, MPI_INTEGER, &
                  pid-1, 1, MPI_COMM_WORLD, request(nreq), ierror)
    write(*,'(2(A,I1),A)') 'process ', pid, ' sent to process ', pid-1, ':'
    write(*,*) xlocal(1,:)
end if

if (pid < nproc-1) then
    nreq = nreq + 1
    call MPI_IRECV(xlocal(lsize+1,:), maxn, MPI_INTEGER, &
                  pid+1, 1, MPI_COMM_WORLD, request(nreq), ierror)
    write(*,'(2(A,I1),A)') 'process ', pid, ' received from process ', pid+1, ':'
    write(*,*) xlocal(lsize+1,:)
end if

call MPI_WAITALL(nreq, request, status, ierror)

! check results
errcnt = 0
do i = 1, lsize
    do j = 1, maxn
        if (xlocal(i,j) /= pid) errcnt = errcnt + 1
    end do
end do
do j = 1, maxn
    if (xlocal(0,j) /= pid-1) errcnt = errcnt + 1
    if ((pid < nproc-1) .and. (xlocal(lsize+1,j) /= pid+1)) errcnt = errcnt + 1
end do

call MPI_REDUCE(errcnt, toterr, 1, MPI_INTEGER, MPI_SUM, 0, MPI_COMM_WORLD)

if (pid == root) then
    if (toterr == 0) then
        write(*,*) "no errors found"
    else
        write(*,*) "found ", toterr, " errors"
    end if
end if

deallocate(xlocal)
deallocate(request)
deallocate(status)

call MPI_FINALIZE(ierror)

但我遇到了分段错误，无法弄清楚原因。我有一种感觉，这是由于请求数组。有人可以解释在Fortran中使用请求数组的正确方法吗？我发现的参考文献都没有澄清这一点。

事先提前

Answer 1

如果您还没有这样做，请考虑使用一些可帮助您进行调试的标志来编译程序，例如：使用gfortran，您可以使用-O0 -g -fbounds-check（如果这样做无效，您可以为版本＆gt; = 4.8添加-fsanitize=address。其他编译器有类似的调试选项。

这样做，并使用2个进程运行，您可以在MPI_Reduce行编程崩溃。如果查看规范（例如OpenMPI 1.8），您可以看到此子例程需要多一个参数，即您忘记在最后添加ierror参数。

尽管来自mpi模块的子程序可以通过use关联访问，但是应该检查参数的一致性以避免这些微不足道的错误，但是并不是所有子程序都必须在该模块中。我不知道你使用了哪个MPI实现，但是我检查了我的本地MPICH安装，它没有模块中的大多数子程序，因此它们没有明确的接口。我想你处于类似的情况，但我猜其他实现可能会遇到类似的命运。您可以将它与缺少MPI_Reduce的函数原型的C头文件进行比较。我想这是因为最初只有一个Fortran 77接口用于大多数实现。

一些最终评论：注意不要只复制粘贴C代码。您传递的数组不是连续的，并且会导致临时副本传递给MPI例程，效率非常低（在这种情况下并不重要）。

在MPI非阻塞发送/接收中请求数组

1 个答案: