subroutine handle_local_worker_requests_group(ctx, fragment_queue, group_fragment_ids, group_polymers, &
worker_fragment_map, local_finished_workers)
!! Handle a single pending local worker request for a group shard, if any.
use mqc_many_body_expansion, only: many_body_expansion_t
class(many_body_expansion_t), intent(in) :: ctx
type(queue_t), intent(inout) :: fragment_queue
integer(int64), intent(in) :: group_fragment_ids(:)
integer, intent(in) :: group_polymers(:, :)
integer(int64), intent(inout) :: worker_fragment_map(:)
integer, intent(inout) :: local_finished_workers
integer(int64) :: local_idx, fragment_idx
integer(int32) :: local_dummy
type(MPI_Status) :: local_status
logical :: has_pending, has_fragment
type(request_t) :: req
call iprobe(ctx%resources%mpi_comms%node_comm, MPI_ANY_SOURCE, TAG_WORKER_REQUEST, has_pending, local_status)
if (.not. has_pending) return
if (worker_fragment_map(local_status%MPI_SOURCE) /= 0) return
call irecv(ctx%resources%mpi_comms%node_comm, local_dummy, local_status%MPI_SOURCE, TAG_WORKER_REQUEST, req)
call wait(req)
call queue_pop(fragment_queue, local_idx, has_fragment)
if (has_fragment) then
fragment_idx = group_fragment_ids(local_idx)
call send_fragment_payload_from_row(ctx%resources%mpi_comms%node_comm, TAG_WORKER_FRAGMENT, fragment_idx, &
group_polymers(local_idx, :), local_status%MPI_SOURCE)
worker_fragment_map(local_status%MPI_SOURCE) = fragment_idx
else
call isend(ctx%resources%mpi_comms%node_comm, -1, local_status%MPI_SOURCE, TAG_WORKER_FINISH, req)
call wait(req)
local_finished_workers = local_finished_workers + 1
end if
end subroutine handle_local_worker_requests_group