Handle a single pending node coordinator request, if any.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(mbe_context_t), | intent(in) | :: | ctx | |||
| type(queue_t), | intent(inout) | :: | fragment_queue | |||
| integer, | intent(inout) | :: | finished_nodes |
| Type | Visibility | Attributes | Name | Initial | |||
|---|---|---|---|---|---|---|---|
| integer, | private | :: | dummy_msg | ||||
| integer(kind=int64), | private | :: | fragment_idx | ||||
| logical, | private | :: | has_fragment | ||||
| logical, | private | :: | has_pending | ||||
| type(request_t), | private | :: | req | ||||
| integer, | private | :: | request_source | ||||
| type(MPI_Status), | private | :: | status |
subroutine handle_node_requests(ctx, fragment_queue, finished_nodes) !! Handle a single pending node coordinator request, if any. use mqc_many_body_expansion, only: mbe_context_t type(mbe_context_t), intent(in) :: ctx type(queue_t), intent(inout) :: fragment_queue integer, intent(inout) :: finished_nodes integer :: request_source, dummy_msg integer(int64) :: fragment_idx type(MPI_Status) :: status logical :: has_pending, has_fragment type(request_t) :: req call iprobe(ctx%resources%mpi_comms%world_comm, MPI_ANY_SOURCE, TAG_NODE_REQUEST, has_pending, status) if (.not. has_pending) return call irecv(ctx%resources%mpi_comms%world_comm, dummy_msg, status%MPI_SOURCE, TAG_NODE_REQUEST, req) call wait(req) request_source = status%MPI_SOURCE call queue_pop(fragment_queue, fragment_idx, has_fragment) if (has_fragment) then call send_fragment_to_node(ctx%resources%mpi_comms%world_comm, fragment_idx, ctx%polymers, request_source) else call isend(ctx%resources%mpi_comms%world_comm, -1, request_source, TAG_NODE_FINISH, req) call wait(req) finished_nodes = finished_nodes + 1 end if end subroutine handle_node_requests