Commit 9889f72b authored by Thomas Jahns's avatar Thomas Jahns 🤸
Browse files

Update core interface.

parent b025e503
......@@ -2,14 +2,14 @@
* @file core.c
* @brief interface to user-adjustable core routines of scales ppm
*
* @copyright (C) 2010,2011,2012 Thomas Jahns <jahns@dkrz.de>
* @copyright (C) 2010,2011,2012 Thomas Jahns <jahns@dkrz.de>
*
* @author Thomas Jahns <jahns@dkrz.de>
*/
/*
* Keywords: ScalES PPM error handling
* Maintainer: Thomas Jahns <jahns@dkrz.de>
* URL: https://www.dkrz.de/redmine/projects/show/scales-ppm
* URL: https://www.dkrz.de/redmine/projects/scales-ppm
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are
......@@ -56,8 +56,15 @@
#include <config.h>
#endif
#include <stdio.h>
#if defined __clang__
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wreserved-id-macro"
#pragma GCC diagnostic ignored "-Wstrict-prototypes"
#endif
#include <cfortran.h>
#if defined __clang__
#pragma GCC diagnostic pop
#endif
#ifdef USE_MPI
#include <mpi.h>
......@@ -65,20 +72,19 @@
#include "core/ppm_visibility.h"
#include "core/core.h"
#include "core/symprefix.h"
MPI_Comm SymPrefix(default_comm) = MPI_COMM_WORLD;
#define PPMF2C_Data COMMON_BLOCK(PPMF2C_DATA,ppmf2c_data)
#define SymPrefix(F2C_Data) COMMON_BLOCK(SYMPREFIX(F2C_DATA),symprefix(f2c_data))
typedef struct
{
MPI_Fint ppm_default_comm;
} PPMF2C_Def;
MPI_Fint symprefix(default_comm);
} SymPrefix(F2C_Def);
COMMON_BLOCK_DEF(PPMF2C_Def,PPMF2C_Data);
COMMON_BLOCK_DEF(SYMPREFIX(F2C_Def),SymPrefix(F2C_Data));
PPMF2C_Def PPMF2C_Data;
SymPrefix(F2C_Def) SymPrefix(F2C_Data);
void
SymPrefix(set_default_comm)(MPI_Comm comm)
......@@ -90,19 +96,9 @@ SymPrefix(set_default_comm)(MPI_Comm comm)
comm_f = comm;
#endif
SymPrefix(default_comm) = comm;
PPMF2C_Data.ppm_default_comm = comm_f;
SymPrefix(F2C_Data).symprefix(default_comm) = comm_f;
}
#ifdef USE_MPI
static inline int
callsToMPIAreAllowed(void)
{
int init_flag = 0, finished_flag = 0;
return MPI_Initialized(&init_flag) == MPI_SUCCESS && init_flag
&& MPI_Finalized(&finished_flag) == MPI_SUCCESS && !finished_flag;
}
#endif
void
SymPrefix(abort_default)(MPI_Comm comm, const char *msg, const char *source, int line)
{
......@@ -111,7 +107,7 @@ SymPrefix(abort_default)(MPI_Comm comm, const char *msg, const char *source, int
#if defined (__xlC__) && defined (_AIX)
#pragma omp critical
#endif
if (callsToMPIAreAllowed())
if (SymPrefix(mpi_calls_are_allowed)())
MPI_Abort(comm, 1);
else
abort();
......@@ -124,21 +120,30 @@ SymPrefix(abort_default)(MPI_Comm comm, const char *msg, const char *source, int
SymPrefix(abort_func) SymPrefix(abort) = SymPrefix(abort_default);
void
SymPrefix(restore_default_abort_handler)()
SymPrefix(restore_default_abort_handler)(void)
{
SymPrefix(abort) = SymPrefix(abort_default);
}
#if (defined __GNUC__ && __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ > 5))\
|| (defined __clang__)
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wmissing-prototypes"
#endif
FCALLSCSUB0(SymPrefix(restore_default_abort_handler),
SYMPREFIX(RESTORE_DEFAULT_ABORT_HNDL),
symprefix(restore_default_abort_hndl))
#if (defined __GNUC__ && __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ > 5))\
|| (defined __clang__)
#pragma GCC diagnostic pop
#endif
#ifdef USE_MPI
static inline int
getMPICommWorldRank()
{
int rank = -1;
if (callsToMPIAreAllowed())
if (SymPrefix(mpi_calls_are_allowed)())
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
return rank;
}
......@@ -164,7 +169,7 @@ SymPrefix(xmpi)(int errcode, const char *source, int line)
/*
* Local Variables:
* license-project-url: "https://www.dkrz.de/redmine/projects/show/scales-ppm"
* license-project-url: "https://www.dkrz.de/redmine/projects/scales-ppm"
* license-markup: "doxygen"
* license-default: "bsd"
* End:
......
......@@ -95,6 +95,12 @@ typedef void (*SymPrefix(abort_func))(MPI_Comm comm, const char *msg,
*/
extern SymPrefix(abort_func) SymPrefix(abort);
/**
* Restore default abort handler.
*/
void
SymPrefix(restore_default_abort_handler)(void);
/**
* communicator object to use by default
*/
......@@ -125,10 +131,20 @@ SymPrefix(set_default_comm)(MPI_Comm comm);
#define die(msg) \
SymPrefix(abort)(SymPrefix(default_comm), (msg), __FILE__, __LINE__)
#ifdef USE_MPI
static inline int
SymPrefix(mpi_calls_are_allowed)(void)
{
int init_flag = 0, finished_flag = 0;
return MPI_Initialized(&init_flag) == MPI_SUCCESS && init_flag
&& MPI_Finalized(&finished_flag) == MPI_SUCCESS && !finished_flag;
}
#endif
#endif
/*
* Local Variables:
* license-project-url: "https://www.dkrz.de/redmine/projects/show/scales-ppm"
* license-project-url: "https://www.dkrz.de/redmine/projects/scales-ppm"
* license-default: "bsd"
* license-markup: "doxygen"
* End:
......
......@@ -92,16 +92,16 @@ FCALLSCSUB4(abort_f, SYMPREFIX(ABORT), symprefix(abort),
PVOID, STRING, STRING, INT)
static void
abort_ppm_handler_wrapper(MPI_Comm comm, const char msg[],
SymPrefix(abort_handler_wrapper)(MPI_Comm comm, const char msg[],
const char source[], int line)
__attribute__((noreturn));
static void
set_abort_ppm_handler_f(void (*abort_ppm_handler)());
SymPrefix(set_abort_handler_f)(void (*abort_handler)());
#undef ROUTINE_1
#define ROUTINE_1 (void (*)())
FCALLSCSUB1(set_abort_ppm_handler_f, SYMPREFIX(SET_ABORT_HANDLER),
FCALLSCSUB1(SymPrefix(set_abort_handler_f), SYMPREFIX(SET_ABORT_HANDLER),
symprefix(set_abort_handler), ROUTINE)
static void
......@@ -137,19 +137,19 @@ PROTOCCALLSFSUB4(*SymPrefix(fortran_abort_func),,PVOID,STRING,STRING,INT)
#undef CFextern
#define CFextern static
static SymPrefix(fortran_abort_func) abort_ppm_fortran_fp;
static SymPrefix(fortran_abort_func) SymPrefix(fortran_abort_fp);
static void
set_abort_ppm_handler_f(void (*abort_ppm_handler)())
SymPrefix(set_abort_handler_f)(void (*abort_handler)())
{
abort_ppm_fortran_fp
= (SymPrefix(fortran_abort_func))abort_ppm_handler;
SymPrefix(abort) = abort_ppm_handler_wrapper;
SymPrefix(fortran_abort_fp)
= (SymPrefix(fortran_abort_func))abort_handler;
SymPrefix(abort) = SymPrefix(abort_handler_wrapper);
}
static void
abort_ppm_handler_wrapper(MPI_Comm comm, const char msg[],
const char source[], int line)
SymPrefix(abort_handler_wrapper)(MPI_Comm comm, const char msg[],
const char source[], int line)
{
#if defined(USE_MPI)
int flag = 0;
......@@ -166,7 +166,7 @@ abort_ppm_handler_wrapper(MPI_Comm comm, const char msg[],
char *msg_arg = (char *)msg, *source_arg = (char *)source;
#undef CPPPROTOCLSFSUB14
#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
CCALLSFSUB4(*abort_ppm_fortran_fp,,PVOID,STRING,STRING,INT,
CCALLSFSUB4(*SymPrefix(fortran_abort_fp),,PVOID,STRING,STRING,INT,
&comm_f, msg_arg, source_arg, line);
}
......
......@@ -59,7 +59,7 @@ MODULE ppm_base
!> communicator object to use by default
INTEGER :: ppm_default_comm
INCLUDE 'ppmcommon.inc'
SAVE :: /ppmf2c_data/
SAVE :: /ppm_f2c_data/
PUBLIC :: ppm_default_comm, set_default_comm
PUBLIC :: abort_ppm, assertion
PUBLIC :: set_abort_handler, restore_default_abort_handler
......@@ -201,7 +201,7 @@ END MODULE ppm_base
BLOCK DATA
USE ppm_base, ONLY: mpi_comm_world
INCLUDE 'ppmcommon.inc'
SAVE :: /ppmf2c_data/
SAVE :: /ppm_f2c_data/
INTEGER :: ppm_default_comm
DATA ppm_default_comm /mpi_comm_world/
END BLOCK DATA
......
......@@ -36,7 +36,7 @@
!$$$NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
!$$$SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!$$$
COMMON /ppmf2c_data/ ppm_default_comm
COMMON /ppm_f2c_data/ ppm_default_comm
! Local Variables:
! mode: Fortran
! license-project-url: "https://www.dkrz.de/redmine/projects/show/scales-ppm"
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment