core.c 4.14 KB
Newer Older
1
2
3
/**
 * @file core.c
 * @brief interface to user-adjustable core routines of scales ppm
4
 *
Thomas Jahns's avatar
Thomas Jahns committed
5
 * @copyright  (C)  2010,2011,2012  Thomas Jahns <jahns@dkrz.de>
6
 *
7
8
9
 * @author Thomas Jahns <jahns@dkrz.de>
 */
/*
10
11
 * Keywords: ScalES PPM error handling
 * Maintainer: Thomas Jahns <jahns@dkrz.de>
Thomas Jahns's avatar
Thomas Jahns committed
12
 * URL: https://www.dkrz.de/redmine/projects/scales-ppm
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are  permitted provided that the following conditions are
 * met:
 *
 * Redistributions of source code must retain the above copyright notice,
 * this list of conditions and the following disclaimer.
 *
 * 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.
 *
 * Neither the name of the DKRZ GmbH 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 OWNER
 * 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.
 *
 * Commentary:
 *
 * The code in this file should be restricted to handle those parts
 * the user program should keep as much control about as possible,
 * like
 *
 * - error handling
 * - file handling
 *
 * Thus the facilities provided here should always come with hooks
 * for user-provided mechanisms.
 *
 * Code:
54
55
 */
#ifdef HAVE_CONFIG_H
56
#  include <config.h>
57
#endif
58
#include <stdio.h>
59
60
61
62
63
64
65
66
67
68
69
#include <stdlib.h>
#ifndef WITHOUT_FORTRAN
#  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
70
71
72
73
#  if defined __GNUC__
#    undef COMMON_BLOCK_DEF
#    define COMMON_BLOCK_DEF(DEFINITION, NAME) extern DEFINITION NAME __attribute__((aligned(16),common))
#  endif
Thomas Jahns's avatar
Thomas Jahns committed
74
#endif
75
#ifdef USE_MPI
76
#  include <mpi.h>
77
78
#endif

79
80
#include "core/ppm_visibility.h"
#include "core/core.h"
81
#include "core/symprefix.h"
82

83
MPI_Comm SymPrefix(default_comm) = MPI_COMM_WORLD;
84

85
86
#ifndef WITHOUT_FORTRAN
#define F2C_Data COMMON_BLOCK(SYMPREFIX(F2C_DATA),symprefix(f2c_data))
87
88

typedef struct
89
{
Thomas Jahns's avatar
Thomas Jahns committed
90
91
  MPI_Fint symprefix(default_comm);
} SymPrefix(F2C_Def);
92

93
COMMON_BLOCK_DEF(SymPrefix(F2C_Def),F2C_Data);
94

95
96
97
98
SymPrefix(F2C_Def) F2C_Data
#  if defined __GNUC__
                   __attribute__((aligned(16),common))
#  endif
99
#endif
100
                   ;
101
102
void
SymPrefix(set_default_comm)(MPI_Comm comm)
103
{
104
#ifndef WITHOUT_FORTRAN
105
  MPI_Fint comm_f;
106
#  if defined(USE_MPI)
107
  comm_f = MPI_Comm_c2f(comm);
108
#  else
109
  comm_f = comm;
110
111
#  endif
  F2C_Data.symprefix(default_comm) = comm_f;
112
#endif
Thomas Jahns's avatar
Thomas Jahns committed
113
  SymPrefix(default_comm) = comm;
114
115
116
}

void
117
SymPrefix(abort_default)(MPI_Comm comm, const char *msg, const char *source, int line)
118
{
119
  fprintf(stderr, "Fatal error in %s, line %d: %s\n", source, line, msg);
120
#ifdef USE_MPI
121
122
123
#if defined (__xlC__) && defined (_AIX)
#pragma omp critical
#endif
Thomas Jahns's avatar
Thomas Jahns committed
124
  if (SymPrefix(mpi_calls_are_allowed)())
125
    MPI_Abort(comm, 1);
126
127
  else
    abort();
128
129
#else
  (void)comm;
130
#endif
131
  abort();
132
133
}

134
SymPrefix(abort_func) SymPrefix(abort) = SymPrefix(abort_default);
135

136
void
Thomas Jahns's avatar
Thomas Jahns committed
137
SymPrefix(restore_default_abort_handler)(void)
138
{
139
  SymPrefix(abort) = SymPrefix(abort_default);
140
141
}

142
143
/*
 * Local Variables:
Thomas Jahns's avatar
Thomas Jahns committed
144
 * license-project-url: "https://www.dkrz.de/redmine/projects/scales-ppm"
145
 * license-markup: "doxygen"
146
147
148
 * license-default: "bsd"
 * End:
 */