5
\$\begingroup\$

I am implementing finite element code using MPI. Obviously, when using MPI I will have to include communication between different nodes so that all processors have all relevant information. As this is my first time doing something like this, I have implemented a very naive algorithm to get updated volume information for each element as shown below:

!loop over all of the processors
do n=0,numProcs-1
    !for each iteration of the loop, one processor will hand out relevant information
    if( my_id .eq. n ) then
        do i=0,numProcs-1
            if( i .ne. my_id ) then
                currProc=i
                !get the number of volumes processor i needs from processor n
                call MPI_RECV( numNeeded,1,MPI_INTEGER,i,my_id, & 
                               MPI_COMM_WORLD,status,ierr )

                !for each volume that processor i needs:
                do j=1,numNeeded
                    !get the element number
                    call MPI_RECV( currNeeded,1,MPI_INTEGER,i,j, &
                                   MPI_COMM_WORLD,status,ierr )
                    !return the volume of that element
                    call MPI_SEND( myElements(elementGlobalToLocal(currNeeded))%xsj,1, & 
                                   MPI_REAL8,i,j,MPI_COMM_WORLD,status,ierr )
                enddo
            endif
        enddo
    else
        !tell processor n how many volumes are needed from it, calculated elsewhere
        call MPI_SEND( numElementsNeeded(n+1),1,MPI_INTEGER,n,n, &
                       MPI_COMM_WORLD,status,ierr )

        !for each volume needed
        do j=1,numElementsNeeded(n+1)
            !send the element number, calculated elsewhere
            call MPI_SEND( elementsNeeded(n+1, j),1,MPI_INTEGER,n,j, & 
                           MPI_COMM_WORLD,status,ierr )
            !receive the appropriate volume
            call MPI_RECV( myExternalXsj(currReceived),1,MPI_REAL8,n,j, & 
                           MPI_COMM_WORLD,status,ierr )
            !global element numbering is 1-numTotElems
            !local numbering is 1-numElemsPerProc
            !elementGlobalToLocal keeps track of conversion from local to global
            elementGlobalToLocal(elementsNeeded(n+1, j))=currReceived
            currReceived=currReceived+1
        enddo
    endif
enddo

While this code does give the right results (i.e., all of the processors have all the information they need, and the values passed are the correct values), the performance is abysmal. Even when using -np 2, roughly 50% of the total time spent on volume calculations is spent doing this communication; when using -np 8 that comes up to a startling 94%. The major issue I see with the code above is that it doesn't scale very well; when process 0 is communicating to process 1, processes 2 and 3 are just hanging, which will cause a significant slowdown.

What would be a good way to address this? Also, are there any other major issues with the code that I am not seeing?

\$\endgroup\$
2
\$\begingroup\$

You are re-implementing an all-to-all. Why not use the all-to-all collective offered by MPI? It is potentially faster (and easier):

integer :: numElementsRequested(numProcs)

call MPI_Alltoall( numElementsNeeded, 1, MPI_INTEGER,    &
  &                numElementsRequested, 1, MPI_INTEGER, &
  &                MPI_COMM_WORLD, ierr                  )

Where numElementsNeeded states the number of elements the current process wants to get from all others, and after the call numElementsRequested would contain the number of elements all other processes are asking of this process. Note, that you can also use the in-place variant, if numElementsNeeded is not needed anymore after the exchange. After the number of elements to exchange with each process is known, you can go an and actually exchange them. If you can use a buffer for all exchanges, you can simply use an alltoallv:

integer :: totalRequested
integer :: sdispls(numProcs), rdispls(numProcs)

totalRequested = sum(numElementsRequested)
allocate( currneeded(totalRequested) )
allocate( volsneeded(totalRequested) )

sdispls(1) = 0
rdispls(1) = 0
do i=1,numProcs-1
  sdispls(i+1) = sdispls(i) + numElementsNeeded(i)
  rdispls(i+1) = rdispls(i) + numElementsRequested(i)
end do

call MPI_alltoallv( ElementsNeeded, numElementsNeeded, sdispls, MPI_INTEGER, &
  &                 currNeeded, numElementsRequested, rdispls, MPI_INTEGER,  &
  &                 MPI_COMM_WORLD, ierr                                     )

! Reversed communication direction, compared to the previous all-to-alls
call MPI_alltoallv( volsNeeded, numElementsRequested, rdispls, MPI_REAL8, &
  &                 myExternalXsj, numElementsNeeded, sdispls, MPI_REAL8, &
  &                 MPI_COMM_WORLD, ierr                                  )

Here, ElementsNeeded would also need to be a 1D array, with the corresponding entries. If you want to stick to the 2D array you would need to adapt the sdispls accordingly. When you do not want to spend that much memory for the buffers, you have to stick to something like you did above for the last two all-to-alls, but you can skip all processes you do not need to communicate with.

\$\endgroup\$
4
\$\begingroup\$

The answer was staring me right in the face, I just wasn't paying attention, apparently. Instead of sending one integer and one real*8 at a time, I should have been sending all of them at once, as:

do n=0,numProcs-1
    if( my_id .eq. n ) then
        do i=0,numProcs-1
            if( i .ne. my_id ) then
                currProc=i
                call MPI_RECV( numNeeded,1,MPI_INTEGER,i,my_id*2, & 
                               MPI_COMM_WORLD,status,ierr )

                allocate( currNeeded(numNeeded) )
                allocate( volsNeeded(numNeeded) )

                call MPI_RECV( currNeeded,numNeeded,MPI_INTEGER,currProc,my_id*2+1, & 
                               MPI_COMM_WORLD,status,ierr )

                do j=1,numNeeded
                    volsNeeded(j)=myElements(elementGlobalToLocal(currNeeded(j)))%xsj
                enddo

                call MPI_SEND( volsNeeded,numNeeded,MPI_REAL8,currProc,my_id, & 
                               MPI_COMM_WORLD,status,ierr )

                deallocate( currNeeded )
                deallocate( volsNeeded )
            endif
        enddo
    else
        call MPI_SEND( numElementsNeeded(n+1),1,MPI_INTEGER,n,n*2, & 
                       MPI_COMM_WORLD,status,ierr )

        call MPI_SEND( elementsNeeded(n+1, 1:numElementsNeeded(n+1)), & 
                       numElementsNeeded(n+1),MPI_INTEGER,n,n*2+1, & 
                       MPI_COMM_WORLD,status,ierr )

        call MPI_RECV( myExternalXsj(currReceived:currReceived+numElementsNeeded(n+1)), & 
                       numElementsNeeded(n+1),MPI_REAL8,n,n,MPI_COMM_WORLD,status,ierr )

        do j=1,numElementsNeeded(n+1)
            elementGlobalToLocal(elementsNeeded(n+1, j))=currReceived
            currReceived=currReceived+1
        enddo
    endif
enddo

Reducing the MPI call times drastically reduces the time spent in communication from (on 8 cores) roughly 269 seconds to roughly 13 seconds, a speedup by a factor of more than 20. This still doesn't change the problem of low scalability, though perhaps using non-blocking send/receive operations (with a barrier after the end of the loop to ensure all messages are received/sent) will do that.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.