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
|
#include "cctk.h"
#include "cctk_arguments.h"
#include "cctk_parameters.h"
subroutine UniformCharge(CCTK_FARGUMENTS)
c Find static field for a uniformly charge sphere
c
c That is, solve Nabla^2 phi = - 4 pi rho
c where rho = Q/(4/3 * Pi * R^3)
c where Q is the total charge and R is the sphere radius
implicit none
DECLARE_CCTK_FARGUMENTS
DECLARE_CCTK_PARAMETERS
CCTK_REAL tolerance,pi
CCTK_REAL AbsTol(3), RelTol(3)
integer iphi,iMcoeff,iNcoeff
integer i,j,k
CCTK_REAL charge_factor
pi = 4.0*atan(1.0)
charge_factor = 4.0d0*pi*charge*3.0d0/(4.0d0*pi*radius**3)
tolerance = 1.0d-5
do k=1, cctk_lsh(3)
do j=1, cctk_lsh(2)
do i=1, cctk_lsh(1)
Mcoeff(i,j,k) = 0.0d0
if (r(i,j,k) <= radius) then
Ncoeff(i,j,k) = charge_factor
else
Ncoeff(i,j,k) = 0d0
end if
end do
end do
end do
phi(i,j,k) = 0.0d0
call CCTK_VarIndex (iMcoeff, "idscalarwaveelliptic::Mcoeff")
call CCTK_VarIndex (iNcoeff, "idscalarwaveelliptic::Ncoeff")
call CCTK_VarIndex (iphi,"wavetoy::phi")
write (*,*) iMcoeff, iNcoeff, iphi
AbsTol(1)=1.0d-5
AbsTol(2)=1.0d-5
AbsTol(3)=1.0d-5
RelTol(1)=-1
RelTol(2)=-1
RelTol(3)=-1
c Call to elliptic solver will go here
c call Ell_LinConfMetricSolver(cctkGH,
c $ metpsi_index, afield_index, Mlin_index, Nsrc_index, AbsTol, RelTol,
c $ "petsc")
c Cheat, and use exact solution
do k=1, cctk_lsh(3)
do j=1, cctk_lsh(2)
do i=1, cctk_lsh(1)
if (r(i,j,k) >= radius) then
phi(i,j,k) = charge/r(i,j,k)
else
phi(i,j,k) = charge/(2.0d0*radius**3)*
& (3.0d0*radius**2-r(i,j,k)**2)
end if
c Should put in an option for time symmetric first step
phi_old(i,j,k) = phi(i,j,k)
end do
end do
end do
return
end
|
