我正在使用SUNDIAL解决一个耦合非线性ODE的大型系统，我遇到了性能问题。一些分析表明，我在设置定义我的方程组的数组（在Fortran 77中）时遇到了严重的瓶颈。特别是，我需要定义一个嵌套的三重循环数组，并在最内层循环中执行求和。这些数组在每个时间步都被填充（我使用隐式 - 微分代数方程求解器，因为我的控制方程有一个非平凡的系数矩阵），我正在寻找关于加速这些计算的潜在方法的建议/参考。我将提供一个显示我的问题的示例代码，以及到目前为止我尝试过的一些细节。
首先，一些背景：
我有问题的数组采用的形式（整个测试代码将包含在下面）
do n= 0,niv
do l= 0,niv
do k= 0,niv
sumdum = 0
do m = 1, niv
sumdum = sumdum+(p(-m,l)*qmat(m,k,n)+p(m,k)*qmat(-m,l,n))
enddo
sqmat(k,l,n) = sumdum
enddo
enddo
enddo
其中niv是自变量的数量。 niv将最终介于100和300之间.p（m，l）和qmat（m，k，n）是先前定义的（复杂）数组（参见下面的代码）。
现在，让我们做一些基准测试（Mac 2.5 GHz i5，gfortran，gcc v 4.8.2 x86_64）。使用OpenMP时钟，我看到，对于niv = 100，我的机器上的总测试代码需要1.49秒（编辑：我已经改变了这个时间以反映包含O2标志）
call omp_set_num_threads ( 1 )
我用
编译 gfortran -fopenmp -O2 -Wl,-stack_size,0x40000000 test.f
现在，如果我看到在填充sqmat数组之前我的代码需要多长时间才能达到这一点，我发现t = 0.21s，这意味着大约87％的时间用于定义这些数组。这并不奇怪，因为这些阵列有4 *（101）^ 3 * 100的计算，而下一个最大的阵列有（201）^ 3个元素，即它大约小100倍。另请注意，对于niv = 150，我发现代码需要~7.01s，而sqmat数组占用的时间占90％。最后，我注意到在SUNDIALS的背景下并且解决了这个ODE系统，这些矩阵消耗了大约50％的niv = 100的计算时间。
希望我已经充分地定义了我的问题，现在我将简要讨论我为加快速度所做的尝试。
显然，根据我上面所写的内容，我转向了OpenMP。这提供了一些加速--2个线程给我一个1.63加速的因子，而4个线程提供比4个线程情况的1.02倍的加速。我使用OpenMP的方式包含在下面的代码中。我可以访问具有许多内核的计算机，所以我很想知道我使用OpenMP的方式是否存在某些问题，这可能会提高速度。表面上，存在不同的sqmat组件调用p（m，j）和qmat（i，j，k）的相同组件的问题。我不确定这是否会降低这里的性能，也没有找到能够绕过这个的方法，所以在这方面的任何建议都会受到赞赏。
第二道攻击是通过利用p和qmat的对称性来尝试减轻这些循环中的计算次数。这使我可以将计算次数减少一半。此外，通过检查，似乎这些数组是“稀疏的”，但我找不到这种稀疏性的结构 - 也许这可以以某种方式被利用。
我最近一直在考虑的是转向处理矩阵乘法的现有fortran套件（类似于PBLAS），希望这些套件可以更有效地计算sqmat项（因为sqmat是p和q的张量积） ）。有没有人对PBLAS有任何经验 - 与Fortran的规范阵列结构相比，这会提供显着的加速吗？我很好奇这一点，特别是在并行化的背景下。
因此，总而言之，我的问题是如何有效地填充这些类型的数组的组件。任何建议或参考，将不胜感激。
尼克
示例代码包含在下面。注意，对openmp，c $ omp的调用被缩进以使代码全部包含在一个代码块中。
program test
implicit none
include 'omp_lib.h'
integer*4 iout(25), ipar, neq, niv, Mtot,ii
parameter (Mtot = 10)
double precision rout(10), rpar
parameter (neq = 4*100)
parameter (niv = neq/4)
integer iatol, nout, jout, itask
integer nst, kused, hused, No
double precision t0, t1, rtol, tout, tret, tout1
double precision y(neq), yp(neq), atol(neq), u(niv)
data nst/3/, kused/9/, hused/2/
integer reserr
integer m, j, kk, l, n, l1, l2, l3, i, ll, indsum, indsum2
integer indsum3, i4, k, k1, k2,k3, k4, k5, k6, l2p, l2pp
integer k3a, k3b
double precision po, tcond, c, qout(1:niv,-niv:niv)
double precision res(neq),res2(niv), res3(niv)
double complex p(-niv:niv,-niv:niv), V(niv), resd2a,
& Vec(-niv:niv)
double complex qmat(-niv:niv,-niv:niv,-niv:niv)
double complex qmat2(-niv:niv,-niv:niv,-niv:niv)
double complex sqmat(-niv:niv,-niv:niv,-niv:niv)
double complex sqmat1(-niv:niv,-niv:niv,-niv:niv)
double complex sqmat2(-niv:niv,-niv:niv,-niv:niv)
double complex sqmat3(-niv:niv,-niv:niv,-niv:niv)
double complex q(-niv:niv,-niv:niv),
& smat(-niv:niv,-niv:niv,-niv:niv)
double complex sumdum, sum1, sum2(niv), sum3(niv), qsum,
& resd, resd2, sumdum2
double complex ssum1, ssum2, forcing(niv)
double precision seconds, seconds2, seconds3,seconds4,seconds5
real :: start, finish
call omp_set_num_threads ( 1 )
seconds = omp_get_wtime ( )
write ( *, '(a)' ) ' '
write ( *, '(a,i8)' )
& ' Number of processors available = ', omp_get_num_procs ( )
write ( * ,'(a,i8)' )
& ' Number of threads = ', omp_get_max_threads ( )
y = 0
do i = 1, niv
y(i) = 0.1d0*i
enddo
do i = niv+1,2*niv
y(i) = -0.01d0*i
enddo
c$omp parallel private(m,j,kk,l,k1,k2,k3a,k3b,k4,k5,k6) shared(p)
c$omp do
do j = -niv, niv
do m = -niv, niv
kk = m-j
l = m-j
k1 = m
k2 = j
k3a = m
k3b = j
k4 = m-j
k5 = j
k6 = m-j
if (abs(kk) .gt. niv) then
kk = 0
else
kk = 1
end if
if (k1 .eq. 0) then
k1 = 0
else
k1=1
end if
if (k2.eq.0) then
k2 = 0
else
k2 = 1
end if
if (k3a .eq. 0) then
k3a=1
else
k3a=0
end if
if (k3b .eq. 0) then
k3b=1
else
k3b=0
end if
if (k4 .eq. 0) then
k4 = 0
else
k4 = 1
end if
if (k5 .eq. 0) then
k5=2
else
k5=1
end if
if (k6 .eq. 0) then
k6=2
else
k6=1
end if
p(m,j)=(0.5*k5*k6*kk*abs(k4*sign(1,m-j)-k2*sign(1,j))*cmplx(k4
& *y(abs(m-j))+1-k4,k4*y(niv+abs(m-j))*sign(1,m-j))-0.5*cmplx(k1*
& y(abs(m))+(1-k1), k1*y(abs(m)+niv)*sign(1, m))*cmplx(k2*y(abs(j
& ))+(1-k2),-k2*y(abs(j)+niv)*sign(1,j)))/((abs(m)+k3a)**(0.5)*(
& k3b+abs(j)))
enddo
enddo
c$omp end do
c$omp end parallel
c$omp parallel reduction(+:qsum) private(m,j,n) shared(q)
c$omp do
do j = -niv, niv
do m = -niv, niv
qsum = 0.0d0
do n = 1, niv
qsum = qsum + p(n,m)*p(-n,j)
enddo
q(m,j) = qsum
enddo
enddo
c$omp end do
c$omp end parallel
q= 0.25d0*q
c$omp parallel private(m,j,n,kk,k1,k2,k3a,k3b,k5,k6,l,indsum,
c$omp& indsum2,i4,indsum3) shared(qmat)
c$omp do
do m= -niv, niv
do j= -niv, niv
do n= -niv, niv
kk = m-j
k1 = m
k2 = j
k3a = m
k3b = j
k5 = m-j
k6 = j
l = m-j
if (abs(kk). gt. niv) then
kk = 0
else
kk = 1
end if
indsum = m-j-n
if (indsum .eq. 0) then
indsum = 1
else
indsum = 0
end if
indsum2 = m+j-n
if (indsum2 .eq. 0) then
indsum2 = 1
else
indsum2 = 0
end if
indsum3 = j+n
if (indsum3 .eq. 0) then
indsum3 = 1
else
indsum3 = 0
end if
i4 = m-n
if (i4 .eq. 0) then
i4 = 1
else
i4 = 0
end if
if (k3a .eq. 0) then
k3a=1
else
k3a=0
end if
if (k3b .eq. 0) then
k3b=1
else
k3b=0
end if
if (k1 .eq. 0) then
k1 = 0
else
k1 = 1
end if
if (k2 .eq. 0) then
k2 = 0
else
k2 = 1
end if
if (k5 .eq. 0) then
k5=2
else
k5=1
end if
if (k6 .eq. 0) then
k6=2
else
k6=1
end if
if (l.eq.0) then
l = 0
else
l = 1
end if
qmat(m,j,n) = (0.5*k5*k6*kk*abs(l*sign(1,m-j)-k2*sign(1,j))*
& cmplx(indsum,0)-0.5*indsum3*cmplx(y(abs(m))+1-k1,sign(1,
& m)*y(abs(m)+niv))-0.5*i4*cmplx(y(abs(j))+1-k2, -sign(1,
& j)*y(abs(j)+niv)))/((abs(m)+k3a)**(0.5)*(
& k3b+abs(j)))
enddo
enddo
enddo
c$omp end do
c$omp end parallel
c$omp parallel reduction(+:sumdum) private(k,l,n,m) shared(sqmat)
c$omp do
do n= 0,niv
do k= 0,niv
do l= 0,niv
sumdum = 0
do m = 1, niv
sumdum = sumdum+(p(-m,l)*qmat(m,k,n)+p(m,k)*qmat(-m,l,n))
enddo
sqmat(k,l,n) = sumdum
sqmat(-l,-k,-n) =conjg( sumdum)
enddo
enddo
enddo
c$omp end do
c$omp end parallel
c$omp parallel reduction(+:sumdum) private(k,l,n,m) shared(sqmat)
c$omp do
do n= -niv, 0
do l= 0,niv
do k= 0,niv
sumdum = 0
do m = 1, niv
sumdum = sumdum+(p(-m,l)*qmat(m,k,n)+p(m,k)*qmat(-m,l,n))
enddo
sqmat(k,l,n) =sumdum
sqmat(-l,-k,-n) = conjg(sumdum)
enddo
enddo
enddo
c$omp end do
c$omp end parallel
c$omp parallel reduction(+:sumdum) private(k,l,n,m) shared(sqmat)
c$omp do
do n= -niv, 0
do l= -niv, 0
do k= 0, niv
sumdum = 0
do m = 1, niv
sumdum = sumdum+(p(-m,l)*qmat(m,k,n)+p(m,k)*qmat(-m,l,n))
enddo
sqmat(k,l,n) = sumdum
sqmat(-l,-k,-n) = conjg(sumdum)
enddo
enddo
enddo
c$omp end do
c$omp end parallel
c$omp parallel reduction(+:sumdum) private(k,l,n,m) shared(sqmat)
c$omp do SCHEDULE(DYNAMIC,1)
do n= -niv, 0
do k= -niv, 0
do l= 0, niv
sumdum = 0
do m = 1, niv
sumdum = sumdum+(p(-m,l)*qmat(m,k,n)+p(m,k)*qmat(-m,l,n))
enddo
sqmat(k,l,n) = sumdum
sqmat(-l,-k,-n) = conjg(sumdum)
enddo
enddo
enddo
c$omp end do
c$omp end parallel
sqmat = 0.25d0*sqmat
seconds = omp_get_wtime ( ) - seconds;
print*, seconds
return
end
答案 0 :(得分：0)
我不能把它放在评论中，但这不仅仅是一个问题，而是一个答案。您的问题似乎围绕代码的最后部分进行了很多讨论：
c$omp parallel reduction(+:sumdum) private(k,l,n,m) shared(sqmat)
c$omp do SCHEDULE(DYNAMIC,1)
do n= -niv, 0
do k= -niv, 0
do l= 0, niv
sumdum = 0
do m = 1, niv
sumdum = sumdum+(p(-m,l)*qmat(m,k,n)+p(m,k)*qmat(-m,l,n))
enddo
sqmat(k,l,n) = sumdum
sqmat(-l,-k,-n) = conjg(sumdum)
enddo
enddo
enddo
c$omp end do
c$omp end parallel
你在并行方面采取的方法有点令人困惑。我没有看到，为什么你需要减少项，sumdum可能是一个完美的私有变量，你说，k，l，n都应该是独立的。在您的代码中，求和发生在最里面的循环中，甚至没有并行化，除非您忘记在示例代码中包含collapse子句。现在只有你的最外层循环得到并行化，如果我理解正确的话，你会在线程上分配100-300次循环迭代。对于少于10个线程，实际上应该没问题，但是我猜测减少和动态调度在这里完全杀了你。
对我来说看起来像以下仍然是一个有效的并行实现：
!$omp parallel private(k,l,n,m,sumdum) shared(sqmat)
!$omp do collapse(3)
do n= -niv, 0
do k= -niv, 0
do l= 0, niv
sumdum = 0
do m = 1, niv
sumdum = sumdum+(p(-m,l)*qmat(m,k,n)+p(m,k)*qmat(-m,l,n))
enddo
sqmat(k,l,n) = sumdum
sqmat(-l,-k,-n) = conjg(sumdum)
enddo
enddo
enddo
!$omp end do
!$omp end parallel
通过手动展开求和循环，并使用条带挖掘方法对求和运算进行向量化，可以进一步提高速度。
答案 1 :(得分：0)
阅读完帖子之后，我首先想到的是你应该做更严肃的剖析。您提供的时序信息非常简陋，并且没有实际分析浮点运算性能或内存带宽使用情况。
看看你声称是代码中最慢的部分，我可以看到基本上是很多小矩阵乘法。你正在将它们作为每个元素的点产品来做，这肯定会比优化的BLAS库更有效，它可以有效地重用缓存。提高性能的最佳方法还是尝试仅使用大型矩阵乘法（组合某些维度）来编写代码，这也将增加使用线程BLAS库的实用性。这样你就可以获得更好的性能。