mon_main.cpp

/****************************************************************************
* Copyright (c) 2026, CEA
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
* 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
* 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
* IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
* OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*
*****************************************************************************/
 
#include <mon_main.h>
#include <LecFicDiffuse_JDD.h>
#include <TClearable.h> // To clear caches before exiting, notably Domaine_dis_cache
#include <instancie_appel.h>
#include <SFichier.h>
#include <Comm_Group_MPI.h>
#include <PE_Groups.h>
#include <Journal.h>
#include <cstdio>
#include <Perf_counters.h>
#include <communications.h>
#include <petsc_for_kernel.h>
#ifdef PETSCKSP_H
#include <petscdevice.h>
#include <petscsys.h>
#endif
#include <Baltik_Version.h>
#include <info_atelier.h>
#include <unistd.h> // For chdir for other compilers
#ifndef __CYGWIN__
#include <catch_and_trace.h>
#endif
 
#include <kokkos++.h>
 
namespace
{
static bool TRUST_LIBRARY_MODE = false;
}
 
void TRUST_set_library_mode(bool b)
{
  TRUST_LIBRARY_MODE = b;
}
 
void TRUST_global_finalize()
{
  if (!TRUST_LIBRARY_MODE) return;
 
#ifdef PETSCKSP_H
  // Call PetscFinalize only if necessary
  PetscBool isInitialized;
  PetscInitialized(&isInitialized);
  if (isInitialized==PETSC_TRUE)
    {
      PetscPopErrorHandler(); // Removes the latest error handler that was pushed with PetscPushErrorHandler in init_petsc
      PetscFinalize();
    }
#endif
 
  if (Kokkos::is_initialized())
    Kokkos::finalize();
}
 
mon_main::mon_main(int verbose_level, bool journal_master, Nom log_directory, bool apply_verification, bool disable_stop)
{
  verbose_level_ = verbose_level;
  journal_master_ = journal_master;
  log_directory_ = log_directory;
  LecFicDiffuse_JDD::apply_verif = apply_verification;
  // Create a temporary journal that writes to Cerr
  init_journal_file(verbose_level, 0 /* filename = 0 => Cerr */, 0 /* append */);
  trio_began_mpi_=false;
  disable_stop_=disable_stop;
  change_disable_stop(disable_stop);
}
 
static int init_petsc(int argc, char **argv, bool with_mpi,bool& trio_began_mpi_)
{
#ifdef PETSCKSP_H
  PetscBool isInitialized;
  PetscInitialized(&isInitialized);
  if (isInitialized)
    return 1;
 
  static char help[] = "TRUST may solve linear systems with Petsc library.\n\n" ;
  Nom pwd(::pwd());
  // Initialize Petsc
#ifdef MPI_INIT_NEEDS_MPIRUN
  int flag;
  MPI_Initialized(&flag);
  // if MPI is initialised or if argc>2
  if ((argc>2)||(flag))
    {
      PetscInitialize(&argc, &argv, (char*)0, help);
    }
#else
  PetscInitialize(&argc, &argv, (char*)0, help);
#endif
#ifdef TRUST_USE_GPU
  PetscDevice device;
  PetscDeviceCreate(PETSC_DEVICE_DEFAULT(), PETSC_DECIDE, &device);
  PetscDeviceView(device, PETSC_VIEWER_STDERR_WORLD);
  //if (instance==1) PetscLogGpuTime(); // Slow down calculation ! Use -log_view_gpu_time
#endif
  // Quirk observed on one machine (ioulia, native MPICH): PetscInitialize changes pwd()
  // in sequential mode and, if the binary is not in the study directory, the pwd is lost...
  int ierr;
  if (!with_mpi)
    {
      ierr=chdir(pwd);
      if (ierr)
        {
          Cerr << "Error on chdir into mon_main.cpp. Contact TRUST support." << finl;
          Process::exit();
        }
    }
  // Equivalent to -abort_on_error (no PETSc error is tolerated):
  PetscPushErrorHandler(PetscAbortErrorHandler, PETSC_NULLPTR);
  // Disable the signal handler in optimised mode to avoid too much verbosity
  // and to avoid "masking" TRUST error messages:
  PetscPopSignalHandler();
 
#ifndef __CYGWIN__
  Cerr << "Enabling error handlers catching SIGFPE and SIGABORT and giving a trace of where the fault happened." << finl;
  install_handlers();
#endif
#else
#ifdef MPI_
  // MPI_Init for machines where Petsc is not installed
  int flag;
  MPI_Initialized(&flag);
  if (!flag)
    {
      MPI_Init(&argc,&argv);
      trio_began_mpi_=true;
    }
#endif
#endif
 
  return 1;
}
 
static int init_parallel_mpi(OWN_PTR(Comm_Group) & groupe_trio)
{
#ifdef MPI_
  groupe_trio.typer("Comm_Group_MPI");
  Comm_Group_MPI& mpi = ref_cast(Comm_Group_MPI, groupe_trio.valeur());
  mpi.init_group_trio();
  return 1;
#else
  return 0;
#endif
}
 
static void instantiate_node_mpi(OWN_PTR(Comm_Group) & ngrp, OWN_PTR(Comm_Group) & mgrp, int with_mpi)
{
  if (with_mpi)
    {
      ngrp.typer("Comm_Group_MPI");
      mgrp.typer("Comm_Group_MPI");
    }
  else
    {
      ngrp.typer("Comm_Group_NoParallel");
      mgrp.typer("Comm_Group_NoParallel");
    }
}
 
static void init_node_mpi(OWN_PTR(Comm_Group) & ngrp)
{
#ifdef MPI_
  assert(ngrp);
  Comm_Group_MPI& mpi_on_node = ref_cast(Comm_Group_MPI, ngrp.valeur());
  mpi_on_node.init_comm_on_numa_node();
#endif
}
 
static void init_node_masters(OWN_PTR(Comm_Group) & master)
{
#ifdef MPI_
  assert(master);
  Comm_Group_MPI& mm = ref_cast(Comm_Group_MPI, master.valeur());
  mm.init_comm_on_node_master();
#endif
}
 
///////////////////////////////////////////////////////////
// From now on, Petsc/MPI_Initialize and Petsc/MPI_Finalize
// are in a single file: mon_main.
// They must not appear anywhere else!
//////////////////////////////////////////////////////////
void mon_main::init_parallel(const int argc, char **argv, bool with_mpi, bool check_enabled, bool with_petsc)
{
  bool init_kokkos_before_mpi = (getenv("KOKKOS_AFTER_MPI") == nullptr);
  // https://kokkos.org/kokkos-core-wiki/ProgrammingGuide/Initialization.html say after !
  if (init_kokkos_before_mpi && !Kokkos::is_initialized())
    {
      // Kokkos initialization
      int argc2 = argc;
      Kokkos::initialize(argc2, argv);
    }
  Nom arguments_info = "";
  arguments_info += "Kokkos initialized!\n";
 
  bool must_mpi_initialize = true;
  if (with_petsc)
    {
      if (init_petsc(argc, argv, with_mpi, trio_began_mpi_))
        {
          must_mpi_initialize = false; // Already done by Petsc
          arguments_info += "Petsc initialization succeeded.\n";
        }
      else
        {
          arguments_info += "Petsc initialization failed (not compiled ?). Not fatal...\n";
        }
    }
  else
    {
      arguments_info += "Petsc initialization skipped (-petsc=0).\n";
    }
#ifdef MPI_
  Comm_Group_MPI::set_must_mpi_initialize(must_mpi_initialize);
#else
  // avoid variable 'must_mpi_initialize' set but not used error when MPI disabled
  if (must_mpi_initialize) abort();
#endif
  // ***************** Parallel initialisation *************************
  Comm_Group::set_check_enabled(check_enabled);
 
  if (with_mpi)
    {
      if (!init_parallel_mpi(groupe_trio_))
        {
          Cerr << "MPI initialization failed (not compiled ?). Fatal." << finl;
          Process::exit();
        }
    }
  else
    groupe_trio_.typer("Comm_Group_NoParallel");
 
  // Initialisation of the communication groups.
  PE_Groups::initialize(groupe_trio_);
  arguments_info += "Parallel engine initialized : ";
  arguments_info += groupe_trio_->que_suis_je();
  arguments_info += " with ";
  arguments_info += Nom(Process::nproc());
  arguments_info += " processors\n";
 
  if (Process::je_suis_maitre())
    Cerr << arguments_info;
 
  // The node group is instantiated here so it is done only once (necessary with ICoCo).
  // It is initialised later because it involves communication operations, which require statistics to be initialised first.
  instantiate_node_mpi(node_group_, node_master_, with_mpi);
 
  if (!init_kokkos_before_mpi && !Kokkos::is_initialized())
    {
      // Kokkos initialization
      int argc2 = argc;
      Kokkos::initialize(argc2, argv);
      if (Process::je_suis_maitre())
        Cerr << "Kokkos initialized after MPI !" << finl;
    }
  if (Process::je_suis_maitre())
    {
#ifdef TRUST_USE_GPU
      Kokkos::print_configuration(std::cerr, true);
#endif
      Cerr << "You can run --kokkos-help option." << finl;
    }
}
 
void mon_main::finalize()
{
  // Clear all things that were registered by Register_clearable() method (typically the Domaine_dis_cache instance
  // to make sure all Kokkos views are freed before doing Kokkos finalize):
  TClearable::Clear_all();
 
#ifdef MPI_
  // MPI_Group_free before MPI_Finalize (not freeing comm as we can not free MPI_COMM_WORLD)
  if (sub_type(Comm_Group_MPI,groupe_trio_.valeur()))
    ref_cast(Comm_Group_MPI,groupe_trio_.valeur()).free();
 
  if (sub_type(Comm_Group_MPI,node_master_.valeur()))
    ref_cast(Comm_Group_MPI,node_master_.valeur()).free_all(); // free comm + group
 
  if (sub_type(Comm_Group_MPI,node_group_.valeur()))
    ref_cast(Comm_Group_MPI,node_group_.valeur()).free_all(); // free comm + group
 
  // user defined groups (if any !)
  if (PE_Groups::has_user_defined_group())
    {
      auto& grp = PE_Groups::get_user_defined_group();
      if (sub_type(Comm_Group_MPI,grp))
        ref_cast_non_const(Comm_Group_MPI,grp).free_all(); // free comm + group
    }
 
#endif
 
#ifdef PETSCKSP_H
  if (!TRUST_LIBRARY_MODE)
    {
      // Call PetscFinalize only if necessary
      PetscBool isInitialized;
      PetscInitialized(&isInitialized);
      if (isInitialized==PETSC_TRUE)
        {
          PetscPopErrorHandler(); // Removes the latest error handler that was pushed with PetscPushErrorHandler in init_petsc
#ifdef MPI_
          if (sub_type(Comm_Group_MPI,PE_Groups::current_group()))
            PETSC_COMM_WORLD = ref_cast(Comm_Group_MPI,PE_Groups::current_group()).get_mpi_comm();
#endif
          PetscFinalize();
        }
    }
#endif
 
#ifdef MPI_
  if (!TRUST_LIBRARY_MODE && trio_began_mpi_)
    {
      // Call MPI_Finalize if MPI_Initialized and not MPI_Finalized
      int flag;
      MPI_Initialized(&flag);
      if (flag)
        {
          MPI_Finalized(&flag);
          if (!flag)
            MPI_Finalize();
        }
    }
#endif
  if (!TRUST_LIBRARY_MODE && Kokkos::is_initialized())
    Kokkos::finalize();
}
 
void mon_main::dowork(const Nom& nom_du_cas)
{
  // The master processor broadcasts the case name to all processors,
  // because with MPICH 1.2.7 (Debian) the command line retrieved via argv
  // does not contain the dataset name on processors other than the master
  Nom tmp = nom_du_cas;
  envoyer(tmp, 0, -1, 0);
  recevoir(tmp, 0, -1, 0);
  Objet_U::get_set_nom_du_cas() = tmp;
 
  // ******************* Journal ***************************
  // Initialisation of the parallel journal (now that the processor rank
  // and the case name are known)
  {
    // Master process creates log directory if needed
    if (Process::je_suis_maitre() && log_directory_!="")
      {
        Nom mkdir_command("mkdir -p ");
        mkdir_command += log_directory_;
        if(system(mkdir_command))
          {
            Cerr << "Error while creating directory: " << log_directory_ << "\n";
            Process::exit();
          }
      }
    Process::barrier(); // Otherwise, non-master processes try to write .log file before mkdir is done
    Nom filename = log_directory_ + nom_du_cas;
    if (Process::nproc() > 1)
      {
        filename += "_";
        char s[20];
        snprintf(s, 20, "%05d", (int)Process::me());
        filename += s;
      }
    filename += ".log";
    // If journal_master_ is set, only the master process writes to the journal:
    if (journal_master_ && !Process::je_suis_maitre())
      verbose_level_ = 0;
 
    // If a single journal is not enabled, disable individual logs beyond a certain number of MPI ranks.
    // Applied when the "-journal" option is not specified.
    if (verbose_level_ < 0)
      {
        if (!journal_master_ && Process::force_single_file(Process::nproc(), nom_du_cas+".log"))
          verbose_level_ = 0;
        else
          verbose_level_ = 1;
      }
 
    init_journal_file(verbose_level_,filename, 0 /* append=0 */);
    Process::Journal() << "Journal logging started" << finl;
  }
 
#ifdef TRUST_USE_GPU
  // PL: It will be better to do it sooner (near Cuda init or Kokkos init) but need stat and journal initialized
  // Soon obsolete:
  init_device();
  self_test();
#endif
 
  Nom nomfic( nom_du_cas );
  nomfic += ".stop";
  if (!get_disable_stop() && Process::je_suis_maitre())
    {
      SFichier ficstop( nomfic );
      ficstop << "Running..."<<finl;
    }
 
  //---------------------------------------------//
  // Module loading:
  // only loaded for the "nul" case, for valgrind verification
  if (Objet_U::nom_du_cas()=="nul")
    {
      Cerr<<"Loading modules:"<<finl;
#include <instancie_appel_c.h>
      Cerr<<"Finished loading modules "<<finl;
    }
 
  // initializing communicators on node
  if (Process::is_parallel())
    init_node_mpi(node_group_);
  PE_Groups::initialize_node(node_group_);
 
  // Node_master needs node_group to be initialized first
  if (Process::is_parallel())
    init_node_masters(node_master_);
  PE_Groups::initialize_node_master(node_master_);
 
  Cout<< " " << finl;
  Cout<< " * * * * * * * * * * * * * * * * * * * * * * * * * * * *     " << finl;
  Cout<< " *  _________  _______             _______  _________  *     " << finl;
  Cout<< " *  \\__   __/ (  ____ ) |\\     /| (  ____ \\ \\__   __/  * " << finl;
  Cout<< " *     ) (    | (    )| | )   ( | | (    \\/    ) (     *    " << finl;
  Cout<< " *     | |    | (____)| | |   | | | (_____     | |     *     " << finl;
  Cout<< " *     | |    |     __) | |   | | (_____  )    | |     *     " << finl;
  Cout<< " *     | |    | (\\ (    | |   | |       ) |    | |     *    " << finl;
  Cout<< " *     | |    | ) \\ \\__ | (___) | /\\____) |    | |     *  " << finl;
  Cout<< " *     )_(    |/   \\__/ (_______) \\_______)    )_(     *   " << finl;
  Cout<< " *                                                     *     " << finl;
  Cout<< " *                  version : " << TRUST_VERSION << "                    *     "  << finl;
  Cout<< " *                                                     *     " << finl;
#ifdef BALTIK_VERSION
  Cout<< " *           Using " << BALTIK_NAME << " version : " << BALTIK_VERSION << "             *" << finl;
#endif
  Cout<< " *                                                     *     " << finl;
  Cout<< " *                       CEA - DES                     *     " << finl;
  Cout<< " *                                                     *     " << finl;
  Cout<< " * * * * * * * * * * * * * * * * * * * * * * * * * * * *     " << finl;
  Cout<< " " << finl;
 
  info_atelier(Cout);
  Cout<<" " << finl;
  Cout<<"  Processing case: " << Objet_U::nom_du_cas() << "\n";
  Cout<<" " << finl;
 
  // GF: the class hierarchy is written only on error
  //---------------------------------------------//
  Cerr<<"Beginning execution" << finl;
  {
    Nom nomentree = nom_du_cas;
    nomentree+=".data";
    /*
    #ifndef NDEBUG
    if (Process::je_suis_maitre())
      {
        SFichier es("convert_jdd");
      }
    #endif */
    // Verification is now done in LecFicDiffuse_JDD;
    // keeping these lines just in case
    if (0)
      {
        Cerr << "MAIN: Checking data file for matching { and }" << finl;
        {
          LecFicDiffuse_JDD verifie_entree(nomentree, ios::in);
          interprete_principal_.interpreter_bloc(verifie_entree,
                                                 Interprete_bloc::FIN /* wait for FIN at the end */,
                                                 1 /* verifie_sans_interpreter */);
        }
      }
    Cerr << "MAIN: Reading and executing data file" << finl;
    {
      LecFicDiffuse_JDD lit_entree(nomentree, ios::in);
      lit_entree.set_check_types(1);
      interprete_principal_.interpreter_bloc(lit_entree,
                                             Interprete_bloc::FIN /* wait for FIN at the end */,
                                             0 /* truly interpret */);
    }
  }
 
  Cerr << "MAIN: End of data file" << finl;
  Process::imprimer_ram_totale(1);
 
  statistics().print_TU_files("Post-resolution statistics");
 
  double temps = statistics().get_computation_time();
  Cout << finl;
  Cout << "--------------------------------------------" << finl;
  Cout << "clock: Total execution: " << temps << " s" << finl;
  if (!get_disable_stop() && Process::je_suis_maitre())
    {
      SFichier ficstop ( nomfic);
      ficstop  << "Finished correctly"<<finl;
    }
}
 
mon_main::~mon_main()
{
  // The journal can be stopped after communications:
  // EDIT 12/02/2020: journal needs communication to be turned on if it's written in HDF5 format
  Process::Journal() << "End of Journal logging" << finl;
  end_journal(verbose_level_);
  // Destroy the main interpreter before stopping the parallel layer
  interprete_principal_.vide();
  // PetscFinalize/MPI_Finalize
  finalize();
  // Can now finalize now that journals have been stopped
  PE_Groups::finalize();
  groupe_trio_.detach();
  node_group_.detach();
 
}