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
|
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "cctk.h"
#include "cctk_parameters.h"
#include "cctk_FortranString.h"
#include "StoreNamedData.h"
static pNamedData *LinConfMetricSolverDB;
static pNamedData *LinMetricSolverDB;
static pNamedData *LinFlatSolverDB;
/*########## 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 */
void 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,
int *AbsTol, int *RelTol);
/* derive the fucntion name from the requested name and hope it is there */
fn = (void(*))GetNamedData(LinConfMetricSolverDB,sname);
if (!fn) CCTK_WARN(0,"Cannot find solver! ");
/* Call the solver and pass through all the necessary arguments */
fn(GH, MetricPsi, FieldIndex, MIndex, NIndex, AbsTol, RelTol);
}
/* Fortran wrappr for the routine Ell_LinConfMetricSolver */
void FMODIFIER FORTRAN_NAME(Ell_LinConfMetricSolver)
(cGH *GH, int *MetricPsi, int *FieldIndex,
int *MIndex, int *NIndex, int *AbsTol, int *RelTol, ONE_FORTSTRING_ARG) {
ONE_FORTSTRING_CREATE(sname);
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);
}
void Ell_LinMetricSolver(cGH *GH, int *Metric, int *FieldIndex,
int *MIndex, int *NIndex, int *AbsTol, int *RelTol, const char *sname) {
void (*fn)(cGH *GH,int *Metric, int *FieldIndex,
int *MIndex, int *NIndex, int *AbsTol, int *RelTol);
fn = (void(*))GetNamedData(LinMetricSolverDB,sname);
if (!fn) CCTK_WARN(0,"Cannot find solver! ");
fn(GH, Metric, FieldIndex, MIndex, NIndex, AbsTol, RelTol);
}
void FMODIFIER FORTRAN_NAME(Ell_LinMetricSolver)
(cGH *GH, int *Metric, int *FieldIndex,
int *MIndex, int *NIndex, int *AbsTol, int *RelTol, ONE_FORTSTRING_ARG) {
ONE_FORTSTRING_CREATE(sname);
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);
}
void Ell_LinFlatSolver(cGH *GH, int *FieldIndex, int *MIndex, int *NIndex,
int *AbsTol, int *RelTol, const char *sname) {
void (*fn)(cGH *GH, int *FieldIndex, int *MIndex, int *NIndex,
int *AbsTol, int *RelTol);
fn = (void(*))GetNamedData(LinFlatSolverDB,sname);
if (!fn) CCTK_WARN(0,"Cannot find solver! ");
fn(GH, FieldIndex, MIndex, NIndex, AbsTol, RelTol);
}
void FMODIFIER FORTRAN_NAME(Ell_LinFlatSolver)
(cGH *GH, int *FieldIndex,
int *MIndex, int *NIndex, int *AbsTol, int *RelTol, ONE_FORTSTRING_ARG) {
ONE_FORTSTRING_CREATE(sname);
Ell_LinFlatSolver(GH, FieldIndex, MIndex, NIndex, AbsTol, RelTol, sname);
free(sname);
}
|
