Clever/fast way of array multiplication and summation - arrays

Question

I have to solve a double integral
in my program, that can be translated into the i-,j- loops in the following minimum working example:
program test
implicit none
integer :: i, j, n
double precision, allocatable :: y(:), res(:), C(:,:,:)
n=200
allocate(y(n), res(n), C(n,n,n))
call random_number(y)
call random_number(C)
res = 0.d0
do i=1, n
do j=1, n
res(:) = res(:) + y(i) * y(j) * C(:, j, i)
end do
end do
deallocate(y, res, C)
end program test
I have to solve this integral multiple times per execution and profiling tells me that it's the bottle neck of my calculation consuming more than 95 % of the execution time.
I was wondering whether there's any possibility to solve this in a more clever, i.e., fast way and maybe get rid of one or both of the loops.
My question is not to optimize the code with compiler flags or parallelization, but whether the double loop is the best practice to tackle the given problem. Usually loops are slow and I try to avoid them. I was thinking that it might be possible to avoid the loops by reshaping or spreading the arrays. But I just don't see it.

Answer 1

If you write the double loop in Matrix notation,y(i)*y(j) becomes the diadic YY^t, with Y being a n x 1 matrix. With this you can re-write the loop to (pseudo-code)
do n=1,size(C,1)
res(n) = sum( YY^t * C_n )
enddo
where C_n = C(n,:,:) and * is an element-wise multiplication. Apart from the element-wise calculation you already did, this leaves you two additional ways of calculating the results:
res(n) = sum( (YY^t) * C_n )
res(n) = sum( Y * (Y^t C_n) )
In both cases, it is beneficial to have contiguous data and re-order the array C:
do i=1,n
C2(:,:,i) = C(i,:,:)
enddo !i
The number of floating point operations is the same with both approaches and slightly less than in the original approach. So let's measure the time for all of them...
Here are the implementations using LAPACK for the matrix operations (and using dot products where applicable):
1. sum( (YY^t) * C_n )
call system_clock(iTime1)
call dgemm('N','N',n,n,1,1.d0,y,n,y,1,0.d0,mat,n)
nn=n*n
do i=1,n
res(i) = ddot( nn, mat, 1, C2(:,:,i), 1 )
enddo !i
2. sum( Y * (Y^t C_n) )
do i=1,n
call dgemm('N','N',1,n,n,1.d0,y,1,C2(:,:,i),n,0.d0,vec,1)
res(i) = ddot( n, y, 1, vec, 1 )
enddo !i
The outcome is as follows:
Orig: 0.111000001
sum((YY^t)C): 0.116999999
sum(Y(Y^tC)): 0.187000006
Your original implementation is the fastest! Why? Most probably due to the ideal usage of the cache on the CPU. Fortran compilers typically are very smart in optimizing loops, and in the element-wise calculation, you simply add and scale vectors, without any matrix operation. This can be utilized very efficiently.
So, is there room for improvement? Certainly :) The operation you are performing inside the loop is commonly known as axpy: y = a*x + y. This is a commonly used BLAS subroutine - usually highly optimized.
Utilizing this leads to
res = 0.d0
do i=1, n
do j=1, n
call daxpy(n, y(i)*y(j), C(:,j,i), 1, res, 1)
end do
end do
and takes
Orig (DAXPY): 0.101000004
Which is roughly 10% faster.
Here is the complete code, all measurements have been performed with OpenBLAS and with n=500 (to better see the impact)
program test
implicit none
integer :: i, j, n, nn
double precision, allocatable, target :: y(:), res(:), resC(:), C(:,:,:), C2(:,:,:), mat(:,:), vec(:)
integer :: count_rate, iTime1, iTime2
double precision :: ddot
n=500
allocate(y(n), res(n), resC(n), C(n,n,n), C2(n,n,n), mat(n,n), vec(n))
call random_number(y)
call random_number(C)
! Get the count rate
call system_clock(count_rate=count_rate)
! Original Aproach
call system_clock(iTime1)
res = 0.d0
do i=1, n
do j=1, n
res(:) = res(:) + y(i) * y(j) * C(:, j, i)
end do
end do
call system_clock(iTime2)
print *,'Orig: ',real(iTime2-iTime1)/real(count_rate)
! Original Aproach, DAXPY
call system_clock(iTime1)
resC = 0.d0
do i=1, n
do j=1, n
call daxpy(n, y(i)*y(j), C(:,j,i), 1, resC, 1)
end do
end do
call system_clock(iTime2)
print *,'Orig (DAXPY): ',real(iTime2-iTime1)/real(count_rate)
! print *,maxval( abs(resC-res) )
! Re-order
do i=1,n
C2(:,:,i) = C(i,:,:)
enddo !i
! sum((YY^t)C)
call system_clock(iTime1)
call dgemm('N','N',n,n,1,1.d0,y,n,y,1,0.d0,mat,n)
nn=n*n
do i=1,n
resC(i) = ddot( nn, mat, 1, C2(:,:,i), 1 )
enddo !i
call system_clock(iTime2)
print *,'sum((YY^t)C): ',real(iTime2-iTime1)/real(count_rate)
! print *,maxval( abs(resC-res) )
! sum(Y(Y^tC))
call system_clock(iTime1)
do i=1,n
call dgemm('N','N',1,n,n,1.d0,y,1,C2(:,:,i),n,0.d0,vec,1)
resC(i) = ddot( n, y, 1, vec, 1 )
enddo !i
call system_clock(iTime2)
print *,'sum(Y(Y^tC)): ',real(iTime2-iTime1)/real(count_rate)
! print *,maxval( abs(resC-res) )
end program test