subroutine gmbe_group_global_coordinator(resources, node_leader_ranks, group_ids)
use mqc_resources, only: resources_t
type(resources_t), intent(in) :: resources
integer, intent(in) :: node_leader_ranks(:)
integer, intent(in) :: group_ids(:)
integer(int64), allocatable :: group_term_ids(:)
integer, allocatable :: group_atom_sets(:, :)
type(queue_t) :: group_queue
integer(int64), allocatable :: temp_ids(:)
integer(int64) :: idx
integer(int32) :: batch_count
integer(int64), allocatable :: batch_ids(:)
type(calculation_result_t), allocatable :: batch_results(:)
integer(int64) :: results_received
integer(int64) :: total_group_terms
integer(int64) :: worker_term_map(resources%mpi_comms%node_comm%size())
integer :: finished_nodes
integer :: local_finished_workers
integer :: local_node_done
integer :: group_id
integer :: group_node_count
integer :: i
type(request_t) :: req
group_id = 1
do i = 1, size(node_leader_ranks)
if (node_leader_ranks(i) == resources%mpi_comms%world_comm%rank()) then
group_id = group_ids(i)
exit
end if
end do
group_node_count = count(group_ids == group_id)
call receive_group_assignment_matrix(resources%mpi_comms%world_comm, group_term_ids, group_atom_sets)
if (size(group_term_ids) > 0) then
! Queue stores local indices (1..N) into group_term_ids/group_atom_sets.
allocate (temp_ids(size(group_term_ids)))
do idx = 1_int64, size(group_term_ids, kind=int64)
temp_ids(idx) = idx
end do
call queue_init_from_list(group_queue, temp_ids)
deallocate (temp_ids)
else
group_queue%count = 0_int64
group_queue%head = 1_int64
end if
batch_count = 0
allocate (batch_ids(GROUP_RESULT_BATCH_SIZE))
allocate (batch_results(GROUP_RESULT_BATCH_SIZE))
results_received = 0_int64
total_group_terms = int(size(group_term_ids, kind=int64), int64)
worker_term_map = 0
finished_nodes = 0
local_finished_workers = 0
local_node_done = 0
do while (finished_nodes < group_node_count .or. results_received < total_group_terms)
call handle_local_worker_results_to_batch(resources%mpi_comms%node_comm, &
resources%mpi_comms%world_comm, &
worker_term_map, batch_count, batch_ids, batch_results, &
results_received)
call handle_node_results_to_batch(resources%mpi_comms%world_comm, batch_count, batch_ids, batch_results, &
results_received)
call handle_group_node_requests(resources, group_queue, group_term_ids, group_atom_sets, finished_nodes)
if (resources%mpi_comms%node_comm%size() > 1 .and. &
local_finished_workers < resources%mpi_comms%node_comm%size() - 1) then
call handle_local_worker_requests_group(resources, group_queue, group_term_ids, group_atom_sets, &
worker_term_map, local_finished_workers)
end if
if (local_node_done == 0) then
if (queue_is_empty(group_queue) .and. &
(resources%mpi_comms%node_comm%size() == 1 .or. &
local_finished_workers >= resources%mpi_comms%node_comm%size() - 1)) then
local_node_done = 1
finished_nodes = finished_nodes + 1
end if
end if
if (batch_count >= GROUP_RESULT_BATCH_SIZE) then
call flush_group_results(resources%mpi_comms%world_comm, batch_count, batch_ids, batch_results)
end if
end do
call flush_group_results(resources%mpi_comms%world_comm, batch_count, batch_ids, batch_results)
call isend(resources%mpi_comms%world_comm, 0, 0, TAG_GROUP_DONE, req)
call wait(req)
deallocate (group_term_ids)
deallocate (group_atom_sets)
deallocate (batch_ids)
deallocate (batch_results)
end subroutine gmbe_group_global_coordinator