Parallel processing OpenMP比串行Fortran90代码慢

在我的Fortran90代码中，我有一个带有多个嵌套循环的外部循环。为了加速我的代码，我尝试在外循环上使用OpenMP，但我遇到了一个非常奇怪的问题：当我使用超过1个线程时，程序运行速度比使用OMP和1个线程慢，而OMP和1个线程的运行速度又比使用原始串行程序慢（就挂钟时间而言，我尝试了1、2、3或4个线程）。然而，在所有情况下，我都得到了正确的结果

我对我的代码进行了几次测试，最后我注意到问题出在一个子例程中，因为如果我对该例程的调用进行注释，我的并行程序将按预期工作，即线程数越大，挂钟时间越短

现在，该例程接收输入4个向量“ks1”、“ks2”、“ket1”、“ket2”，并执行“ks1”和“ks2”之间的并集，从而获得“kstot”。然后创建两个新向量“ket1tot”和“ket2tot”，其中，如果ks1tot（i）等于ks1（j），则ket1tot（i）等于ket1（j），否则ket1tot（i）=0。凯托也是这样

然后结合存储在向量“ks1tot”、“ket1tot”、“ket2tot”中的值，我计算向量的哪些行（matFC）包含我需要的值，并通过乘以这些值，得到最终结果（FCtot）

所以我在一个简单的程序中打开这个例程，添加一些初始行以模拟真实的程序。我是说，我补充说：

1） 一个循环（在i上），它模仿我试图并行化的真实程序的外循环

2） 我实现了这样一个事实：每个线程在不同的文件上工作（因此我不应该有错误的共享问题）

3） 我添加了另一个循环（在k上），它模仿我多次调用例程

以下是代码（文本中指出了构成原始子程序的部分，该子程序给我带来了问题）：

不过，我还是遇到了同样的问题，即使用4个线程的挂钟时间比使用1个线程的挂钟时间大

例如，我得到（秒）：

输入Wtime CPU时间

1螺纹20.37 20.37

4螺纹31.26 91.61

序列号19.64 19.64

我知道调用OMP库会带来开销，事实上，单线程OMP程序比串行OMP程序慢。但我无法理解为什么4线程OMP代码速度较慢

我在Linux上使用英特尔fortran编译器2013

有什么建议吗

---

感谢您抽出时间来解决这个问题。

好的，我解决了自己的问题

感谢大家的建议，特别是@Jorge Bellón和@High Performance Mark

正如他们的评论所说，问题实际上是分配/解除分配的数量太多。如果我将分配移出循环，或者至少如果我将分配放在第一个循环之后，我会得到“正常”的OpenMP行为，即线程数越大，挂钟时间越短

对于上面的示例，使用4个线程的挂钟时间现在大约为7秒

---

谢谢大家的帮助。

如果缩进代码并显示一个代表您所做工作的小测试程序，阅读起来会容易得多。请记住，您需要OpenMP的帮助（而不是我们许多人不太了解的理论化学），因此这将使我们能够更好地帮助您。也就是说，您是否尝试重新排列循环？“英特尔编译器”足够聪明，可以“猜测”哪种循环顺序更方便，只要它足够确定不会有任何冲突。此外，如果可能的话，尝试将allocate/deallocate移到循环之外，这通常会更有效率。@Jorge Bellón对不起，我现在已经缩进了我的代码。关于分配/解除分配，在我的实际程序中，ks1等没有固定的大小，因此我发现每次分配正确的大小都很有用。无论如何，我已经进行了一项测试，它表明避免分配/解除分配会使代码更快，但并不能解决OpenMP的问题。最后，但并非最不重要的一点是，“显示一个小测试程序”是什么意思？我发布的代码是一个在工作代码中转换的例程（如果您有一个类似“filea.dat”的文件要读取），因此我不明白您认为我应该发布的“测试程序”是什么。除了前面的评论，当openmp关闭时，编译器可能会跳过冗余循环迭代。此外，如果在超线程上运行，您应该在openmp支持的情况下设置关联。

cpu\u time（）

在这里是无用的

system_clock（）

是可移植的标准壁时子程序（与SECDS不同）。您的代码很长，整个问题也很复杂。渴望完全阅读。尽量减少文本（我已经删除了一些内容，但尝试删除物理内容，这是不相关的）和代码。我们需要更短的代码！看见如果没有滚动就无法放入框中，则说明它太长。

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