MpiParallelSuperMng.cc

// -*- tab-width: 2; indent-tabs-mode: nil; coding: utf-8-with-signature -*-
//-----------------------------------------------------------------------------
// Copyright 2000-2026 CEA (www.cea.fr) IFPEN (www.ifpenergiesnouvelles.com)
// See the top-level COPYRIGHT file for details.
// SPDX-License-Identifier: Apache-2.0
//-----------------------------------------------------------------------------
/*---------------------------------------------------------------------------*/
/* MpiParallelSuperMng.cc                                      (C) 2000-2025 */
/*                                                                           */
/* Parallelism manager using MPI.                                            */
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
#include "arcane/utils/ApplicationInfo.h"
#include "arcane/utils/NullThreadMng.h"
#include "arcane/utils/ITraceMng.h"
#include "arcane/utils/PlatformUtils.h"
#include "arcane/utils/ValueConvert.h"
#include "arcane/utils/NotImplementedException.h"
#include "arcane/utils/ArgumentException.h"
#include "arcane/utils/FatalErrorException.h"
#include "arcane/utils/CommandLineArguments.h"
 
#include "arcane/parallel/IStat.h"
 
#include "arccore/message_passing_mpi/internal/MpiAdapter.h"
#include "arcane/parallel/mpi/MpiParallelMng.h"
#include "arcane/parallel/mpi/MpiParallelDispatch.h"
#include "arcane/parallel/mpi/MpiErrorHandler.h"
 
#include "arcane/core/FactoryService.h"
#include "arcane/core/IApplication.h"
#include "arcane/core/ParallelSuperMngDispatcher.h"
 
#include "arcane/impl/SequentialParallelSuperMng.h"
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
namespace Arcane
{
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

class MpiParallelSuperMng
: public ParallelSuperMngDispatcher
{
 public:
 
  explicit MpiParallelSuperMng(const ServiceBuildInfo& sbi);
  ~MpiParallelSuperMng() override;
 
  void initialize() override;
  void build() override;
 
  IApplication* application() const override { return m_application; }
  IThreadMng* threadMng() const override { return m_thread_mng; }
  bool isParallel() const override { return m_is_parallel; }
  Int32 commRank() const override { return m_rank; }
  Int32 commSize() const override { return m_nb_rank; }
  Int32 traceRank() const override { return m_rank; }
  void* getMPICommunicator() override { return &m_mpi_main_communicator; }
  Parallel::Communicator communicator() const override { return m_main_communicator; }
  Ref<IParallelMng> internalCreateWorldParallelMng(Int32 local_rank) override;
  void tryAbort() override;
  bool isMasterIO() const override { return commRank() == 0; }
  Integer masterIORank() const override { return 0; }
  Integer nbLocalSubDomain() override { return m_nb_local_sub_domain; }
  void barrier() override;
 
 public:
 
  static void initMPI(IApplication* app);
 
 public:
 
  IApplication* m_application; 
  IThreadMng* m_thread_mng;
  Parallel::IStat* m_stat; 
  bool m_is_parallel; 
  Int32 m_rank; 
  Int32 m_nb_rank; 
  Int32 m_nb_local_sub_domain; 
  MPI_Comm m_mpi_main_communicator; 
  MP::Communicator m_main_communicator; 
  MP::Communicator m_machine_communicator; 
  MpiErrorHandler m_error_handler;
  MpiAdapter* m_adapter;
  MpiDatatypeList* m_datatype_list;
 
 private:
 
  // Error handler
  static void _ErrorHandler(MPI_Comm*, int*, ...);
};
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
MpiParallelSuperMng::
MpiParallelSuperMng(const ServiceBuildInfo& sbi)
: m_application(sbi.application())
, m_thread_mng(nullptr)
, m_stat(nullptr)
, m_is_parallel(false)
, m_rank(0)
, m_nb_rank(0)
, m_nb_local_sub_domain(1)
, m_mpi_main_communicator(MPI_COMM_NULL)
, m_main_communicator(MPI_COMM_NULL)
, m_machine_communicator(MPI_COMM_NULL)
, m_adapter(nullptr)
, m_datatype_list(nullptr)
{
  m_thread_mng = new NullThreadMng();
  m_stat = Parallel::createDefaultStat();
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
MpiParallelSuperMng::
~MpiParallelSuperMng()
{
  _finalize();
 
  try {
    delete m_datatype_list;
    if (m_adapter)
      m_adapter->destroy();
    delete m_stat;
    delete m_thread_mng;
  }
  catch (const Exception& ex) {
    m_application->traceMng()->error() << ex;
  }
 
  MPI_Barrier(m_mpi_main_communicator);
  m_error_handler.removeHandler();
 
  MPI_Comm_free(&m_mpi_main_communicator);
  m_mpi_main_communicator = MPI_COMM_NULL;
 
  MPI_Comm_free(static_cast<MPI_Comm*>(m_machine_communicator.communicatorAddress()));
 
  arcaneFinalizeMPI();
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
void MpiParallelSuperMng::
initialize()
{
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
void MpiParallelSuperMng::
initMPI(IApplication* app)
{
  int* argc = nullptr;
  char*** argv = nullptr;
 
  Request::setNullRequest(Request(0, nullptr, MPI_REQUEST_NULL));
  Communicator::setNullCommunicator(Communicator(MPI_COMM_NULL));
 
  const CommandLineArguments& app_args = app->applicationInfo().commandLineArguments();
  argc = app_args.commandLineArgc();
  argv = app_args.commandLineArgv();
 
  // TODO:
  // Be able to use a communicator other than MPI_COMM_WORLD
  int thread_wanted = MPI_THREAD_SERIALIZED;
  int thread_provided = 0;
  arcaneInitializeMPI(argc, argv, thread_wanted);
 
#ifndef ARCANE_USE_MPC
  // MPC (v 2.4.1) does not know this function
  MPI_Query_thread(&thread_provided);
#else
  thread_provided = MPI_THREAD_MULTIPLE;
#endif
 
  if (thread_provided < thread_wanted) {
    int my_rank = 0;
    // Display a message but only on one processor.
    MPI_Comm_rank(MPI_COMM_WORLD, &my_rank);
    if (my_rank == 0)
      app->traceMng()->info() << "WARNING: MPI thread level provided!=wanted ("
                              << thread_provided << "!=" << thread_wanted << ")";
  }
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
void MpiParallelSuperMng::
_ErrorHandler(MPI_Comm* comm, int* error_code, ...)
{
  ARCANE_UNUSED(comm);
 
  char error_buf[MPI_MAX_ERROR_STRING + 1];
  int error_len = 0;
  int e = *error_code;
  // int MPI_Error_string(int errorcode, char *string, int *resultlen);
  MPI_Error_string(e, error_buf, &error_len);
  error_buf[error_len] = '\0';
  error_buf[MPI_MAX_ERROR_STRING] = '\0';
 
  // int MPI_Error_class(int errorcode, int *errorclass);
 
  ARCANE_FATAL("Error in MPI call code={0} msg={1}", *error_code, error_buf);
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
void MpiParallelSuperMng::
build()
{
  ITraceMng* tm = m_application->traceMng();
 
  // TODO: Check if a reduction needs to be done over all times.
  Real start_time = platform::getRealTime();
  initMPI(m_application);
  Real end_time = platform::getRealTime();
 
  MPI_Comm_dup(MPI_COMM_WORLD, &m_mpi_main_communicator);
  m_main_communicator = MP::Communicator(m_mpi_main_communicator);
  int rank, size;
  MPI_Comm_rank(m_mpi_main_communicator, &rank);
  MPI_Comm_size(m_mpi_main_communicator, &size);
 
  MPI_Comm mpi_machine_communicator = MPI_COMM_NULL;
  MPI_Comm_split_type(MPI_COMM_WORLD, MPI_COMM_TYPE_SHARED, rank, MPI_INFO_NULL, &mpi_machine_communicator);
 
  m_machine_communicator = MP::Communicator(mpi_machine_communicator);
 
#ifndef ARCANE_USE_MPC
  m_error_handler.registerHandler(m_main_communicator);
#endif
 
  if (rank == 0) {
    tm->info() << "MPI has non blocking collective";
    tm->info() << "MPI: sizeof(MPI_Count)=" << sizeof(MPI_Count);
    tm->info() << "MPI: is GPU Aware?=" << arcaneIsAcceleratorAwareMPI();
    tm->info() << "MPI: init_time (seconds)=" << (end_time - start_time);
  }
 
  m_rank = rank;
  m_nb_rank = size;
  m_is_parallel = true;
  auto astat = m_stat->toArccoreStat();
  m_datatype_list = new MpiDatatypeList(false);
  m_adapter = new MpiAdapter(tm, astat, m_main_communicator, nullptr);
  auto c = createBuiltInDispatcher<Byte>(tm, nullptr, m_adapter, m_datatype_list);
  auto i32 = createBuiltInDispatcher<Int32>(tm, nullptr, m_adapter, m_datatype_list);
  auto i64 = createBuiltInDispatcher<Int64>(tm, nullptr, m_adapter, m_datatype_list);
  auto r = createBuiltInDispatcher<Real>(tm, nullptr, m_adapter, m_datatype_list);
  _setDispatchers(c, i32, i64, r);
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
Ref<IParallelMng> MpiParallelSuperMng::
internalCreateWorldParallelMng(Int32 local_rank)
{
  ITraceMng* tm = m_application->traceMng();
  tm->debug() << "[MpiParallelSuperMng::internalCreateWorldParallelMng]";
  if (local_rank != 0)
    ARCANE_THROW(ArgumentException, "local_rank has to be '0'");
 
  MPI_Comm comm = MPI_COMM_NULL;
  MPI_Comm_dup(m_main_communicator, &comm);
 
  MPI_Comm machine_comm = MPI_COMM_NULL;
  MPI_Comm_dup(m_machine_communicator, &machine_comm);
 
  int rank = -1;
  int nb_rank = -1;
  MPI_Comm_rank(comm, &rank);
  MPI_Comm_size(comm, &nb_rank);
 
  bool is_parallel = nb_rank > 1;
 
  MpiParallelMngBuildInfo bi(comm, machine_comm);
  bi.is_parallel = is_parallel;
  bi.stat = m_stat;
  bi.trace_mng = tm;
  bi.timer_mng = nullptr;
  bi.thread_mng = m_thread_mng;
  bi.mpi_lock = nullptr;
 
  tm->debug() << "[MpiParallelSuperMng::internalCreateWorldParallelMng] pm->build()";
  Ref<IParallelMng> pm = createRef<MpiParallelMng>(bi);
  pm->build();
  return pm;
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
void MpiParallelSuperMng::
tryAbort()
{
  m_application->traceMng()->info() << "MpiParallelSuperMng: rank " << m_rank << " calling MPI_Abort";
  m_application->traceMng()->flush();
  MPI_Abort(m_main_communicator, 2);
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
void MpiParallelSuperMng::
barrier()
{
  MPI_Barrier(m_main_communicator);
}
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

class MpiSequentialParallelSuperMng
: public SequentialParallelSuperMng
{
 public:
 
  explicit MpiSequentialParallelSuperMng(const ServiceBuildInfo& sbi)
  : SequentialParallelSuperMng(sbi, Parallel::Communicator(MPI_COMM_WORLD))
  {
  }
 
  ~MpiSequentialParallelSuperMng() override
  {
    arcaneFinalizeMPI();
  }
 
  void build() override
  {
    MpiParallelSuperMng::initMPI(application());
    SequentialParallelSuperMng::build();
  }
};
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
ARCANE_REGISTER_SERVICE(MpiParallelSuperMng,
                        ServiceProperty("MpiParallelSuperMng", ST_Application),
                        ARCANE_SERVICE_INTERFACE(IParallelSuperMng));
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
ARCANE_REGISTER_SERVICE(MpiSequentialParallelSuperMng,
                        ServiceProperty("MpiSequentialParallelSuperMng", ST_Application),
                        ARCANE_SERVICE_INTERFACE(IParallelSuperMng));
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
 
} // End namespace Arcane
 
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/