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
|
#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;
#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);
}
|
