【发布时间】：2017-06-20 13:10:57
【问题描述】：
在我的 Fortran90 代码中，我有一个带有多个嵌套循环的外循环。为了加快我的代码，我尝试在外循环上使用 OpenMP，但我有一个非常奇怪的问题：当我使用超过 1 个线程时，程序运行速度比使用带有 1 个线程的 OMP 慢，而 OMP 又比使用慢原始串行程序（就挂钟时间而言。我尝试使用 1、2、3 或 4 个线程）。然而，在所有情况下，我都得到了正确的结果。
我对我的代码进行了几次测试，最后我注意到问题出在一个子例程中，因为如果我注释了对该例程的调用，我的并行程序按预期工作，即线程数越大，越低挂钟时间。
现在，该例程接受输入 4 个向量“ks1”、“ks2”、“ket1”、“ket2”，并执行“ks1”和“ks2”之间的联合，获得“kstot”。然后它创建 2 个新向量，“ket1tot”和“ket2tot”，如果 ks1tot(i) 等于 ks1(j)，则 ket1tot(i) 等于 ket1(j)，否则 ket1tot(i)=0。 ket2tot 也是如此。
然后结合存储在向量“ks1tot”、“ket1tot”、“ket2tot”中的值，我计算向量（matFC）的哪些行包含我需要的值，通过乘以这些值，我得到最终结果（ FCtot)。
所以我把这个例程变成了一个简单的程序，添加了一些初始行以模仿真实的程序。我的意思是我补充说：
1) 一个循环（在 i 上），它模仿我试图并行化的真实程序的外循环；
2) 我实现了每个线程处理不同文件的事实（所以我不应该有错误共享问题）
3) 我添加了另一个循环（在 k 上），模仿我多次调用该例程。
这里是代码（构成给我问题的原始子程序的部分在文中指出）：
program evaluatefc
#ifdef _OPENMP
use omp_lib
#endif
implicit none
integer::i,ii,j,jj,jjj,k,sizeks1,sizeks2,sizec,sizekstot,NR,NR1,maxnq
integer::line,ierr,fileunit,mythread,nfreqtot
real*8::FCtot,time1,time2
integer,allocatable,dimension(:)::ks1,ket1,ks2,ket2
integer,dimension(:),allocatable::c,kstot,ket1tot,ket2tot
real*8,allocatable,dimension(:)::matFC
character*15,allocatable,dimension(:)::matfileFC
character::fileFC*15
real*4::tstarting,tending
! This program was originally a subroutine
! that takes in input 4 vectors, ks1, ks2, ket1, ket2
!---------------------------------------------------------------------------
! I initialize some values that in the original subroutine were computed by
!the main program
allocate(matfileFC(3),stat=ierr)
matfileFC(1)='filea.dat'
matfileFC(2)='fileb.dat'
matfileFC(3)='filec.dat'
sizeks1=2
sizeks2=2
maxnq=11
allocate(ks1(sizeks1),stat=ierr)
allocate(ket1(sizeks1),stat=ierr)
allocate(ks2(sizeks2),stat=ierr)
allocate(ket2(sizeks2),stat=ierr)
nfreqtot=42
NR1=nfreqtot*(maxnq**2)+nfreqtot
NR=nfreqtot*(maxnq**2)
allocate(matFC(NR),stat=ierr)
!Call two intrinsic to evaluate CPU and wall clock time
call cpu_time(time1)
tstarting=secnds(0.0)
!$OMP PARALLEL DO &
!$OMP DEFAULT(NONE) &
!$OMP firstprivate(sizeks1,sizeks2,maxnq,matfileFC,NR,NR1) &
!$OMP PRIVATE(i,ii,j,jj,k,ierr,mythread,fileunit,c,sizec,line,sizekstot) &
!$OMP PRIVATE(jjj,ket1,ks1,ket1tot,kstot,ket2,ks2,ket2tot,FCtot,matFC,fileFC)
do ii=1,3
#ifdef _OPENMP
mythread=OMP_GET_THREAD_NUM()
#else
mythread=10
#endif
fileFC=matfileFC(ii)
! Read some lines of a given file.
fileunit=50+mythread
open(unit=fileunit,name=fileFC,status='old',form='formatted')
read(fileunit,*)!Do not read first line
jjj=0
do jj=1,NR1-1
if(mod(jj,(maxnq**2+1)).eq.0) then
read(fileunit,*)
else
jjj=jjj+1
read(fileunit,*)j,k,i,matFC(jjj)
! I actually need only the fourth valor of the line to be stored
endif
enddo
close(fileunit)
do k=1,10000000
! Again I initialize the abovementioned values that in the actual
! subroutine are computed by the main program
ks1(1)=mod(k,30)+1
ks1(2)=mod(k,30)+2
ks2(1)=mod(k,17)+1
ks2(2)=mod(k,17)+3
ket1(1)=mod(k,2)
ket1(2)=mod(k,3)
ket2(1)=mod(k,5)
ket2(2)=mod(k,7)
sizec=sizeks1+sizeks2
allocate(c(sizec),stat=ierr)
do i=1,sizeks1
c(i)=ks1(i)
enddo
do i=sizeks1+1,sizec
c(i)=ks2(i-sizeks1)
enddo
sizekstot=sizec
do i=1,sizeks1
do j=1,sizeks2
if(ks1(i).eq.ks2(j)) then
sizekstot=sizekstot-1
endif
enddo
enddo
allocate(kstot(sizekstot),stat=ierr)
jjj=1
i=1
jj=0
do i=1,sizec-1
jjj=jjj+1
do j=jjj,sizec
if(c(i).eq.c(j)) then
exit
elseif(c(i).ne.c(j).and.j.eq.sizec) then
jj=jj+1
kstot(jj)=c(i)
endif
enddo
enddo
kstot(sizekstot)=c(sizec)
allocate(ket1tot(sizekstot),stat=ierr)
do i=1,sizekstot
ket1tot(i)=0
enddo
allocate(ket2tot(sizekstot),stat=ierr)
do i=1,sizekstot
ket2tot(i)=0
enddo
do i=1,sizekstot
do j=1,sizeks1
if(kstot(i).eq.ks1(j))then
ket1tot(i)=ket1(j)
endif
enddo
enddo
do i=1,sizekstot
do j=1,sizeks2
if(kstot(i).eq.ks2(j))then
ket2tot(i)=ket2(j)
endif
enddo
enddo
FCtot=1
do i=1,sizekstot
line=(kstot(i)-1)*(maxnq)**2+ket1tot(i)*(maxnq)+ket2tot(i)+1
FCtot=matFC(line)*FCtot
enddo
deallocate(c,stat=ierr)
deallocate(kstot,stat=ierr)
deallocate(ket1tot,stat=ierr)
deallocate(ket2tot,stat=ierr)
enddo
enddo
!$OMP END PARALLEL DO
call cpu_time(time2)
tending=secnds(tstarting)
write(*,*)
write(*,*)'CPU time is:'
write(*,*)time2-time1
write(*,*)
write(*,*)'Wall clock time is:'
write(*,*)tending
end program
我还是遇到了同样的问题，即使用 4 线程的挂钟时间比使用 1 线程的要大。
例如我得到（以秒为单位）：
输入 Wtime CPU 时间
1 线程 20.37 20.37
4 线程 31.26 91.61
串行 19.64 19.64
我知道对 OMP 库的调用引入了开销，实际上 1 线程 OMP 程序比串行程序慢。但我不明白为什么 4 线程 OMP 代码更慢。
我在 Linux 上使用 Intel fortran 编译器 2013。
有什么建议吗？
感谢您在任何时候都可以致力于解决这个问题。
【问题讨论】：
-
如果你缩进你的代码并展示一个代表你正在做什么的小测试程序，它会更容易阅读。请记住，您需要 OpenMP 方面的帮助（而不是我们许多人不太了解的理论化学方面的帮助），因此这将使我们能够更好地帮助您。话虽如此，您是否尝试过重新排序循环？英特尔编译器足够聪明，可以“猜测”哪个循环顺序更方便，前提是可以确定不会发生任何冲突。此外，如果可能，请尝试将分配/解除分配移到循环之外，这通常效率更高。
-
@Jorge Bellón 对不起，我现在已经缩进了我的代码。关于分配/解除分配，在我的真实程序 ks1 等中没有固定大小，所以我发现每次分配正确的大小很有用。无论如何，我进行了一项测试，结果表明避免分配/解除分配可以使代码更快，但不能解决 OpenMP 的问题。最后但并非最不重要的一点是，“显示一个小型测试程序”是什么意思？我发布的代码是一个转入工作代码的例程（如果您有一个像“filea.dat”这样的文件要读取），所以我不明白我应该在您看来发布的“测试程序”是什么。
-
对于前面的评论，编译器可能会在 openmp 关闭时跳过冗余循环迭代。此外，如果在超线程上运行，如果你的 openmp 支持它，你应该设置亲和力。
-
cpu_time()在这里没用。system_clock()是可移植的标准壁挂时间子程序（与 secnds 不同）。 -
你的代码真的很长，整个问题也是如此。很长时间才能完整阅读。尝试减少文本（我已经删除了一些东西，但尝试删除物理的东西，它不相关）和代码。 我们需要更短的代码！ 请参阅minimal reproducible example。如果不滚动就无法放入框内，则说明它太长了。
标签： parallel-processing fortran openmp fortran90