Tpetra_Core.cpp

// @HEADER
// *****************************************************************************
//          Tpetra: Templated Linear Algebra Services Package
//
// Copyright 2008 NTESS and the Tpetra contributors.
// SPDX-License-Identifier: BSD-3-Clause
// *****************************************************************************
// @HEADER
 
#include "Tpetra_Core.hpp"
#include "Tpetra_Details_mpiIsInitialized.hpp"
 
#ifdef HAVE_TPETRACORE_MPI
#include <Teuchos_DefaultMpiComm.hpp>  // this includes mpi.h too
#endif                                 // HAVE_TPETRACORE_MPI
#include <Teuchos_DefaultSerialComm.hpp>
 
#include <Kokkos_Core.hpp>
#include "Tpetra_Details_checkLaunchBlocking.hpp"
#include "Tpetra_Details_KokkosTeuchosTimerInjection.hpp"
#include "Tpetra_Details_Behavior.hpp"
#include "KokkosKernels_EagerInitialize.hpp"
#include "Tpetra_Details_initializeKokkos.hpp"
 
namespace Tpetra {
 
namespace {  // (anonymous)
 
#if defined(HAVE_TPETRACORE_MPI)
bool mpiIsInitializedAndNotFinalized() {
  int isInitialized = 0;
  int isFinalized   = 0;
  // Not sure if MPI_Initialized or MPI_Finalized meet the strong
  // exception guarantee.
  try {
    (void)MPI_Initialized(&isInitialized);
  } catch (...) {
    isInitialized = 0;
  }
  try {
    (void)MPI_Finalized(&isFinalized);
  } catch (...) {
    isFinalized = 0;
  }
  return isInitialized != 0 && isFinalized == 0;
}
#endif  // defined(HAVE_TPETRACORE_MPI)
 
// Whether one of the Tpetra::initialize() functions has been called before.
bool tpetraIsInitialized_ = false;
 
// Whether Tpetra initialized Kokkos.  Tpetra::finalize only
// finalizes Kokkos if it initialized Kokkos.  Otherwise,
// something else initialized Kokkos and is responsible for
// finalizing it.
bool tpetraInitializedKokkos_ = false;
 
#ifdef HAVE_TPETRACORE_MPI
// Whether Tpetra initialized MPI.  Tpetra::finalize only
// finalizes MPI if it initialized MPI.  Otherwise, something else
// initialized MPI and is responsible for finalizing it.
bool tpetraInitializedMpi_ = false;
#endif  // HAVE_TPETRACORE_MPI
 
// Tpetra's default communicator, wrapped in a Teuchos wrapper.
// After Tpetra::finalize() is called, this GOES AWAY (is set to null).
Teuchos::RCP<const Teuchos::Comm<int> > wrappedDefaultComm_;
 
#ifdef HAVE_TPETRACORE_MPI
 
int getRankHarmlessly(MPI_Comm comm) {
  int myRank = 0;
  if (mpiIsInitializedAndNotFinalized()) {
    try {
      (void)MPI_Comm_rank(comm, &myRank);
    } catch (...) {
      // Not sure if MPI_Comm_rank meets strong exception guarantee
      myRank = 0;
    }
  }
  return myRank;
}
 
// This takes the same arguments as MPI_Init and the first two
// arguments of initialize().
void initMpiIfNeeded(int* argc, char*** argv) {
  // Both MPI_Initialized and MPI_Finalized report true after
  // MPI_Finalize has been called.  It's not legal to call
  // MPI_Init after MPI_Finalize has been called (see MPI 3.0
  // Standard, Section 8.7).  It would be unusual for users to
  // want to use Tpetra after MPI_Finalize has been called, but
  // there's no reason why we should forbid it.  It just means
  // that Tpetra will need to run without MPI.
 
  const bool mpiReady = mpiIsInitializedAndNotFinalized();
  if (!mpiReady) {
    // Tpetra doesn't currently need to call MPI_Init_thread,
    // since with Tpetra, only one thread ever calls MPI
    // functions.  If we ever want to explore
    // MPI_THREAD_MULTIPLE, here would be the place to call
    // MPI_Init_thread.
    const int err = MPI_Init(argc, argv);
    TEUCHOS_TEST_FOR_EXCEPTION(err != MPI_SUCCESS, std::runtime_error,
                               "MPI_Init failed with "
                               "error code "
                                   << err << " != MPI_SUCCESS.  If MPI was set up "
                                             "correctly, then this should not happen, since we have already "
                                             "checked that MPI_Init (or MPI_Init_thread) has not yet been "
                                             "called.  This may indicate that your MPI library is corrupted "
                                             "or that it is incorrectly linked to your program.");
    tpetraInitializedMpi_ = true;
  }
}
#endif  // HAVE_TPETRACORE_MPI
 
}  // namespace
 
bool isInitialized() {
  return tpetraIsInitialized_;
}
 
Teuchos::RCP<const Teuchos::Comm<int> > getDefaultComm() {
  // It's technically not correct to call this function if Tpetra
  // has not yet been initialized, but requiring that may break some
  // downstream tests.
  //
  // This function initializes wrappedDefaultComm_ lazily.
  // Tpetra::initialize should not set it up.
  if (wrappedDefaultComm_.is_null()) {
    Teuchos::RCP<const Teuchos::Comm<int> > comm;
#ifdef HAVE_TPETRACORE_MPI
    // Teuchos::MpiComm's constructor used to invoke MPI collectives.
    // It still reserves the right to do so.  This means MPI must be
    // initialized and not finalized.
    const bool mpiReady = mpiIsInitializedAndNotFinalized();
    if (mpiReady) {
      comm = Teuchos::rcp(new Teuchos::MpiComm<int>(MPI_COMM_WORLD));
    } else {
      comm = Teuchos::rcp(new Teuchos::SerialComm<int>());
    }
#else
    comm = Teuchos::rcp(new Teuchos::SerialComm<int>());
#endif  // HAVE_TPETRACORE_MPI
    wrappedDefaultComm_ = comm;
  }
  return wrappedDefaultComm_;
}
 
void initialize(int* argc, char*** argv) {
  if (!tpetraIsInitialized_) {
#if defined(HAVE_TPETRACORE_MPI)
    initMpiIfNeeded(argc, argv);
#endif  // defined(HAVE_TPETRACORE_MPI)
 
    // Initialize Kokkos using the new function
    if (!Kokkos::is_initialized()) {
      Tpetra::Details::initializeKokkos(argc, argv);
      tpetraInitializedKokkos_ = true;
    }
 
    Tpetra::Details::Behavior::reject_unrecognized_env_vars();
  }
  tpetraIsInitialized_ = true;
}
 
#ifdef HAVE_TPETRACORE_MPI
void initialize(int* argc, char*** argv, MPI_Comm comm) {
  if (!tpetraIsInitialized_) {
#if defined(HAVE_TPETRACORE_MPI)
    initMpiIfNeeded(argc, argv);
    // It's technically legal to initialize Tpetra after
    // MPI_Finalize has been called.  This means that we can't call
    // MPI_Comm_rank without first checking MPI_Finalized.
    const int myRank = getRankHarmlessly(comm);
#else
    const int myRank = 0;
#endif  // defined(HAVE_TPETRACORE_MPI)
 
    // Initialize Kokkos using the new function
    if (!Kokkos::is_initialized()) {
      Tpetra::Details::initializeKokkos(argc, argv, myRank);
      tpetraInitializedKokkos_ = true;
    }
 
    Tpetra::Details::Behavior::reject_unrecognized_env_vars();
  }
  tpetraIsInitialized_ = true;
 
  // Set the default communicator.  We set it here, after the above
  // initialize() call, just in case users have not yet initialized
  // MPI.  (This is legal if users pass in a predefined
  // communicator, like MPI_COMM_WORLD or MPI_COMM_SELF.)
  //
  // What if users have already called initialize() before, but with
  // a different default communicator?  There are two possible
  // things we could do here:
  //
  //   1. Test via MPI_Comm_compare whether comm differs from the
  //      raw MPI communicator in wrappedDefaultComm_ (if indeed it
  //      is an MpiComm).
  //   2. Accept that the user might want to change the default
  //      communicator, and let them do it.
  //
  // I prefer #2.  Perhaps it would be sensible to print a warning
  // here, but on which process?  Would we use the old or the new
  // communicator to find that process' rank?  We don't want to use
  // MPI_COMM_WORLD's Process 0, since neither communicator might
  // include that process.  Furthermore, in some environments, only
  // Process 0 in MPI_COMM_WORLD is allowed to do I/O.  Thus, we
  // just let the change go without a warning.
  wrappedDefaultComm_ = Teuchos::rcp(new Teuchos::MpiComm<int>(comm));
}
#endif  // HAVE_TPETRACORE_MPI
 
void initialize(int* argc, char*** argv,
                const Teuchos::RCP<const Teuchos::Comm<int> >& comm) {
  if (!tpetraIsInitialized_) {
#if defined(HAVE_TPETRACORE_MPI)
    initMpiIfNeeded(argc, argv);
#endif  // defined(HAVE_TPETRACORE_MPI)
 
    // Initialize Kokkos using the new function
    if (!Kokkos::is_initialized()) {
      Tpetra::Details::initializeKokkos(argc, argv, !comm.is_null() ? comm->getRank() : 0);
      tpetraInitializedKokkos_ = true;
    }
 
    Tpetra::Details::Behavior::reject_unrecognized_env_vars();
  }
  tpetraIsInitialized_ = true;
  wrappedDefaultComm_  = comm;
}
 
void finalize() {
  if (!tpetraIsInitialized_) {
    return;  // user didn't call initialize(), so do nothing at all
  }
 
  // Tpetra should only finalize Kokkos if it initialized Kokkos.
  // See Github Issue #434.
  // Note: Kokkos finalization is now handled by the atexit hook set up in
  // Tpetra::Details::initializeKokkos(), so we don't need to call it here.
  // The atexit hook ensures Kokkos::finalize() is called automatically.
 
  // Make sure that no outstanding references to the communicator
  // remain.  If users gave initialize() an MPI_Comm, _they_ are
  // responsible for freeing it before calling finalize().
  wrappedDefaultComm_ = Teuchos::null;
 
#ifdef HAVE_TPETRACORE_MPI
  // Tpetra should only finalize MPI if it initialized MPI.
  // See Github Issue #434.
  if (tpetraInitializedMpi_) {
    // finalize() is a kind of destructor, so it's a bad idea to
    // throw an exception on error.  MPI implementations do have
    // the option to throw on error, so let's catch that here.
    try {
      if (Details::mpiIsInitialized()) {
        // This must be called by the same thread that called
        // MPI_Init or MPI_Init_thread (possibly, but not
        // necessarily, in Tpetra::initialize()).
        (void)MPI_Finalize();
      }
    } catch (...) {
    }
  }
#endif  // HAVE_TPETRACORE_MPI
 
  tpetraIsInitialized_ = false;  // it's not anymore.
}
 
ScopeGuard::ScopeGuard(int* argc, char*** argv) {
  ::Tpetra::initialize(argc, argv);
}
 
#ifdef HAVE_TPETRA_MPI
ScopeGuard::ScopeGuard(int* argc, char*** argv, MPI_Comm comm) {
  ::Tpetra::initialize(argc, argv, comm);
}
#endif  // HAVE_TPETRA_MPI
 
ScopeGuard::~ScopeGuard() {
  ::Tpetra::finalize();
}
 
}  // namespace Tpetra