matrix multiplication in fortran using mpi and mkl - fortran

Question

The problem I am having is mainly related to MPI. I have developed the code to multiply two matrices using mpi and mkl in fortran. It is giving the correct output but the issue is that if I increase the numberof processors for the calculation then the time taken to calcualte gets increase as well, i.e. it takes 36 seconds to multiply matrices using 4 processors but it takes 58 seconds for 5 processors. And I have come to know that processor with rank 1 takes more time than others inspit of the weight is almost same for all the processors. i.e. if NP=4 then rank=1 takes same amount of time(Screenshot), others are taking but for NP=5, rank=1 is taking more time than others(Screenshot).
use mkl_service
include 'mpif.h'
! variables
!------mpi initialization---!
!----someoperation---!
if(rank.eq.root)then
! some task then
do i=1,nworkers-1
call mpi_send(nobsvld, 1, mpi_int, i, 3, mpi_comm_world, ierr)
end do
! multiplication routine called
call matrixMultiply(dble(p), dble(htra), phtra, nsea, nsea, nobsvld, nworkers, mpi_comm_world, rank, mpi_int, mpi_real8)
call matrixMultiply(dble(hvld), phtra, hphtra, nobsvld, nsea, nobsvld, nworkers, mpi_comm_world, rank, mpi_int, mpi_real8)
! some task then
call matrixMultiply(gmm, inovvld, gain, nobsvld, nobsvld, 1, nworkers, mpi_comm_world, rank, mpi_int, mpi_real8)
call matrixMultiply(phtra, gain, gainres, nsea, nobsvld, 1, nworkers, mpi_comm_world, rank, mpi_int, mpi_real8)
! some task then
else
!---Worker---!
call mpi_recv(nobsvld, 1, mpi_int, 0, 3, mpi_comm_world, stats, ierr)
call recv_cal_send(nsea, nsea, nobsvld, mpi_comm_world, mpi_int, mpi_real8,rank)
call recv_cal_send(nobsvld, nsea, nobsvld, mpi_comm_world, mpi_int, mpi_real8,rank)
call recv_cal_send(nobsvld, nobsvld, 1, mpi_comm_world, mpi_int, mpi_real8,rank)
call recv_cal_send(nsea, nobsvld, 1, mpi_comm_world, mpi_int, mpi_real8,rank)
end if
call mpi_finalize(ierr)
end program
!-------------------------------------routines-----------------------------------!
!-------------------routine for root to send as well as calculate some of the portion and receive from workers--------------------!
subroutine matrixMultiply(A, B, C, ax, ay, by, n, comm, rank, dt_int, dt_real)
integer :: ax, ay, by, rows, averows, extra, e_row, offset, source, ierr
integer, dimension(5) :: stats !mpi_status_size==5
real*8 :: A(ax,ay), B(ay,by), C(ax,by)
real*8, allocatable :: A_buff(:,:), C_buff(:,:)
!-------------------------------------send portions to workers-------------------------------------!
offset=1
averows=ax/n
extra=modulo(ax,n)
if(extra.gt.0)then
offset=offset+averows+1
else
offset=offset+averows
end if
do i=1,n-1
if(extra.gt.i)then
rows=averows+1
else
rows=averows
end if
e_row = offset+rows-1
call mpi_send(rows, 1, dt_int, i, i, comm, ierr)
call mpi_send(offset, 1, dt_int, i, i, comm, ierr)
call mpi_send(B, ay*by, dt_real, i, i, comm, ierr)
!call cpu_time(s1)
allocate(A_buff(rows,ay))
A_buff(1:rows,1:ay)=A(offset:e_row,1:ay)
call mpi_send(A_buff, rows*ay, dt_real, i, i, comm, ierr)
!call cpu_time(s2)
!print*,s2-s1," to send to",i
offset=offset+rows
deallocate(A_buff)
end do
!-------------------------------------calculate the portion of itself-------------------------------------!
if(extra.gt.0)then
rows=averows+1
else
rows=averows
end if
allocate(A_buff(rows, ay))
A_buff(1:rows,1:ay)=A(1:rows,1:ay)
allocate(C_buff(rows,by))
call cpu_time(c1)
call dgemm('N','N', rows, by, ay, 1.d0, A_buff, rows, B, ay, 0.d0, C_buff, rows)
call cpu_time(c2)
print*,c2-c1," for calculation by root"
deallocate(A_buff)
C(1:rows,1:by)=C_buff(1:rows,1:by)
deallocate(C_buff)
!-------------------------------------receive calculated portions from workers -------------------------------------!
do i=1,n-1
source=i
call mpi_recv(rows, 1, dt_int, source, source, comm, stats, ierr)
call mpi_recv(offset, 1, dt_int, source, source, comm, stats, ierr)
e_row = offset+rows-1
allocate(C_buff(rows,by))
call mpi_recv(C_buff, rows*by, dt_real, source, source, comm, stats, ierr)
C(offset:e_row,1:by)=C_buff(1:rows,1:by)
deallocate(C_buff)
end do
end subroutine
!---------routine to receive portion from root to calculate and send back----------!
subroutine recv_cal_send(ax, ay, by, comm, dt_int, dt_real,rank)
integer :: comm, rank, dt_int, dt_real, ierr, offset
integer :: source, ax, ay, bx, by, cy, rows
integer, dimension(5) :: stats !mpi_status_size==5
real*8, dimension(ay,by) :: B
real*8, allocatable :: A_buffer(:,:)
real*8, allocatable :: buff(:,:)
bx=ay
cy=by
source = 0
call mpi_recv(rows, 1, dt_int, source, rank, comm, stats, ierr)
call mpi_recv(offset, 1, dt_int, source, rank, comm, stats, ierr)
call mpi_recv(B, bx*by, dt_real, source, rank, comm, stats, ierr)
allocate(A_buffer(rows,ay))
call mpi_recv(A_buffer, rows*ay, dt_real, source, rank, comm, stats, ierr)
allocate(buff(rows,cy))
call cpu_time(c1)
call dgemm('N','N', rows, by, bx , 1.d0, A_buffer, rows, B, bx, 0.d0, buff, rows)
call cpu_time(c2)
print*,c2-c1," for calculation by",rank
deallocate(A_buffer)
!call cpu_time(s1)
call mpi_send(rows, 1, dt_int, 0, rank, comm, ierr)
call mpi_send(offset, 1, dt_int, 0, rank, comm, ierr)
call mpi_send(buff, rows*cy,dt_real, 0, rank, comm, ierr)
!call cpu_time(s2)
!print*,s2-s1," cal sent by",rank
deallocate(buff)
end subroutine

Answer 1

(Note lacking a complete example program I'm having to make a few assumptions about what is going on here - should a full example be provided I will modify as appropriate. Note also there may be an issue with the number of real cores you have in your system, but as I understand it your solution his real problems that are independent of this)
I am afraid that the way you have written this is inherently non-scalable, and it's non-scalable in two different ways; it is not scalable in time and, worse to my mind, it is not scalable in memory. The former is the cause behind the poor performance you are observing, the latter means that using more processes will not allow you to solve bigger problems.
To try and understand what I mean by the former let's try and make a little model of the time taken by the solution above when running on P processes for NxN matrices. The time taken for the compute that performs the matrix multiplication will be proportional to N**3/P , which is a nicely decreasing function of time as P increases, good. But you also have to pass messages, and in particular you seem to send all of B from rank 0 to all the other processes. The time for this will, as the code is written, be proportional to P*N**2 (ignoring latency), which is an increasing function of time with P - the more processes you use, the slower the communication becomes. Thus the total time is a sum of the (decreasing) compute time with the (increasing) communication time - and for sufficiently large P this will tend to infinity, not zero; this is what I mean by inherently non-scalable in time. Now the problem you have in your case is the compute is quite quick, so at least for the N you are using it only requires quite modest P before the communication time dominates, and the time to solution will increase approximately linearly with the number of processes.
You can marginally improve this by using mpi_bcast (and mpi_gatherv for the final result). This will change the communication time to Log(P)*N**2, but it's still increasing, and so the algorithm is still inherently non-scalable. And more generally my experience is that these master-slave algorithms are rarely worth investigating at all if you want performance - only if the compute is ferociously expensive do they have any worth.
The above could be helped if you increase N - this makes the compute time more expensive compared to the communication time and so you are more likely to see the decrease with P due to the former, than the increase due to the latter at least to a larger value of P; at some point the communication time will always take over. But because you hold all the matrices on all processes you can't solve any bigger a problem on P processes than you can on 1. This is what I mean by inherently non-scalable in memory.
A good solution to this will address both problems, and if you really want a good solution both issues are coupled and must both be addressed - you must use a properly distributed memory solution if you want good parallel scaling in time. For matrix multiplication an example algorithm is Cannon's Algorithm which, in the spirit of the little model above, has compute time proportional to N**3/P and communication time to N**2/Sqrt(P) - note these are both decreasing functions of P, so the time to solution here tends to zero; this is a scalable algorithm in time. Further the memory use per processes is proportional to N**2/P, again a decreasing function of P, and so this algorithm is also scaling in memory. But you shouldn't write this yourself - a number of parallel libraries are available which implement these scalable algorithms for matrix multiplication, I use ScaLapack (see also parallel matrix multiplication using PBLAS) and MKL has a version of this library available; there are also free versions.
Edit:
A couple of other thoughts
You have made sure you are using single threaded BLAS calls?
If you are only interested in single node parallelism use a parallel BLAS call - you will get great performance for minimal investment of effort