/* Fourier value of a blob ------------------------------------------------- */
double kaiser_Fourier_value(double w, double a, double alpha, int m)
{
if (m != 2 && m !=0)
REPORT_ERROR(ERR_VALUE_INCORRECT, "m out of range in kaiser_Fourier_value()");
double sigma = sqrt(ABS(alpha * alpha - (2. * PI * a * w) * (2. * PI * a * w)));
if (m == 2)
{
if (2.*PI*a*w > alpha)
return pow(2.*PI, 3. / 2.)*pow(a, 3.)*pow(alpha, 2.)*bessj3_5(sigma)
/ (bessi0(alpha)*pow(sigma, 3.5));
else
return pow(2.*PI, 3. / 2.)*pow(a, 3.)*pow(alpha, 2.)*bessi3_5(sigma)
/ (bessi0(alpha)*pow(sigma, 3.5));
}
else if (m == 0)
{
if (2*PI*a*w > alpha)
return pow(2.*PI, 3. / 2.)*pow(a, 3)*bessj1_5(sigma)
/ (bessi0(alpha)*pow(sigma, 1.5));
else
return pow(2.*PI, 3. / 2.)*pow(a, 3)*bessi1_5(sigma)
/ (bessi0(alpha)*pow(sigma, 1.5));
}
else
REPORT_ERROR(ERR_ARG_INCORRECT,"Invalid blob order");
}
real_t nonexpbessi0(real_t x)
{
if (x == 0.0) return 1.0;
if (fabs(x) <= 15.0) {
real_t bessi0(real_t);
return exp(-fabs(x))*bessi0(x);
} else {
int i;
real_t sqrtx,br,br1,br2,z,z2,numerator,denominator;
static real_t ar1[4]={0.2439260769778, -0.115591978104435e3,
0.784034249005088e4, -0.143464631313583e6};
static real_t ar2[4]={1.0, -0.325197333369824e3,
0.203128436100794e5, -0.361847779219653e6};
x=fabs(x);
sqrtx=sqrt(x);
br1=br2=0.0;
z=30.0/x-1.0;
z2=z+z;
for (i=0; i<=3; i++) {
br=z2*br1-br2+ar1[i];
br2=br1;
br1=br;
}
numerator=z*br1-br2+0.346519833357379e6;
br1=br2=0.0;
for (i=0; i<=3; i++) {
br=z2*br1-br2+ar2[i];
br2=br1;
br1=br;
}
denominator=z*br1-br2+0.865665274832055e6;
return (numerator/denominator)/sqrtx;
}
}
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;
}
float bessi(int n, float x)
{
float bessi0(float x);
void nrerror(char error_text[]);
int j;
float bi,bim,bip,tox,ans;
if (n < 2) nrerror("Index n less than 2 in bessi");
if (x == 0.0)
return 0.0;
else {
tox=2.0/fabs(x);
bip=ans=0.0;
bi=1.0;
for (j=2*(n+(int) sqrt(ACC*n));j>0;j--) {
bim=bip+j*tox*bi;
bip=bi;
bi=bim;
if (fabs(bi) > BIGNO) {
ans *= BIGNI;
bi *= BIGNI;
bip *= BIGNI;
}
if (j == n) ans=bip;
}
ans *= bessi0(x)/bi;
return x < 0.0 && (n & 1) ? -ans : ans;
}
}
double bessk0(double x)
{
double t, tt, ti, u;
if (x < 0.0){
fprintf(stderr, "bessk0(%g): negative argument", x);
exit(1);
}
t = x / 2.0;
if (t < 1.0) {
tt = t * t;
u = -0.57721566 +
tt * (0.42278420 +
tt * (0.23069756 +
tt * (0.03488590 +
tt * (0.00262698 +
tt * (0.00010750 +
tt * 0.00000740)))));
return (u - log(t) * bessi0(x));
} else {
ti = 1.0 / t;
u = 1.25331414 +
ti * (-0.07832358 +
ti * (0.02189568 +
ti * (-0.01062446 +
ti * (0.00587872 +
ti * (-0.00251540 +
ti * 0.00053208)))));
return (u * exp(-x) / sqrt(x));
}
}
static Real BesselK(const int order,const Real x)
{
Real y,ans;
if (order==0) {
if (x <= 2.0) {
y=x*x/4.0;
ans=(-log(x/2.0)*bessi0(x))+(-0.57721566+y*(0.42278420 +y*(0.23069756+y*(0.3488590e-1+y*(0.262698e-2 +y*(0.10750e-3+y*0.74e-5))))));
}
else {
y=2.0/x;
ans=(exp(-x)/sqrt(x))*(1.25331414+y*(-0.7832358e-1 +y*(0.2189568e-1+y*(-0.1062446e-1+y*(0.587872e-2 +y*(-0.251540e-2+y*0.53208e-3))))));
}
}
// if (order == 1) {
// 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)))))));
// }
// }
// if (order !=1 || order !-0) ans=0;
return ans;
}
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));
}
double kaiser_Fourier_value(double w, double a, double alpha, int m)
{
double sigma = sqrt(abs(alpha * alpha - (PI2 * a * w) * (PI2 * a * w)));
if (m == 2)
{
if (PI2 * a * w > alpha)
return pow(PI2, 1.5) * pow(a, 3.) * pow(alpha, 2.) * bessj3_5(sigma) / (bessi0(alpha) * pow(sigma, 3.5));
else
return pow(PI2, 1.5) * pow(a, 3.) * pow(alpha, 2.) * bessi3_5(sigma) / (bessi0(alpha) * pow(sigma, 3.5));
}
else if (m == 0)
{
if (PI2 * a * w > alpha)
return pow(PI2, 1.5) * pow(a, 3.) * bessj1_5(sigma) / (bessi0(alpha)*pow(sigma, 1.5));
else
return pow(PI2, 1.5) * pow(a, 3.) * bessi1_5(sigma) / (bessi0(alpha)*pow(sigma, 1.5));
}
else
throw;
}
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;
}
/* 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();
}
int main(void)
{
char txt[MAXSTR];
int i,nval;
float val,x;
FILE *fp;
if ((fp = fopen("fncval.dat","r")) == NULL)
nrerror("Data file fncval.dat not found\n");
fgets(txt,MAXSTR,fp);
while (strncmp(txt,"Modified Bessel Function I0",27)) {
fgets(txt,MAXSTR,fp);
if (feof(fp)) nrerror("Data not found in fncval.dat\n");
}
fscanf(fp,"%d %*s",&nval);
printf("\n%s\n",txt);
printf("%5s %12s %13s \n","x","actual","bessi0(x)");
for (i=1;i<=nval;i++) {
fscanf(fp,"%f %f",&x,&val);
printf("%6.2f %12.7f %12.7f\n",x,val,bessi0(x));
}
fclose(fp);
return 0;
}
void __R_bessi0(double *x,int *expon,double *val){
if(*expon)
*val = bessi0_expon(*x);
else
*val = bessi0(*x);
}
double bessi2(double x)
{
return (x == 0) ? 0 : bessi0(x) - ((2 * 1) / x) * bessi1(x);
}
int main(int argc, char const *argv[])
{
for(int n=5;n<=35;n+=5)
{
FILE *fp;
if(n==5)fp=fopen("n5.dat","w");
if(n==10)fp=fopen("n10.dat","w");
if(n==15)fp=fopen("n15.dat","w");
if(n==20)fp=fopen("n20.dat","w");
if(n==25)fp=fopen("n25.dat","w");
if(n==30)fp=fopen("n30.dat","w");
if(n==35)fp=fopen("n35.dat","w");
int m=n+1;
float* x1=vector(1,n);
float* w1=vector(1,n);
float* x2=vector(1,m);
float* w2=vector(1,m);
gauher(x1,w1,n);
gauher(x2,w2,m);
for(float x20=0.0;x20<=6.0;x20+=0.1)
{
float sigma=1/sqrt(2);
float iloczyn=pow(x20,2)/(8*pow(sigma,2));
float Vdok=pow(2*atan(1)*4,2)*pow(sigma,4)*sqrt(atan(1)*4)/(2*sigma)*exp(-iloczyn)*bessi0(iloczyn);
float Vnum=0;
for(int k1=1;k1<=n;++k1)
for(int m1=1;m1<=n;++m1)
for(int k2=1;k2<=m;++k2)
for(int m2=1;m2<=m;++m2)
{
float mianownik=(sqrt(pow(x1[k1]-x2[k2]-x20,2)+pow(x1[m1]-x2[m2],2)));
Vnum+=(w1[k1]*w1[m1]*w2[k2]*w2[m2])/mianownik;
};
fprintf(fp, "%10.8f %10.8f %10.8f %10.8f\n",x20,Vdok,Vnum,fabs((Vdok-Vnum)/Vdok) );
printf("%10.8f %10.8f %10.8f %10.8f\n",x20,Vdok,Vnum,fabs((Vdok-Vnum)/Vdok)) ;
}
free_vector(x1,1,n);
free_vector(w1,1,n);
free_vector(x2,1,m);
free_vector(w2,1,m);
fclose(fp);
}
return 0;
}
static void
func(const XC(mgga_type) *p, FLOAT x, FLOAT t, FLOAT u, int order,
FLOAT *f, FLOAT *vrho0, FLOAT *dfdx, FLOAT *dfdt, FLOAT *dfdu,
FLOAT *d2fdx2, FLOAT *d2fdt2, FLOAT *d2fdu2, FLOAT *d2fdxt, FLOAT *d2fdxu, FLOAT *d2fdtu)
{
FLOAT y;
FLOAT vrho, v_PRHG, C;
assert(p != NULL);
C = 0.25*(u - 2.0*t + 0.5*x*x);
y = XC(mgga_x_2d_prhg_get_y)(C);
v_PRHG = M_PI*bessi0(y/2.0);
v_PRHG /= X_FACTOR_2D_C;
if (p->info->number == XC_MGGA_X_2D_PRHG07) {
*vrho0 = v_PRHG*(1.0 / 3.0); // This factor is here in order to get the correct potential through work_mgga_x.c
*f = v_PRHG / 2.0;
}
else if (p->info->number == XC_MGGA_X_2D_PRHG07_PRP10) {
*vrho0 = (v_PRHG - ((2.0*M_SQRT2)/(3.0*M_PI))*SQRT(max(t - 0.25*x*x,0.0))/X_FACTOR_2D_C)*(1.0 / 3.0);
*f = *vrho0 * (3.0 / 2.0);
}
else
*vrho0 = 0;
return;
}
/*
* Initialization routine - sets up a lookup table for scaling a sample of data
* by window data. If the lookup table is successfully allocated, its memory
* location and its specified size are stored at the specified memory location
* of the internal context.
* Returns true if initialization succeeded and returns false otherwise.
* The internal context should be freed when it is finished with, by
* window_close().
*/
bool window_init( int i_buffer_size, window_param * p_param,
window_context * p_ctx )
{
float * pf_table = NULL;
window_type wind_type = p_param->wind_type;
if( wind_type != HANN && wind_type != FLATTOP
&& wind_type != BLACKMANHARRIS
&& wind_type != KAISER )
{
/* Assume a rectangular window (i.e. no window) */
i_buffer_size = 0;
goto exit;
}
pf_table = malloc( i_buffer_size * sizeof( *pf_table ) );
if( !pf_table )
{
/* Memory allocation failed */
return false;
}
int i_buffer_size_minus_1 = i_buffer_size - 1;
switch( wind_type )
{
case HANN:
/* Hann window */
for( int i = 0; i < i_buffer_size; i++ )
{
float f_val = (float) i / (float) i_buffer_size_minus_1;
pf_table[i] = 0.5f - 0.5f * cosf( 2.0f * (float) M_PI * f_val );
}
break;
case FLATTOP:
/* Flat top window */
for( int i = 0; i < i_buffer_size; i++ )
{
float f_val = (float) i / (float) i_buffer_size_minus_1;
pf_table[i] = FT_A0
- FT_A1 * cosf( 2.0f * (float) M_PI * f_val )
+ FT_A2 * cosf( 4.0f * (float) M_PI * f_val )
- FT_A3 * cosf( 6.0f * (float) M_PI * f_val )
+ FT_A4 * cosf( 8.0f * (float) M_PI * f_val );
}
break;
case BLACKMANHARRIS:
/* Blackman-Harris window */
for( int i = 0; i < i_buffer_size; i++ )
{
float f_val = (float) i / (float) i_buffer_size_minus_1;
pf_table[i] = BH_A0
- BH_A1 * cosf( 2.0f * (float) M_PI * f_val )
+ BH_A2 * cosf( 4.0f * (float) M_PI * f_val )
- BH_A3 * cosf( 6.0f * (float) M_PI * f_val );
}
break;
case KAISER:
{
/* Kaiser window */
float f_pialph = (float) M_PI * p_param->f_kaiser_alpha;
float f_bessi0_pialph = bessi0( f_pialph );
for( int i = 0; i < i_buffer_size; i++ )
{
float f_val = (float) i / (float) i_buffer_size_minus_1;
float f_term_to_square = 2.0f * f_val - 1.0f;
float f_sqd_term = f_term_to_square * f_term_to_square;
float f_sqr_term = sqrtf( 1.0f - f_sqd_term );
pf_table[i] = bessi0( f_pialph * f_sqr_term ) / f_bessi0_pialph;
}
break;
}
default:
/* We should not reach here */
assert(0);
break;
}
exit:
p_ctx->pf_window_table = pf_table;
p_ctx->i_buffer_size = i_buffer_size;
return true;
}