subroutine run_multi_molecule_calculations(resources, mqc_config)
!! Run calculations for multiple molecules with MPI parallelization
!! Each molecule is independent, so assign one molecule per rank
use mqc_config_parser, only: mqc_config_t
use mqc_config_adapter, only: config_to_system_geometry
use mqc_error, only: error_t
use mqc_io_helpers, only: set_molecule_suffix, get_output_json_filename
use mqc_json, only: merge_multi_molecule_json
type(resources_t), intent(in) :: resources
type(mqc_config_t), intent(in) :: mqc_config
type(driver_config_t) :: config
type(system_geometry_t) :: sys_geom
type(resources_t) :: mol_resources
type(error_t) :: error
integer :: imol, my_rank, num_ranks, color
integer :: molecules_processed
character(len=:), allocatable :: mol_name
logical :: has_fragmented_molecules
character(len=256), allocatable :: individual_json_files(:)
my_rank = resources%mpi_comms%world_comm%rank()
num_ranks = resources%mpi_comms%world_comm%size()
! Allocate array to track individual JSON files for merging
allocate (individual_json_files(mqc_config%nmol))
! Check if any molecules have fragments (nlevel > 0)
has_fragmented_molecules = .false.
do imol = 1, mqc_config%nmol
if (mqc_config%molecules(imol)%nfrag > 0) then
has_fragmented_molecules = .true.
exit
end if
end do
if (my_rank == 0) then
call logger%info(" ")
call logger%info("============================================")
call logger%info("Multi-molecule mode: "//to_char(mqc_config%nmol)//" molecules")
call logger%info("MPI ranks: "//to_char(num_ranks))
if (has_fragmented_molecules) then
call logger%info("Mode: Sequential execution (fragmented molecules detected)")
call logger%info(" Each molecule will use all "//to_char(num_ranks)//" rank(s) for its calculation")
else if (num_ranks == 1) then
call logger%info("Mode: Sequential execution (single rank)")
else if (num_ranks > mqc_config%nmol) then
call logger%info("Mode: Parallel execution (one molecule per rank)")
call logger%info("Note: More ranks than molecules - ranks "//to_char(mqc_config%nmol)// &
" to "//to_char(num_ranks - 1)//" will be idle")
else
call logger%info("Mode: Parallel execution (one molecule per rank)")
end if
call logger%info("============================================")
call logger%info(" ")
end if
! Determine execution mode:
! 1. Sequential: Single rank OR fragmented molecules (each molecule needs all ranks)
! 2. Parallel: Multiple ranks AND unfragmented molecules (distribute molecules across ranks)
molecules_processed = 0
if (num_ranks == 1 .or. has_fragmented_molecules) then
! Sequential mode: process all molecules one after another
! Each molecule uses all available ranks for its calculation
do imol = 1, mqc_config%nmol
! Determine molecule name for logging
if (allocated(mqc_config%molecules(imol)%name)) then
mol_name = mqc_config%molecules(imol)%name
else
mol_name = "molecule_"//to_char(imol)
end if
if (my_rank == 0) then
call logger%info(" ")
call logger%info("--------------------------------------------")
call logger%info("Processing molecule "//to_char(imol)//"/"//to_char(mqc_config%nmol)//": "//mol_name)
call logger%info("--------------------------------------------")
end if
! Convert to driver configuration for this molecule
call config_to_driver(mqc_config, config, molecule_index=imol)
! Convert geometry for this molecule
call config_to_system_geometry(mqc_config, sys_geom, error, molecule_index=imol)
if (error%has_error()) then
call error%add_context("mqc_driver:run_multi_molecule_calculation")
if (my_rank == 0) then
call logger%error("Error converting geometry for "//mol_name//": "//error%get_full_trace())
end if
call abort_comm(resources%mpi_comms%world_comm, 1)
end if
! Set output filename suffix for this molecule
call set_molecule_suffix("_"//trim(mol_name))
! Run calculation for this molecule
call run_calculation(resources, config, sys_geom, mqc_config%molecules(imol)%bonds)
! Track the JSON filename for later merging
individual_json_files(imol) = get_output_json_filename()
! Clean up for this molecule
call sys_geom%destroy()
if (my_rank == 0) then
call logger%info("Completed molecule "//to_char(imol)//"/"//to_char(mqc_config%nmol)//": "//mol_name)
end if
molecules_processed = molecules_processed + 1
end do
else
! Multiple ranks: distribute molecules across ranks in round-robin fashion
molecules_processed = 0
do imol = 1, mqc_config%nmol
! This rank processes molecules where (imol - 1) mod num_ranks == my_rank
if (mod(imol - 1, num_ranks) == my_rank) then
! Determine molecule name for logging
if (allocated(mqc_config%molecules(imol)%name)) then
mol_name = mqc_config%molecules(imol)%name
else
mol_name = "molecule_"//to_char(imol)
end if
call logger%info(" ")
call logger%info("--------------------------------------------")
call logger%info("Rank "//to_char(my_rank)//": Processing molecule "//to_char(imol)// &
"/"//to_char(mqc_config%nmol)//": "//mol_name)
call logger%info("--------------------------------------------")
! Convert to driver configuration for this molecule
call config_to_driver(mqc_config, config, molecule_index=imol)
! Convert geometry for this molecule
call config_to_system_geometry(mqc_config, sys_geom, error, molecule_index=imol)
if (error%has_error()) then
call error%add_context("mqc_driver:run_multi_molecule_calculation")
call logger%error("Rank "//to_char(my_rank)//": Error converting geometry for "//mol_name//": "//error%get_full_trace())
call abort_comm(resources%mpi_comms%world_comm, 1)
end if
! Set output filename suffix for this molecule
call set_molecule_suffix("_"//trim(mol_name))
! Run calculation for this molecule (all ranks write JSON in parallel mode)
call run_calculation(resources, config, sys_geom, mqc_config%molecules(imol)%bonds, &
all_ranks_write_json=.true.)
! Track the JSON filename for later merging
individual_json_files(imol) = get_output_json_filename()
! Clean up for this molecule
call sys_geom%destroy()
call logger%info("Rank "//to_char(my_rank)//": Completed molecule "//to_char(imol)// &
"/"//to_char(mqc_config%nmol)//": "//mol_name)
molecules_processed = molecules_processed + 1
end if
end do
if (molecules_processed == 0) then
! Idle rank - no molecules assigned
call logger%verbose("Rank "//to_char(my_rank)//": No molecules assigned (idle)")
end if
end if
! Synchronize all ranks
call resources%mpi_comms%world_comm%barrier()
! In parallel execution, rank 0 needs to reconstruct all JSON filenames for merging
! since each rank only populated its own entry
if (my_rank == 0 .and. num_ranks > 1 .and. .not. has_fragmented_molecules) then
! Rank 0 constructs filenames for all molecules
do imol = 1, mqc_config%nmol
! Get molecule name
if (allocated(mqc_config%molecules(imol)%name)) then
mol_name = mqc_config%molecules(imol)%name
else
mol_name = "molecule_"//to_char(imol)
end if
! Construct JSON filename pattern: output_<basename>_<molname>.json
! This mirrors what get_output_json_filename() returns after set_molecule_suffix()
call set_molecule_suffix("_"//trim(mol_name))
individual_json_files(imol) = get_output_json_filename()
end do
end if
! Merge individual JSON files into one combined file (rank 0 only)
if (my_rank == 0) then
call merge_multi_molecule_json(individual_json_files, mqc_config%nmol)
end if
if (my_rank == 0) then
call logger%info(" ")
call logger%info("============================================")
call logger%info("All "//to_char(mqc_config%nmol)//" molecules completed")
if (has_fragmented_molecules) then
call logger%info("Execution: Sequential (each molecule used all ranks)")
else if (num_ranks == 1) then
call logger%info("Execution: Sequential (single rank)")
else if (num_ranks > mqc_config%nmol) then
call logger%info("Execution: Parallel (active ranks: "//to_char(mqc_config%nmol)//"/"//to_char(num_ranks)//")")
else
call logger%info("Execution: Parallel (all ranks active)")
end if
call logger%info("============================================")
end if
end subroutine run_multi_molecule_calculations