Question

在我的Fortran代码的主要部分中，我有这一行

Gmat=0
do i=1,indCompMax
do j=(i-1)*useSymFlag+1,nsit-(i-1)*useSymFlag 
l=1
do while (G0poles(l,2)/=0)
Gmat(i,j)=Gmat(i,j)+real(G0int(i,j,l))/(omega(k)-G0poles(l,1))**G0poles(l,3)
l=l+1
enddo
enddo
enddo
call ExtendBySymmetry(Gmat)

这部分在代码中重复多次，所以我定义了这个子程序

!=============================================================================
SUBROUTINE EvaluateFunc(matrixPol,matrixInt,z,matrix)
      use NAGmodule
      integer i,j,k
      REAL*8, DIMENSION(Npoles,3) :: matrixPol
      COMPLEX*16, DIMENSION(nsit,nsit,Npoles) :: matrixInt
      COMPLEX*16, DIMENSION(nsit,nsit) :: matrix
      COMPLEX*16 :: z

  do i=1,indCompMax
     do j=(i-1)*useSymFlag+1,nsit-(i-1)*useSymFlag 
       k=1
       do while (matrixPol(k,2)/=0)
         matrix(i,j)=matrix(i,j)+real(matrixInt(i,j,k))/(z-matrixPol(k,1))**matrixPol(k,3)
         k=k+1
       enddo
     enddo
  enddo
  call ExtendBySymmetry(matrix)

end

问题在于，如果我使用这个子程序，输出矩阵的评估比同一个评估需要更长的时间（大约慢5倍），但直接在代码的主要部分进行。如何优化代码并使子程序更快地进行评估？

更新：感谢您的回复。首先，操作**matrixPol(k,3)也存在于主代码中，我忘了把它写在帖子中。

对于比较(matrixPol(k,2)/=0)没有问题，因为实际上从向量的某个位置开始，所有元素都正好为零。

计算i,j循环之外的前因子有助于加快子程序。并且切换两个指数i和j实际上没有效果。以下是子程序的运行时间

所有主要部分 1.688s

我的旧子程序 19.063s

在循环i，j之外的factor

5.193s

切换索引i和j 5.281s

使用dot_product 4.958s

但子程序仍然慢了2.5倍。

这是一个最小的例子：

    module  NAGmodule
    implicit none
    real*8,     allocatable :: hmat(:,:),eval(:),eigmat(:,:)
    real*8,     allocatable :: G0poles(:,:)
    complex*16, allocatable :: G0int(:,:,:)
    complex*16, allocatable :: Gmat(:,:)
    real*8,     allocatable :: omega(:)
    integer                 :: numpoles, halffillingflag, iter, indCompMax
    complex*16              :: omegaComplex
    real*8,  parameter      :: pi=3.141592653589793
    integer, parameter      :: out_unit=10
    integer, parameter      :: timeFag=1
    integer                 :: counti, countf, count_rate
    real                    :: dt
    integer, parameter :: Npoles=1000
    real*8, parameter  :: U=4
    real*8, parameter  :: omegamin=-20
    real*8, parameter  :: omegamax=20
    integer, parameter :: Nomega=1500000
    integer, parameter :: nsit = 4
    integer, parameter :: nup = 1
    integer, parameter :: ndw = 1
    integer, parameter :: PBCflag=1
    integer, parameter :: useSymFlag=1
    end module NAGmodule

    use nagmodule
    integer                 :: i,j,k,l,m,n,p,q
    REAL*8 t1,t2

    allocate(hmat(nsit,nsit),eigmat(nsit,nsit),eval(nsit))
    allocate(G0poles(Npoles,3),G0int(nsit,nsit,Npoles))
    allocate(omega(Nomega))
    allocate(Gmat(nsit,nsit))

    indCompMax=1

    hmat=0.
    do i=1,(nsit-1)
      hmat(i,i+1)=-1
      hmat(i+1,i)=-1
    enddo
    if (PBCflag==1) then
       hmat(1,nsit)=-1
       hmat(nsit,1)=-1
    end if

    call NAGdiag(nsit)
    eigmat=hmat

    do k=1,Nomega
      omega(k)=(omegamax-omegamin)/(Nomega-1)*(k-1)+omegamin
    enddo

    do k=1,nup
      G0poles(k,1)=eval(k) 
      G0poles(k,2)=-1
      G0poles(k,3)=1
    enddo
    do k=(nup+1),nsit
      G0poles(k,1)=eval(k)
      G0poles(k,2)=1
      G0poles(k,3)=1
    enddo


      do k=1,nsit
        G0int(k,k,k)=1
        if ((k==nup).AND.(abs(eval(k)-eval(k+1))<1e-15)) then
          G0int(k,k,k)=0.5
          G0int(k+1,k+1,k)=0.5
        else if ((k==nup+1).AND.(abs(eval(k)-eval(k-1))<1e-15)) then
          G0int(k,k,k)=0.5
          G0int(k-1,k-1,k)=0.5
        end if
      enddo

    do k=1,nsit
     G0int(:,:,k)=matmul(eigmat,matmul(G0int(:,:,k),transpose(eigmat)))
    enddo


    t1=0
    t2=0


    do k=1,Nomega
     omegaComplex=CMPLX(omega(k),0)
     call system_clock(counti,count_rate)
     Gmat=0
     call EvaluateFunc3(G0poles,G0int,omegaComplex,Gmat)
     call system_clock(countf)
     dt=REAL(countf-counti)/REAL(count_rate)
     t1=t1+dt

    call system_clock(counti,count_rate)
      Gmat=0
      do i=1,indCompMax
         do j=(i-1)*useSymFlag+1,nsit-(i-1)*useSymFlag 
           l=1
           do while (G0poles(l,2)/=0)
             Gmat(i,j)=Gmat(i,j)+real(G0int(i,j,l))/(omega(k)-G0poles(l,1))
             l=l+1
          enddo
         enddo
      enddo
      call ExtendBySymmetry(Gmat)
     call system_clock(countf)
     dt=REAL(countf-counti)/REAL(count_rate)
     t2=t2+dt
    enddo

   write(*,*)'time with subroutine',t1
   write(*,*)'time main',t2


    stop
    end

    !=================================================================================
    SUBROUTINE EvaluateFunc3(matrixPol,matrixInt,z,matrix)
          use NAGmodule
          integer i,j,k
          REAL*8, DIMENSION(Npoles,3) :: matrixPol
          COMPLEX*16, DIMENSION(nsit,nsit,Npoles) :: matrixInt
          COMPLEX*16, DIMENSION(nsit,nsit) :: matrix
          COMPLEX*16 :: z
          integer :: maxPoles
          COMPLEX*16, DIMENSION(Npoles) :: factor


    maxPoles=0
    do while (matrixPol(maxPoles+1,2)/=0)
    maxPoles=maxPoles+1
    enddo 

      factor(:maxPoles) = (1.,0.)/(z-matrixPol(:maxPoles,1))**matrixPol(:maxPoles,3)

      do j=1,indCompMax  
         do i=(j-1)*useSymFlag+1,nsit-(j-1)*useSymFlag
             matrix(i,j)=matrix(i,j)+dot_product(matrixInt(i,j,1:maxPoles),factor(1:maxPoles))
         enddo
      enddo
      call ExtendBySymmetry2(matrix)

    end

    !=================================================================================
    SUBROUTINE ExtendBySymmetry2(matrix)
          use NAGmodule
          COMPLEX*16, DIMENSION(nsit,nsit) :: matrix
          integer k,i,j,l,m


    if ((PBCflag==1).AND.(useSymFlag==1)) then
          do i=2,nsit
            matrix(2:nsit,i)=matrix(1:nsit-1,i-1)
            matrix(1,i)=matrix(nsit,i-1)
          enddo
    else if ((PBCflag==0).AND.(useSymFlag==1)) then
          do j=1,nsit/2
            do i=j,nsit-j+1
              matrix(j,i)=matrix(i,j)
              matrix(nsit-i+1,nsit-j+1)=matrix(i,j)
             matrix(nsit-j+1,nsit-i+1)=matrix(i,j)
            enddo
          enddo
    end if

    end

    !=================================================================================
    SUBROUTINE ExtendBySymmetry(matrix)
          use NAGmodule
          COMPLEX*16, DIMENSION(nsit,nsit) :: matrix
          integer k,i,j,l,m


    if ((PBCflag==1).AND.(useSymFlag==1)) then
          do i=2,nsit
            matrix(i,2:nsit)=matrix(i-1,1:nsit-1)
            matrix(i,1)=matrix(i-1,nsit)
          enddo
    else if ((PBCflag==0).AND.(useSymFlag==1)) then
          do i=1,nsit/2
            do j=i,nsit-i+1
              matrix(j,i)=matrix(i,j)
              matrix(nsit-i+1,nsit-j+1)=matrix(i,j)
              matrix(nsit-j+1,nsit-i+1)=matrix(i,j)
            enddo
          enddo
    end if

    end


    !=================================================================================

          SUBROUTINE NAGdiag(nsit1)
          use NAGmodule

          real*8,  allocatable :: WORK(:)
          integer, allocatable :: IWORK(:)  

          CHARACTER JOB, UPLO
          EXTERNAL dsyevd
          NMAX=nsit1
          LDA=NMAX
          LWORK=4*NMAX*NMAX+100
          LIWORK=5*NMAX
          LIWORK=10*NMAX      
          ALLOCATE(WORK(LWORK),IWORK(LIWORK))

          JOB='V'    
          UPLO='L' 

          CALL dsyevd(JOB,UPLO,nsit1,hmat,LDA,eval,WORK,LWORK,IWORK,LIWORK,INFO)

          IF (INFO.GT.0) THEN
          WRITE (*,*) 'Failure to converge.'
          stop
         endif

          deALLOCATE(WORK,IWORK)

          return
          end`

Answer 1

由于原始问题的几处编辑，现在答案部分是多余的。但是，优化部分仍然有效。

代码的真正问题在于，您将z作为复数传递给子例程（omegaComplex），而omega(k)是真实的。这导致取幂和除法作为复杂操作而不是实际操作来执行。

将z固定为真实（以及优化中的factor）会导致预期的结果。通过优化，我得到了：

 time with subroutine  0.24000001139938831     
 time main  0.35700001695659012

原始答案：

首先，子例程不执行与内联代码相同的操作。操作**matrixPol(k,3)是一个涉及大量计算工作的复数的幂。难怪子程序要慢得多。

我看到了一些加速代码的可能性：

除数(z-matrixPol(k,1))**matrixPol(k,3)独立于i和j，可以从循环中取出。
分割比乘法更昂贵。因此，您应该在循环外预先计算factor = 1/div，并在循环中与factor相乘。
除非您将相应的值设置为零，否则比较(matrixPol(k,2)/=0)几乎永远不会成立。在你调用子程序之前我假设你知道极点的顺序，那么为什么不把它传递给自己保存这个比较呢？如果无法做到这一点，请确定主循环前子程序内的极数。然后，k上的内环更加简单。
在循环内部，您将输入矩阵一次又一次地转换为real。这可以在循环外一次完成。或者，更好的是，只将实际部分传递给函数！

此时，您的代码看起来像：

!=============================================================================
SUBROUTINE EvaluateFunc(matrixPol,matrixInt,z,matrix)
      use NAGmodule
      integer i,j,k
      REAL*8, DIMENSION(Npoles,3) :: matrixPol
      COMPLEX*16, DIMENSION(nsit,nsit,Npoles) :: matrixInt
      COMPLEX*16, DIMENSION(nsit,nsit) :: matrix
      COMPLEX*16 :: z, factor(Npoles)
      REAL*8, DIMENSION(nsit,nsit,Npoles) :: matrixInt_re
      integer :: maxPoles

  ! Determine maximum number of poles
  do k=1,Npoles
    ! Only valid if the poles are set to exactly zero outside. If not, 
    ! use ( abs(matrixPol(k,2)) <= someEpsilon ) 
    if ( matrixPol(k,2) == 0 ) then
      maxPoles = k-1
      exit
    endif
  enddo

  ! Pre-compute factors
  factor(:maxPoles) = (1.,0.)/(z-matrixPol(:maxPoles,1))**matrixPol(:maxPoles,3)
  ! Convert input to real
  matrixInt_re = real(matrixInt)

  do i=1,indCompMax
     do j=i,nsit-i+1 
       do k=1,maxPoles
         matrix(i,j)=matrix(i,j)+matrixInt_re(i,j,k)*factor(k)
       enddo
     enddo
  enddo
  call ExtendBySymmetry(Gmat)    
end

进一步优化：

重写这样的代码很明显，k上的内部循环只不过是一个点积。这可能会被编译器加速。主循环看起来像：

  do i=1,indCompMax
     do j=i,nsit-i+1 
       matrix(i,j)=matrix(i,j) + &
         dot_product( matrixInt_re(i,j,:maxPoles), factor(:maxPoles) )
     enddo
  enddo

正如chw21所指出的那样，Fortran使用column major内存布局，您正在以主要的方式访问它。这可能会给你带来很多记忆。您应该考虑在主程序中转置数组，或者至少在i和j上切换循环。我更喜欢第一个选项，因为内点产品将在连续的内存块上执行。

Answer 2

尝试看看你是否可以交换循环。由于Fortran按顺序存储数组

(1, 1), (2, 1), (3, 1), ..., (n, 1), (1, 2), (2, 2), ...

如果沿着该维度循环，内存访问速度会快得多。

更快地制作子程序

2 个答案: