MPI

These recipes use mpih_object from fundal_mpih_object (build FUNDAL with MPI=1 or an mpi FoBiS mode) and run on 2 ranks. They print from rank 0 only.

• One device per rank
• A global sum of device results
• Exchange a halo through host buffers

One device per rank

Initialize MPI and give each rank of a node its own device.

call mpih%initialize(do_mpi_init=.true., do_device_init=.true.)

call MPI_COMM_RANK(local_comm, local_rank, ierr)     ! local_comm: the ranks of this node (set by do_device_init)
mine = [mpih%myrank, local_rank, mydev]              ! dev_init chose mydev = mod(local_rank, devs_number)
allocate(table(3,0:mpih%procs_number-1))
call MPI_GATHER(mine, 3, MPI_INTEGER, table, 3, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (mpih%myrank == 0) then
   do p=0, mpih%procs_number - 1
      print '(A,I0,A,I0,A,I0)', 'rank ', table(1,p), ': local rank ', table(2,p), ', device ', table(3,p)
   enddo
endif

$ mpirun --oversubscribe -np 2 mpi devices
rank 0: local rank 0, device 0
rank 1: local rank 1, device 0

The documentation runs on the host, which is one device: both ranks get device 0. On a node with two GPUs the ranks get devices 0 and 1, mod(local_rank, devs_number).

WARNING

local_comm is set only by initialize(do_device_init=.true.). To forbid the host fallback on every rank, pass require_device=.true. to initialize: a rank without a device then stops.

A global sum of device results

Reduce on the device of each rank, then across the ranks with MPI.

local_sum = 0._R8P
!$acc parallel loop reduction(+:local_sum) DEVICEVAR(a_dev)
!$omp OMPLOOP reduction(+:local_sum) DEVICEPTR(a_dev)
do i=1, n
   a_dev(i) = real(offset + i, R8P)  ! the global numbers 1, 2, ..., n * procs
   local_sum = local_sum + a_dev(i)
enddo
call MPI_ALLREDUCE(local_sum, global_sum, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr)

$ mpirun --oversubscribe -np 2 mpi allreduce
global sum:   20100.0
equal to m (m+1) / 2, m = n procs: T

Exchange a halo through host buffers

Copy the boundary cells from the device, exchange them, copy the received values into the ghost cells (from tutorial chapter 6):

call dev_memcpy_from_device(dst=edge(1:1), src=t_dev(first:first)) ! device -> host buffer
call dev_memcpy_from_device(dst=edge(2:2), src=t_dev(last:last))
call MPI_SENDRECV(edge(2), 1, MPI_DOUBLE_PRECISION, right, 0, ghost(1), 1, MPI_DOUBLE_PRECISION, left,  0, &
                  MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
call MPI_SENDRECV(edge(1), 1, MPI_DOUBLE_PRECISION, left,  1, ghost(2), 1, MPI_DOUBLE_PRECISION, right, 1, &
                  MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
if (left  /= MPI_PROC_NULL) call dev_memcpy_to_device(dst=t_dev(first-1:first-1), src=ghost(1:1)) ! host -> device
if (right /= MPI_PROC_NULL) call dev_memcpy_to_device(dst=t_dev(last+1:last+1),   src=ghost(2:2))

WARNING

MPI_SENDRECV (or non-blocking calls) avoids the deadlock of two ranks that both call a blocking MPI_SEND first. Passing device pointers directly to MPI requires a GPU-aware MPI library.