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
|
SetEnhancedTimes[False];
SetSourceLanguage["C"];
(******************************************************************************)
(* Derivatives *)
(******************************************************************************)
derivOrder = 4;
derivatives =
{PDstandardNth[i_] ->
StandardCenteredDifferenceOperator[1,derivOrder/2,i],
PDstandardNth[i_, i_] ->
StandardCenteredDifferenceOperator[2,derivOrder/2,i],
PDstandardNth[i_, j_] ->
StandardCenteredDifferenceOperator[1,derivOrder/2,i]
StandardCenteredDifferenceOperator[1,derivOrder/2,j]};
FD = PDstandardNth;
ResetJacobians;
DefineJacobian[PD, FD, KD, Zero3];
evolutionTimelevels = 2;
KD = KroneckerDelta;
(******************************************************************************)
(* Tensors *)
(******************************************************************************)
(* Register the tensor quantities with the TensorTools package *)
Map[DefineTensor, {u, rho, eps}];
(******************************************************************************)
(* Groups *)
(******************************************************************************)
evolvedGroups =
{SetGroupName[CreateGroupFromTensor[u ], "WT_u" ],
SetGroupName[CreateGroupFromTensor[rho], "WT_rho"]};
evaluatedGroups =
{SetGroupName[CreateGroupFromTensor[eps], "WT_eps"]};
declaredGroups = Join[evolvedGroups, evaluatedGroups];
declaredGroupNames = Map[First, declaredGroups];
extraGroups =
{{"grid::coordinates", {x, y, z, r}}};
groups = declaredGroups;
(******************************************************************************)
(* Initial data *)
(******************************************************************************)
initialCalcGaussian =
{Name -> "WT_Gaussian",
Schedule -> {"AT initial"},
ConditionalOnKeyword -> {"initial_data", "Gaussian"},
Equations ->
{u -> amplitude Exp[-(1/2) (r/width)^2],
rho -> 0}};
initialCalcStanding =
{Name -> "WT_Standing",
Schedule -> {"AT initial"},
ConditionalOnKeyword -> {"initial_data", "Standing"},
Shorthands -> {k, omega},
Equations ->
{k -> Pi / width,
omega -> Sqrt[3 k^2],
u -> amplitude Cos[k x] Cos[k y] Cos[k z] Cos[omega t],
rho -> amplitude Cos[k x] Cos[k y] Cos[k z] Sin[omega t] (-omega)}};
(******************************************************************************)
(* Evolution equations *)
(******************************************************************************)
evolCalc =
{Name -> "WT_RHS",
Schedule -> {"IN MoL_CalcRHS" (*"AT analysis"*)},
Where -> Interior,
Equations ->
{dot[u] -> rho,
dot[rho] -> KD[ua,ub] PD[u,la,lb]}};
(******************************************************************************)
(* Boundary conditions *)
(******************************************************************************)
boundaryCalc =
{Name -> "WT_Dirichlet",
Schedule -> {"IN MoL_CalcRHS", "AT analysis"},
Where -> Boundary,
Equations ->
{dot[u] -> 0,
dot[rho] -> 0}};
(******************************************************************************)
(* Energy *)
(******************************************************************************)
energyCalc =
{Name -> "WT_Energy",
Schedule -> {"AT analysis"},
Where -> Interior,
Equations ->
{eps -> 1/2 (rho^2 + KD[ua,ub] PD[u,la] PD[u,lb])}};
energyBoundaryCalc =
{Name -> "WT_EnergyBoundary",
Schedule -> {"AT analysis"},
Where -> Boundary,
Equations ->
{eps -> 0}};
(******************************************************************************)
(* Parameters *)
(******************************************************************************)
keywordParameters =
{{Name -> "initial_data",
AllowedValues -> {"Gaussian", "Standing"},
Default -> "Gaussian"}};
realParameters =
{{Name -> amplitude,
Description -> "Amplitude of initial Gaussian",
Default -> 1},
{Name -> width,
Description -> "Width of initial Gaussian",
Default -> 1}};
(******************************************************************************)
(* Construct the thorns *)
(******************************************************************************)
calculations =
{initialCalcGaussian, initialCalcStanding,
evolCalc, boundaryCalc,
energyCalc, energyBoundaryCalc};
CreateKrancThornTT[
groups, ".", "ML_WaveToy",
Calculations -> calculations,
DeclaredGroups -> declaredGroupNames,
PartialDerivatives -> derivatives,
UseLoopControl -> True,
UseVectors -> True,
EvolutionTimelevels -> evolutionTimelevels,
KeywordParameters -> keywordParameters,
RealParameters -> realParameters];
renameCalc[calc_, oldprefix_, newprefix_] := Module[
{name, newname, newcalc},
name = lookup[calc, Name];
newname = StringReplace[name,
RegularExpression["^" <> oldprefix] -> newprefix];
newcalc = mapReplace[calc, Name, newname];
newcalc];
CreateKrancThornTT[
groups, ".", "ML_WaveToy_CL",
Calculations -> Map[renameCalc[#, "WT_", "WT_CL_"]&, calculations],
DeclaredGroups -> declaredGroupNames,
PartialDerivatives -> derivatives,
UseLoopControl -> True,
UseOpenCL -> True,
UseVectors -> True,
EvolutionTimelevels -> evolutionTimelevels,
KeywordParameters -> keywordParameters,
RealParameters -> realParameters];
|