在 Fortran mpi 中并行化部分串行代码

问题描述

我想在我最初的串行 Fortran 程序中并行化一个模块。（原串口程序涉及到几个Module）

更具体地说，由于模块用于计算大矩阵的 FFT，我只希望该模块在具有 MPI 的多个处理器中执行。

其他模块和主程序应该由一个处理器完成。

我将我的问题简化为下面的一个主程序和一个模块。主程序：

program main
  use myfft
  implicit none

  call myfft_setup
  write(*,*) 'Hello World in main: ',myid,'of ',nproc
  stop

end

模块：

module myfft
   use,intrinsic :: iso_c_binding
   implicit none
   include 'mpif.h'
   include 'fftw3-mpi.f03'
   integer :: ierr,nproc

   contains

   subroutine myfft_setup
   call mpi_init(ierr)
   call MPI_COMM_SIZE(MPI_COMM_WORLD,nproc,ierr)
   call MPI_COMM_RANK(MPI_COMM_WORLD,ierr)
   call fftw_mpi_init()

   write(*,*) 'Hello World in module: ',nproc

   call fftw_mpi_cleanup()
   call mpi_finalize(ierr)
  
   end subroutine
   end module

有一些 FFTW 函数可以忽略。要使用四个处理器执行 MPI 编译代码，我使用了以下命令：

mpirun -n 4 a.out

结果：

 Hello World in module:            0 of            4
 Hello World in module:            1 of            4
 Hello World in module:            2 of            4
 Hello World in module:            3 of            4
 Hello World in main:            0 of            0
 Hello World in main:            0 of            0
 Hello World in main:            0 of            0
 Hello World in main:            0 of            0

它表明处理器编号 0 自己已经完成了四次 Hello World。我希望 Hello World 在主程序中由处理器编号 0 完成一次，但是模块中的 Hello World 仍然是在并行版本中完成的（四次，不同的 proc）。

我应该如何重写我的代码？或者我应该如何更改我的命令行？

完整代码：

module myfft
       use,intrinsic :: iso_c_binding
       implicit none
       include 'mpif.h'
       include 'fftw3-mpi.f03'
       integer :: ierr,nproc

contains

subroutine myfft_setup
       ! Parameter DeFinition
       implicit none

       integer(C_INTPTR_T),parameter :: L = 1024
       integer(C_INTPTR_T),parameter :: M = 1024

       !Variable DeFinition
       integer(C_INTPTR_T) :: alloc_local,local_M,local_j_offset
       integer(C_INTPTR_T) :: i,j

       complex(C_DOUBLE_COMPLEX),pointer :: fdata(:,:)
       complex(C_DOUBLE_COMPLEX) :: fout


       type(C_PTR) :: plan,cdata

       integer :: ierr,nproc

       real(C_DOUBLE) :: t1,t2,t3,t4,tplan,tmid,texec
!
! Initialize
   call mpi_init(ierr)
   call MPI_COMM_SIZE(MPI_COMM_WORLD,ierr)
   call fftw_mpi_init()
!
!   get local data size and allocate (note dimension reversal)
   alloc_local = fftw_mpi_local_size_2d(M,L,&
    &                  MPI_COMM_WORLD,local_j_offset)
   cdata = fftw_alloc_complex(alloc_local)
   call c_f_pointer(cdata,fdata,[L,local_M])
!

!   create MPI plan for in-place forward DFT (note dimension reversal)
         t1 = MPI_wtime()
   plan = fftw_mpi_plan_dft_2d(M,&
    &         MPI_COMM_WORLD,FFTW_FORWARD,FFTW_ESTIMATE)
         t2 = MPI_wtime()
!
! initialize data to some function my_function(i,j)
   do j = 1,local_M
     do i = 1,L
       call initial(i,(j + local_j_offset),M,fout)
       fdata(i,j) = fout
     end do
   end do
!
! compute transform (as many times as desired)
         t3 = MPI_wtime()
   call fftw_mpi_execute_dft(plan,fdata)
         t4 = MPI_wtime()
!
! print solutinos
         tplan = t2 - t1
         tmid = t3 - t2
         texec = t4 - t3
         write(*,*) 'in module: ',nproc
         if (myid.eq.0) print*,'Tplan=','   Tmid=','   Texec=',texec
!
! deallocate and destroy plans
   call fftw_destroy_plan(plan)
   call fftw_mpi_cleanup()
   call fftw_free(cdata)
   call mpi_finalize(ierr)
!
end subroutine
!
! ***** Subroutines ****************************************************
!
 subroutine initial(i,j,fout)
 use,intrinsic :: iso_c_binding

 implicit none

 integer(C_INTPTR_T),intent(in) :: i,M
 complex(C_DOUBLE_COMPLEX),intent(out) :: fout
 real(C_DOUBLE),parameter :: amp = 0.25
 real(C_DOUBLE) :: xx,yy,LL,MM,r1

   xx = real(i,C_DOUBLE) - real((L+1)/2,C_DOUBLE)
   yy = real(j,C_DOUBLE) - real((M+1)/2,C_DOUBLE)
   LL = real(L,C_DOUBLE)
   MM = real(M,C_DOUBLE)

   r1 = sqrt(((xx/LL)**2.) + ((yy/MM)**2.))
   if (r1 .le. amp) then
     fout = CMPLX(1.,0.,C_DOUBLE_COMPLEX)
         else
           fout = CMPLX(0.,1.,C_DOUBLE_COMPLEX)
         endif

     return
  end Subroutine
! **********************************************************************
end module


!to compile seperately
!mpif90 -I/usr/local/include -L/usr/local/lib -c myfft.f90 -lfftw3_mpi -lfftw3 -lm
!mpif90 -I/usr/local/include -L/usr/local/lib -c main.f90 -lfftw3_mpi -lfftw3 -lm
!mpif90 -I/usr/local/include -L/usr/local/lib myfft.o main.o -lfftw3_mpi -lfftw3 -lm
!to execute
!mpirun -n #nprocs ./main

program main
  use myfft
  implicit none

  call myfft_setup
  write(*,*) 'Hello World from process: ',nproc

  stop
end

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

fftw fortran mpi parallel-processing