double Epsi(double snr)
{
double val;
val = 2 + snr*snr - (PI/8)*exp(-(snr*snr)/2)*((2+snr*snr)*bessi0((snr*snr)/4) +
(snr*snr)*bessi1((snr*snr)/4))*((2+snr*snr)*bessi0((snr*snr)/4) + (snr*snr)*bessi1((snr*snr)/4));
if (val<0.001) val = 1;
if (val>10) val = 1;
return val;
}
/* Value of a blob --------------------------------------------------------- */
double kaiser_value(double r, double a, double alpha, int m)
{
double rda, rdas, arg, w;
rda = r / a;
if (rda <= 1.0)
{
rdas = rda * rda;
arg = alpha * sqrt(1.0 - rdas);
if (m == 0)
{
w = bessi0(arg) / bessi0(alpha);
}
else if (m == 1)
{
w = sqrt (1.0 - rdas);
if (alpha != 0.0)
w *= bessi1(arg) / bessi1(alpha);
}
else if (m == 2)
{
w = sqrt (1.0 - rdas);
w = w * w;
if (alpha != 0.0)
w *= bessi2(arg) / bessi2(alpha);
}
else if (m == 3)
{
w = sqrt (1.0 - rdas);
w = w * w * w;
if (alpha != 0.0)
w *= bessi3(arg) / bessi3(alpha);
}
else if (m == 4)
{
w = sqrt (1.0 - rdas);
w = w * w * w *w;
if (alpha != 0.0)
w *= bessi4(arg) / bessi4(alpha);
}
else
REPORT_ERROR(ERR_VALUE_INCORRECT, "m out of range in kaiser_value()");
}
else
w = 0.0;
return w;
}
double bessk1(double x)
{
double t, tt, ti, u;
if (x < 0.0){
fprintf(stderr, "bessk1(%g): negative argument", x);
exit(1);
}
t = x / 2.0;
if (t < 1.0) {
tt = t * t;
u = 1.0 +
tt * (0.15443144 +
tt * (-0.67278579 +
tt * (-0.18156897 +
tt * (-0.01919402 +
tt * (-0.00110404 +
tt * -0.00004686)))));
return (u / x + log(t) * bessi1(x));
} else {
ti = 1.0 / t;
u = 1.25331414 +
ti * (0.23498619 +
ti * (-0.03655620 +
ti * (0.01504268 +
ti * (-0.00780353 +
ti * (0.00325614 +
ti * -0.00068245)))));
return (u * exp(-x) / sqrt(x));
}
}
local real gdisk(real rad)
{
real x;
x = 0.5 * alpha * rad;
return - alpha*alpha * mdisk * x *
(bessi0(x) * bessk0(x) - bessi1(x) * bessk1(x));
}
void potential_double(int *ndim,double *pos,double *acc,double *pot,double *time)
{
double apar, qpar, spar, ppar, lpar, rpar, rcyl;
int i;
// 20070312 bwillett added ppar - the plummer denominator: r + rc = sqrt(x^2+y^2+z^2) + rc
// 20070312 bwillett added lpar - the logarithmic argument: R^2 + (z/q)^2 + d^2
// 20070427 bwillett added rpar - the spherical radius: r + rc - rc = ppar - plu_rc
// 20070501 bwillett added apar - a + qpar
// 20070507 bwillett took out pow statements
// 20070507 bwillett used hypot from math.h
rcyl = hypot(pos[X],pos[Y]);
ppar = sqrt ((pos[X]*pos[X])+(pos[Y]*pos[Y])+(pos[Z]*pos[Z])) + plu_rc;
rpar = ppar - plu_rc;
lpar = (rcyl*rcyl) + ((pos[Z]/q)*(pos[Z]/q)) + (d*d);
// This is only valid for 3 dimensions, and is in (x,y,z)
// Recall F_mu = -grad_mu U
// So a_mu = -grad_mu Phi
// I did these derivatives in Mathematica, and will try to keep it consistent with the conventions written above
acc[X] = - ( ( (2.0*vhalo*vhalo*pos[X])/(lpar) ) + ( (plu_mass*pos[X])/(rpar*ppar*ppar) ) );
acc[Y] = - ( ( (2.0*vhalo*vhalo*pos[Y])/(lpar) ) + ( (plu_mass*pos[Y])/(rpar*ppar*ppar) ) );
acc[Z] = - ( ( (2.0*vhalo*vhalo*pos[Z])/(lpar) ) + ( (plu_mass*pos[Z])/(rpar*ppar*ppar) ) );
// Copied from expdisk.c
double r2, r, arg, i0, k0, i1, k1, f;
double alpha;
alpha = 1.0/a;
r = rpar;
r2 = r*r;
arg = 0.5*alpha*r;
//printf("%f %f %f %f %f\n", a, mass, r, r2, x);
i0=bessi0(arg);
k0=bessk0(arg);
i1=bessi1(arg);
k1=bessk1(arg);
// 20080928 - willeb added exponential disk to acceleration field
*pot = -mass*arg*(i0*k1-i1*k0);
f = -0.5*alpha*alpha*alpha*mass*(i0*k0-i1*k1);
acc[X] += f*pos[X];
acc[Y] += f*pos[Y];
acc[Z] += f*pos[Z];
// 20080928 - willeb added bulge and halo to potential
*pot += (-(plu_mass)/ppar);
*pot += (vhalo*vhalo*log(lpar));
}
/* Bessel function I_n (x), n = 0, 1, 2, ...
Use ONLY for small values of n */
double i_n(int n, double x)
{
int i;
double i_ns1, i_n, i_np1;
if (n == 0)
return bessi0(x);
if (n == 1)
return bessi1(x);
if (x == 0.0)
return 0.0;
i_ns1 = bessi0(x);
i_n = bessi1(x);
for (i = 1; i < n; i++)
{
i_np1 = i_ns1 - (2 * i) / x * i_n;
i_ns1 = i_n;
i_n = i_np1;
}
return i_n;
}
float bessk1(float x)
{
float bessi1(float x);
double y,ans;
if (x <= 2.0) {
y=x*x/4.0;
ans=(log(x/2.0)*bessi1(x))+(1.0/x)*(1.0+y*(0.15443144
+y*(-0.67278579+y*(-0.18156897+y*(-0.1919402e-1
+y*(-0.110404e-2+y*(-0.4686e-4)))))));
} else {
y=2.0/x;
ans=(exp(-x)/sqrt(x))*(1.25331414+y*(0.23498619
+y*(-0.3655620e-1+y*(0.1504268e-1+y*(-0.780353e-2
+y*(0.325614e-2+y*(-0.68245e-3)))))));
}
return ans;
}
/* Value of line integral through Kaiser-Bessel radial function
(n >=2 dimensions) at distance s from center of function.
Parameter m = 0, 1, or 2. */
double kaiser_proj(double s, double a, double alpha, int m)
{
double sda, sdas, w, arg, p;
sda = s / a;
sdas = sda * sda;
w = 1.0 - sdas;
if (w > 1.0e-10)
{
arg = alpha * sqrt(w);
if (m == 0)
{
if (alpha == 0.0)
p = 2.0 * a * sqrt(w);
else
p = (2.0 * a / alpha) * sinh(arg) / bessi0(alpha);
}
else if (m == 1)
{
if (alpha == 0.0)
p = 2.0 * a * w * sqrt(w) * (2.0 / 3.0);
else
p = (2.0 * a / alpha) * sqrt(w) * (cosh(arg) - sinh(arg) / arg)
/ bessi1(alpha);
}
else if (m == 2)
{
if (alpha == 0.0)
p = 2.0 * a * w * w * sqrt(w) * (8.0 / 15.0);
else
p = (2.0 * a / alpha) * w *
((3.0 / (arg * arg) + 1.0) * sinh(arg) - (3.0 / arg) * cosh(arg)) / bessi2(alpha);
}
else
REPORT_ERROR(ERR_VALUE_INCORRECT, "m out of range in kaiser_proj()");
}
else
p = 0.0;
return p;
}
void potential_dummy_for_c(void)
{
double a,b,c;
int spline();
double bessi0(), bessk0(), bessi1(), bessk1();
void get_atable();
void read_image();
error("potential.c: Cannot call dummy_for_c - included to fool linkers");
(void) spline();
(void) bessi0();
(void) bessk0();
(void) bessi1();
(void) sqr(1.0);
stropen("/dev/null","w");
#ifndef NO_IMAGE
read_image();
#endif
get_atable();
}
double bessi3(double x)
{
return (x == 0) ? 0 : bessi1(x) - ((2 * 2) / x) * bessi2(x);
}
double bessi2(double x)
{
return (x == 0) ? 0 : bessi0(x) - ((2 * 1) / x) * bessi1(x);
}
void __R_bessi1(double *x,int *expon,double *val){
if(*expon)
*val = bessi1_expon(*x);
else
*val = bessi1(*x);
}
