R + Snow + Fortran + MPI崩溃 [英] R + Snow + Fortran + MPI crash

问题描述

这是

$ b

  library（snow）
 cl < -  
 
 makeCluster（2，type =MPI）
 clusterEvalQ（cl，MyPi :: FMPIpi（DARTS = 5000，ROUNDS = 100））
 stopCluster（cl）
  

忘记加载包 MyPi 。

编辑：根据您的编辑，允许我补充说，由于其GUI，我从不在 运行（打开）MPI（甚至是OpenMP）穿线它。对于并行工作，请从命令行启动。如果您期望使用MPI上下文，请使用 mpirun 或 orterun 。

This is a follow-up to my previous question.

I created an R package that uses a MPI Fortran module. This is the module:

Module Fortranpi
USE MPI
IMPLICIT NONE
contains
subroutine dboard(darts, dartsscore)
  integer, intent(in)                    :: darts
  double precision, intent(out)          :: dartsscore
  double precision                       :: x_coord, y_coord
  integer                                :: score, n

score = 0
do n = 1, darts
  call random_number(x_coord)
  call random_number(y_coord)

  if ((x_coord**2 + y_coord**2) <= 1.0d0) then
  score = score + 1
  end if
end do

dartsscore = 4.0d0*score/darts

end subroutine dboard

subroutine pi(avepi, DARTS, ROUNDS) bind(C, name="pi_")
  use, intrinsic                         :: iso_c_binding, only : c_double, c_int
  real(c_double), intent(out)            ::  avepi
  integer(c_int), intent(in)             ::  DARTS, ROUNDS
  integer                                ::  MASTER, rank, i, n
  integer, allocatable                   ::  seed(:)
  double precision                       ::  pi_est, homepi, pirecv, pisum

! we set it to zero in the sequential run
rank = 0
! initialize the random number generator
! we make sure the seed is different for each task
call random_seed()
call random_seed(size = n)
allocate(seed(n))
seed = 12 + rank*11
call random_seed(put=seed(1:n))
deallocate(seed)

avepi = 0
do i = 0, ROUNDS-1
  call dboard(darts, pi_est)
  ! calculate the average value of pi over all iterations
  avepi = ((avepi*i) + pi_est)/(i + 1)
end do
end subroutine pi


subroutine MPIpi(avepi, DARTS, ROUNDS) bind(C, name="pi2_")
use, intrinsic                         :: iso_c_binding, only : c_double, c_int
real(c_double), intent(out)            :: avepi
integer(c_int), intent(in)             :: DARTS, ROUNDS
integer                                :: i, n, mynpts, ierr, numprocs, proc_num
integer, allocatable                   :: seed(:)
double precision                       :: pi_est, y, sumpi

  call mpi_init(ierr)
  call mpi_comm_size(MPI_COMM_WORLD, numprocs, ierr)
  call mpi_comm_rank(MPI_COMM_WORLD, proc_num, ierr)

  if (numprocs .eq. 0) then
    mynpts = ROUNDS - (numprocs-1)*(ROUNDS/numprocs)
  else
    mynpts = ROUNDS/numprocs
  endif

  ! initialize the random number generator
  ! we make sure the seed is different for each task
  call random_seed()
  call random_seed(size = n)
  allocate(seed(n))
  seed = 12 + proc_num*11
  call random_seed(put=seed(1:n))
  deallocate(seed)

  y=0.0d0
    do i = 1, mynpts
    call dboard(darts, pi_est)
    y = y + pi_est
  end do

  call mpi_reduce(y, sumpi, 1, mpi_double_precision, mpi_sum, 0, &
                  mpi_comm_world, ierr)
  if (proc_num==0) avepi = sumpi/ROUNDS
  call mpi_finalize(ierr)
end subroutine MPIpi

end module Fortranpi

This is the R fucntion:

#'@export
FMPIpi <- function(DARTS, ROUNDS) {
  retvals <- .Fortran("pi2", avepi = as.numeric(1), DARTS =  as.integer(DARTS), ROUNDS =  as.integer(ROUNDS))
  return(retvals$avepi)
}

I am able to compile and load the package in Rstudio.

Now I'm trying to call my fucntion with this R code:

library(snow)
cl <- makeCluster(2, type = "MPI")
clusterEvalQ(cl, MyPi::FMPIpi(DARTS = 5000, ROUNDS = 100))
stopCluster(cl)

But when I try to run it Rstudio crashes. What am I doing wrong?

---

This is an even simpler example (also not working)

I created a package HelloFMPI. The NAMESPACE has this

  useDynLib(HelloFMPI)
  exportPattern("^[[:alpha:]]+")

test.f90:

subroutine test(id, ierr)
use mpi
implicit none
integer*4 id, ierr
call MPI_Comm_rank(MPI_COMM_WORLD, id, ierr)
end subroutine test

and hello.R:

hello <- function() {
  r <- .Fortran("test", as.integer(0), as.integer(0))
  return(r)
}

I can build and load the package with Rstudio. When I run this code:

library(HelloFMPI)
library(snow)
cl <- makeCluster(2, type = "MPI")
clusterEvalQ(cl, HelloFMPI::hello())
stopCluster(cl)

Rstudio crashes

解决方案

In

library(snow)
cl <- makeCluster(2, type = "MPI")
clusterEvalQ(cl, MyPi::FMPIpi(DARTS = 5000, ROUNDS = 100))
stopCluster(cl)

you forgot to load the package MyPi.

Edit: Based on your edits, allow me to add that I never run (Open)MPI (or even OpenMP) code inside RStudio due to its GUI threading around it. For parallel work, start on the command-line. And if you expect a MPI context, use mpirun or orterun.

这篇关于R + Snow + Fortran + MPI崩溃的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！