I'm currently trying to convert the following mpi_send/recv calls into one mpi_scatterv, because I'm experiencing a pretty significant performance hit by copying my array into a temporary buffer and sending that temp buffer. It's still worth it over the equivalent serial implementation, but I was hoping to distribute work without having to copy to a temp buffer. It appears that mpi_scatterv is the function that I want, but my various attempts at implementation haven't worked and have been mostly confused.
The code that does the mpi_send/recv calls is below:
if(me_image.eq.root_image) then
do i = 0, max_proc-1, 1
allocate(temp_dCpqdR(3*nat_sl, 3*nat_sl, n_pairs(i+1), 3))
do j = 1, n_pairs(i+1), 1
temp_dCpqdR(:,:,j,:) = dCpqdR(:,:,j+offset,:)
end do
offset = offset + n_pairs(i+1)
if(i.ne.0) then
call mpi_send(temp_dCpqdR, 3*nat_sl*3*nat_sl*3*n_pairs(i+1), mpi_double_precision,&
i, 0, intra_image_comm,ierr)
call mpi_send(Cpq, 3*nat_sl*3*nat_sl, mpi_double_precision,&
i, 1, intra_image_comm,ierr)
call mpi_send(eigenvalues, 3*nat_sl, mpi_double_precision,&
i, 2, intra_image_comm,ierr)
else
my_dCpqdR(:,:,:,:) = temp_dCpqdR(:,:,:,:)
end if
deallocate(temp_dCpqdR)
end do
else
if(me_image.le.(max_proc-1)) then
call mpi_recv(my_dCpqdR,& ! Buffer
3*nat_sl*3*nat_sl*3*n_pairs(me_image+1),& ! Count
mpi_double_precision,& ! Type
0,& ! Source
0,& ! Tag
intra_image_comm,& ! Communicator
rstatus,& ! Status var
ierr) ! Error flag
call mpi_recv(Cpq,& ! Buffer
3*nat_sl*3*nat_sl,& ! Count
mpi_double_precision,& ! Type
0,& ! Source
1,& ! Tag
intra_image_comm,& ! Communicator
rstatus,& ! Status var
ierr) ! Error flag
call mpi_recv(eigenvalues,& ! Buffer
3*nat_sl,& ! Count
mpi_double_precision,& ! Type
0,& ! Source
2,& ! Tag
intra_image_comm,& ! Communicator
rstatus,& ! Status var
ierr) ! Error flag
end if
end if
I have tried to translate the above code into scatterv calls myself, but I'm not sure how to do it. I think I need to have lines like:
call mpi_type_create_subarray(4, (/ nat_sl, nat_sl, nat, 3 /), (/nat_sl, nat_sl, n_pairs(me_image+1), 3/),&
(/0, 0, 0, 0/), mpi_order_fortran, mpi_double_precision, subarr_typ, ierr)
call mpi_type_commit(subarr_typ, ierr)
And
call mpi_scatterv(dCpqdR, n_pairs(me_image+1), f_displs, subarr_typ,&
my_dCpqdR, 3*nat_sl*3*nat_sl*3*n_pairs(me_image+1), subarr_typ,&
root_image, intra_image_comm, ierr)
I've read that I need to set extents so I implemented them like this:
extent = 3*nat_sl*3*nat_sl*3*n_pairs(me_image+1)
call MPI_Type_create_resized(subarr_typ, 0, extent, resized_subarr, ierr)
call MPI_Type_commit(resized_subarr, ierr)
But this gives me quite a few errors, including
[MathBook Pro:58100] *** An error occurred in MPI_Type_create_subarray
[MathBook Pro:58100] *** reported by process [2560884737,2314885530279477248]
[MathBook Pro:58100] *** on communicator MPI_COMM_WORLD
[MathBook Pro:58100] *** MPI_ERR_ARG: invalid argument of some other kind
[MathBook Pro:58100] *** MPI_ERRORS_ARE_FATAL (processes in this communicator will now abort,
[MathBook Pro:58100] *** and potentially your MPI job)
Anyway, I'm confident that the error is in the way that I'm handling the memory layout, though. Please let me know if you need any more information from me, and I look forward to any suggestions you all have.
