1
2
3
4
5
6
7
8
9
10
11
12
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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
|
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "cctk.h"
#include "cctk_parameters.h"
#include "cctk_WarnLevel.h"
#include "cctk_FortranString.h"
#include "StoreNamedData.h"
static pNamedData *LinConfMetricSolverDB;
static pNamedData *LinMetricSolverDB;
static pNamedData *LinFlatSolverDB;
static pNamedData *BrBrConfMetricSolverDB;
static pNamedData *PolyConfMetricSolverDB;
#define ELLBASE_NOSOLVER 1
#define ELLBASE_OK 0
/*########## Elliptic Equation class: LinEllConfMetric */
/* Registers the Equation class wrapper (the function which is called for a
specific class of problems by passing all the necessay arguments PLUS
the name of the desired solver */
void Ell_LinConfMetricRegistry(void (*function), const char *sname) {
StoreNamedData(&LinConfMetricSolverDB,sname,(void*)function);
}
/* The Equation class wrapper, for the ellitpic class LinConfMetric
(linar elliptic problem that requires the metric plus a
conformal factor). It derives the function to call from the
passed registration name of the solver "sname".
Specifically it takes:
grid hierarchy, integer array of the metric+conf.factor indeces,
field index, Mindex, Nindex, real array for absolute tolerances
and relative tolerances, the registration name of the solver */
int Ell_LinConfMetricSolver(cGH *GH, int *MetricPsi, int FieldIndex,
int MIndex, int NIndex,
CCTK_REAL *AbsTol, CCTK_REAL *RelTol,
const char *sname) {
/* prototype for the equation class wrapper */
void (*fn)(cGH *GH,int *MetricPsi, int FieldIndex,
int MIndex, int NIndex,
CCTK_REAL *AbsTol, CCTK_REAL *RelTol);
/* derive the fucntion name from the requested name and hope it is there */
fn = (void(*))GetNamedData(LinConfMetricSolverDB,sname);
if (!fn) {
CCTK_WARN(2,"Cannot find solver! ");
return(ELLBASE_NOSOLVER);
}
/* Call the solver and pass through all the necessary arguments */
fn(GH, MetricPsi, FieldIndex, MIndex, NIndex, AbsTol, RelTol);
return(ELLBASE_OK);
}
/* Fortran wrappr for the routine Ell_LinConfMetricSolver */
void FMODIFIER FORTRAN_NAME(Ell_LinConfMetricSolver)
(int *ierr, cGH *GH, int *MetricPsi, int *FieldIndex,
int *MIndex, int *NIndex, CCTK_REAL *AbsTol, CCTK_REAL *RelTol, ONE_FORTSTRING_ARG) {
ONE_FORTSTRING_CREATE(sname);
*ierr = Ell_LinConfMetricSolver(GH, MetricPsi, *FieldIndex, *MIndex, *NIndex,
AbsTol, RelTol, sname);
free(sname);
}
/*########## Elliptic Equation class: LinEllMetric */
void Ell_LinMetricRegistry(void (*function), const char *sname) {
StoreNamedData(&LinMetricSolverDB,sname,(void*)function);
}
int Ell_LinMetricSolver(cGH *GH, int *Metric, int FieldIndex,
int MIndex, int NIndex, CCTK_REAL *AbsTol, CCTK_REAL *RelTol, const char *sname) {
void (*fn)(cGH *GH,int *Metric, int FieldIndex,
int MIndex, int NIndex, CCTK_REAL *AbsTol, CCTK_REAL *RelTol);
fn = (void(*))GetNamedData(LinMetricSolverDB,sname);
if (!fn) {
CCTK_WARN(2,"Cannot find solver! ");
return(ELLBASE_NOSOLVER);
}
fn(GH, Metric, FieldIndex, MIndex, NIndex, AbsTol, RelTol);
return(ELLBASE_OK);
}
void FMODIFIER FORTRAN_NAME(Ell_LinMetricSolver)
(int *ierr, cGH *GH, int *Metric, int *FieldIndex,
int *MIndex, int *NIndex, CCTK_REAL *AbsTol, CCTK_REAL *RelTol, ONE_FORTSTRING_ARG) {
ONE_FORTSTRING_CREATE(sname);
*ierr = Ell_LinMetricSolver(GH, Metric, *FieldIndex, *MIndex, *NIndex, AbsTol, RelTol, sname);
free(sname);
}
/*########## Elliptic Equation class: LinEllFlat */
void Ell_LinFlatRegistry(void (*function), const char *sname) {
StoreNamedData(&LinFlatSolverDB,sname,(void*)function);
}
int Ell_LinFlatSolver(cGH *GH, int FieldIndex, int MIndex, int NIndex,
CCTK_REAL *AbsTol, CCTK_REAL *RelTol, const char *sname) {
void (*fn)(cGH *GH, int FieldIndex, int MIndex, int NIndex,
CCTK_REAL *AbsTol, CCTK_REAL *RelTol);
fn = (void(*))GetNamedData(LinFlatSolverDB,sname);
if (!fn) {
CCTK_WARN(2,"Cannot find solver! ");
return(ELLBASE_NOSOLVER);
}
fn(GH, FieldIndex, MIndex, NIndex, AbsTol, RelTol);
return(ELLBASE_OK);
}
void FMODIFIER FORTRAN_NAME(Ell_LinFlatSolver)
(int *ierr, cGH *GH, int *FieldIndex,
int *MIndex, int *NIndex, CCTK_REAL *AbsTol, CCTK_REAL *RelTol, ONE_FORTSTRING_ARG) {
ONE_FORTSTRING_CREATE(sname);
*ierr = Ell_LinFlatSolver(GH, *FieldIndex, *MIndex, *NIndex, AbsTol, RelTol, sname);
free(sname);
}
/*########## Elliptic Equation class: BrBrConfMetric
(Brandt-Bruemann Data with conformal metric) */
void Ell_BrBrConfMetricRegistry(void (*function), const char *sname) {
StoreNamedData(&BrBrConfMetricSolverDB,sname, (void*)function);
}
int Ell_BrBrConfMetricSolver(cGH *GH, int *MetricPsi, int FieldIndex,
int MIndex, int NIndex,
CCTK_REAL *AbsTol, CCTK_REAL *RelTol,
const char *sname) {
void (*fn)(cGH *GH,int *MetricPsi, int FieldIndex, int MIndex, int NIndex,
CCTK_REAL *AbsTol, CCTK_REAL *RelTol);
fn = (void(*))GetNamedData(BrBrConfMetricSolverDB,sname);
if (!fn) {
CCTK_WARN(2,"Cannot find solver! ");
return(ELLBASE_NOSOLVER);
}
fn(GH, MetricPsi, FieldIndex, MIndex, NIndex, AbsTol, RelTol);
return(ELLBASE_OK);
}
void FMODIFIER FORTRAN_NAME(Ell_BrBrConfMetricSolver)
(int *ierr, cGH *GH, int *MetricPsi, int *FieldIndex,
int *MIndex, int *NIndex, CCTK_REAL *AbsTol, CCTK_REAL *RelTol, ONE_FORTSTRING_ARG) {
ONE_FORTSTRING_CREATE(sname);
*ierr = Ell_BrBrConfMetricSolver(GH, MetricPsi, *FieldIndex, *MIndex, *NIndex,
AbsTol, RelTol, sname);
free(sname);
}
/*########## Elliptic Equation class: PolyConfMetric */
void Ell_PolyConfMetricRegistry(void (*function), const char *sname) {
StoreNamedData(&PolyConfMetricSolverDB,sname, (void*)function);
}
int Ell_PolyConfMetricSolver(cGH *GH, int *MetricPsi, int FieldIndex,
int *PIndex, int Pcount, CCTK_REAL *AbsTol, CCTK_REAL *RelTol,
const char *sname) {
void (*fn)(cGH *GH,int *MetricPsi, int FieldIndex, int *PIndex, int Pcount,
CCTK_REAL *AbsTol, CCTK_REAL *RelTol);
fn = (void(*))GetNamedData(PolyConfMetricSolverDB,sname);
if (!fn) {
CCTK_WARN(2,"Cannot find solver! ");
return(ELLBASE_NOSOLVER);
}
fn(GH, MetricPsi, FieldIndex, PIndex, Pcount, AbsTol, RelTol);
return(ELLBASE_OK);
}
void FMODIFIER FORTRAN_NAME(Ell_PolyConfMetricSolver)
(int *ierr, cGH *GH, int *MetricPsi, int *FieldIndex,
int *PIndex, int *Pcount, CCTK_REAL *AbsTol, CCTK_REAL *RelTol, ONE_FORTSTRING_ARG) {
ONE_FORTSTRING_CREATE(sname);
*ierr = Ell_PolyConfMetricSolver(GH, MetricPsi, *FieldIndex, PIndex, *Pcount,
AbsTol, RelTol, sname);
free(sname);
}
|
