Question

我是MPI编程的新手。我必须测试3个代码，例如顺序，OpenMP和MPI代码。这三个代码（不是真实代码，仅举例说明）分别给出如下

顺序代码

 program no_parallel
 implicit none
 integer, parameter                         :: dp = selected_real_kind(15,307)  
 integer                                    :: i, j
 real(kind = dp)                            :: time1, time2
 real(kind = dp), dimension(1000000)        :: a
    !Initialisation
        do i = 1, 1000000
           a(i) = sqrt( dble(i) / 3.0d+0 ) 
        end do  
    call cpu_time( time1 )
        do j = 1, 1000 
             do i = 1, 1000000
                a(i) = a(i) + sqrt( dble(i) ) 
             end do 
        end do
    call cpu_time( time2 )
    print *, a(1000000)
    print *, 'Elapsed real time = ', time2 - time1, 'second(s)'
 end program no_parallel

OpenMP代码

 program openmp
 implicit none
 integer, parameter                         :: dp = selected_real_kind(15,307)  
 integer                                    :: i, j
 real(kind = dp)                            :: time1, time2, omp_get_wtime
 real(kind = dp), dimension(1000000)        :: a
    !Initialisation
        do i = 1, 1000000
           a(i) = sqrt( dble(i) / 3.0d+0 ) 
        end do 
    time1 = omp_get_wtime()
     !$omp parallel
        do j = 1, 1000
          !$omp do schedule( runtime ) 
             do i = 1, 1000000
                a(i) = a(i) + sqrt( dble(i) ) 
             end do
          !$omp end do 
        end do
     !$omp end parallel 
    time2 = omp_get_wtime()
    print *, a(1000000)
    print *, 'Elapsed real time = ', time2 - time1, 'second(s)'
 end program openmp

MPI代码

 program MPI
 implicit none
 include "mpif.h"
 integer, parameter                         :: dp = selected_real_kind(15,307)
 integer                                    :: ierr, num_procs, my_id, destination, tag, source, stat, i, j
 real(kind = dp)                            :: time1, time2
 real(kind = dp), dimension(1000000)        :: a
    call MPI_INIT ( ierr )
    call MPI_COMM_RANK ( MPI_COMM_WORLD, my_id, ierr )
    call MPI_COMM_SIZE ( MPI_COMM_WORLD, num_procs, ierr )  
    !Initialisation
        do i = 1, 1000000
           a(i) = sqrt( dble(i) / 3.0d+0 ) 
        end do
    destination = 0
    tag = 999
    source = 3
    stat = MPI_STATUS_SIZE
    time1 = MPI_Wtime()
        do j = 1, 1000     
           do i = 1 + my_id, 1000000, num_procs
              a(i) = a(i) + sqrt( dble(i) ) 
           end do
        end do
    call MPI_BARRIER ( MPI_COMM_WORLD, ierr )
    if( my_id == source ) then 
        call MPI_SEND ( a(1000000), 1, MPI_DOUBLE_PRECISION, destination, tag, MPI_COMM_WORLD, ierr )
    end if
    if( my_id == destination ) then
        call MPI_RECV ( a(1000000), 1, MPI_DOUBLE_PRECISION, source, tag, MPI_COMM_WORLD, stat, ierr )
    end if
    time2 = MPI_Wtime()
    if( my_id == 0) then
        print *, a(1000000)    !, 'from ID =', my_id 
        print *, 'Elapsed real time = ', time2 - time1, 'second(s)'
    end if
    stop 
    call MPI_FINALIZE ( ierr )
 end program MPI

我使用带有Intel Fortran Compiler 17.0.3优化标记的-O0编译了这些代码。 OpenMP和MPI代码均在4核Haswell Desktop上执行。我分别获得了顺序，OpenMP和MPI代码8.08s，2.1s和3.2s的CPU时间。实际上，我期待OpenMP和MPI代码之间的结果几乎相似;然而，事实并非如此。我的问题：

关于MPI代码，如果我想打印出a(1000000)的结果，是否可以更智能地执行此操作而不执行call MPI_SEND和call MPI_RECV ？
您是否知道仍然可以优化哪部分MPI代码？
关于MPI代码中的source，是否可以自动定义它？在这种情况下，对我来说很容易，因为处理器的数量是4，所以必须将a(1000000)分配给线程3.

提前谢谢。

Answer 1

实际上，你的MPI程序对我来说没什么意义。为什么所有排名都有相同的完整数组？你为什么要复制完整的数组？为什么只在这个特定的来源和目的地之间？

程序没有计算任何有用的东西，所以很难说，正确的程序是什么（没有正确计算任何有用的东西）。

在许多MPI程序中，您无法发送和接收整个阵列。甚至不是完整的本地数组，而只是它们之间的一些边界。

所以我想出了这个。请注意use mpi，我从任何地方删除了magic number 1000000。

我也删除了stop。在end之前停止只是一个坏习惯，但它没有害处。将它放在MPI_Finalize() 之前是非常有害的。

最重要的是，我以不同的方式分配了作品。每个等级都有自己的部分数据。

program Test_MPI

use mpi

 implicit none

 integer, parameter                         :: dp = selected_real_kind(15,307)
 integer                                    :: ierr, num_procs, my_id, stat, i, j
 real(kind = dp)                            :: time1, time2
 real(kind = dp), dimension(:), allocatable :: a
 integer, parameter                         :: n = 1000000
 integer                                    :: my_n, ns
    call MPI_INIT ( ierr )
    call MPI_COMM_RANK ( MPI_COMM_WORLD, my_id, ierr )
    call MPI_COMM_SIZE ( MPI_COMM_WORLD, num_procs, ierr )  

    my_n = n / num_procs
    ns = my_id * my_n
    if (my_id == num_procs-1) my_n = n - ns

    allocate(a(my_n))

    !Initialisation
        do i = 1, my_n
           a(i) = sqrt( real(i+ns, dp) / 3.0d+0 ) 
        end do

    stat = MPI_STATUS_SIZE
    time1 = MPI_Wtime()
        do j = 1, 1000     
           do i = 1 , my_n 
              a(i+my_id) = a(i) + sqrt( real(i+ns, dp) ) 
           end do
        end do
    call MPI_BARRIER ( MPI_COMM_WORLD, ierr )

    time2 = MPI_Wtime()
    if( my_id == 0) then
        !!!! why???  print *, a(my_n) 
        print *, 'Elapsed real time = ', time2 - time1, 'second(s)'
    end if

    call MPI_FINALIZE ( ierr )
 end program Test_MPI

是的，那里没有沟通。我无法想到为什么它应该在那里。如果它应该，你必须告诉我们原因。它应该几乎完美地扩展。

也许你想在一个等级中收集最终数组？很多人这样做，但通常根本不需要。目前尚不清楚为什么在你的情况下需要它。

Answer 2

最后，我得到了解决问题的方法。以前，我没有意识到并行化的方式在串行代码中循环：

~/my-project

在MPI代码中 循环分发 ：

do i = 1, 1000000
   a(i) = a(i) + sqrt( dble(i) ) 
end do

是问题所在。我假设这是因为发生了更多 缓存未命中 。因此，我将 块分发 应用于MPI代码，而不是循环分发，这样效率更高（ 适用于此情况!!! ）。我现在写一个修改后的MPI代码：

do i = 1 + my_id, 1000000, num_procs a(i) = a(i) + sqrt( dble(i) ) end do

现在，MPI代码可以与OpenMP实现（n）（几乎）相似的CPU时间。此外，它适用于优化标志-O3和-fast的使用。

谢谢大家的帮助。 :)

Answer 3

我发现在SUBROUTINE或FUNCTION中通常需要更多的工作来使并行性得到回报，所以在这个例子中，关注矢量化是最好的方法。
绰号是“Vecorize inner - Parallelise outer”（VIPO）
对于第二种情况，我建议如下：

MODULE MyOMP_Funcs
IMPLICIT NONE
PRIVATE

integer, parameter, PUBLIC           :: dp = selected_real_kind(15,307)  
real(kind = dp), dimension(1000000)  :: a

PUBLIC  MyOMP_Init, MyOMP_Sum

CONTAINS

!=================================
SUBROUTINE MyOMP_Init(N,A)
IMPLICIT NONE

integer                      , INTENT(IN   ) :: N  
real(kind = dp), dimension(n), INTENT(INOUT) :: A

integer                                      :: I 

!Initialisation
DO i = 1, n
  A(i) = sqrt( dble(i) / 3.0d+0 ) 
ENDDO 

RETURN
END SUBROUTINE MyOMP_Init


!=================================
SUBROUTINE MyOMP_Sum(N,A,SumA)
!$OMP DECLARE SIMD(MyOMP_Sum) UNIFORM(N,SumA) linear(ref(A))
USE OMPLIB
IMPLICIT NONE

integer                      , INTENT(IN   ) :: N
!DIR$ ASSUME_ALIGNED A: 64                   :: A
real(kind = dp), dimension(n), INTENT(IN   ) :: A
real(kind = dp)              , INTENT(  OUT) :: SumA

integer                                      :: I

SumA = 0.0

!Maybe also try...  !DIR$ VECTOR ALWAYS

!$OMP SIMD REDUCTION(+:SumA)
Sum_Loop: DO i = 1, N
  SumA = SumA + A(i) + sqrt( dble(i) ) 
ENDDO Sum_Loop
!$omp end   !<-- You probably do not need these

RETURN
END SUBROUTINE MyOMP_Sum

!=================================
SUBROUTINE My_NOVEC_Sum_Sum(N,A,SumA)
IMPLICIT NONE

integer                      , INTENT(IN   ) :: N
!DIR$ ASSUME_ALIGNED A: 64                   :: A
real(kind = dp), dimension(n), INTENT(IN   ) :: A
real(kind = dp)              , INTENT(  OUT) :: SumA

integer                                      :: I

SumA = 0.0

!DIR$ NOVECTOR
Sum_Loop: DO i = 1, N
  SumA = SumA + A(i) + sqrt( dble(i) ) 
ENDDO Sum_Loop

RETURN
END SUBROUTINE My_NOVEC_Sum

!=================================
END MODULE MyOMP_Funcs
!=================================


!=================================
program openmp
!USE OMP_LIB 
USE MyOMP_Funcs 
implicit none

integer        , PARAMETER          :: OneM = 1000000
integer        , PARAMETER          :: OneK = 1000
integer                             :: i, j
real(kind = dp)                     :: time1, time2, omp_get_wtime
!DIR$ ATTRIBUTES ALIGNED:64         :: A, SumA
real(kind = dp), dimension(OneM)    :: A
real(kind = dp)                     :: SumA
!Initialisation

CALL MyOMP_Init(N,A)
time1 = omp_get_wtime()

!  !$omp parallel
!    do j = 1, OneK

CALL MyOMP_Sum(OneM, A, SumA)

!    end do
!  !$omp end parallel 
!!--> Put timing loops here

time2 = omp_get_wtime()
print *, a(1000000)
print *, 'Elapsed real time = ', time2 - time1, 'second(s)'

end program openmp

运行SIMD REDUCTION版本后，您可以尝试分层并行如果模块是库的一部分，则编译器设置独立于程序。

Single vs OpenMP vs MPI - Fortran

3 个答案: