void dftint(float (*func)(float), float a, float b, float w, float *cosint,
float *sinint)
{
void dftcor(float w, float delta, float a, float b, float endpts[],
float *corre, float *corim, float *corfac);
void polint(float xa[], float ya[], int n, float x, float *y, float *dy);
void realft(float data[], unsigned long n, int isign);
static int init=0;
int j,nn;
static float aold = -1.e30,bold = -1.e30,delta,(*funcold)(float);
static float data[NDFT+1],endpts[9];
float c,cdft,cerr,corfac,corim,corre,en,s;
float sdft,serr,*cpol,*spol,*xpol;
cpol=vector(1,MPOL);
spol=vector(1,MPOL);
xpol=vector(1,MPOL);
if (init != 1 || a != aold || b != bold || func != funcold) {
init=1;
aold=a;
bold=b;
funcold=func;
delta=(b-a)/M;
for (j=1;j<=M+1;j++)
data[j]=(*func)(a+(j-1)*delta);
for (j=M+2;j<=NDFT;j++)
data[j]=0.0;
for (j=1;j<=4;j++) {
endpts[j]=data[j];
endpts[j+4]=data[M-3+j];
}
realft(data,NDFT,1);
data[2]=0.0;
}
en=w*delta*NDFT/TWOPI+1.0;
nn=IMIN(IMAX((int)(en-0.5*MPOL+1.0),1),NDFT/2-MPOL+1);
for (j=1;j<=MPOL;j++,nn++) {
cpol[j]=data[2*nn-1];
spol[j]=data[2*nn];
xpol[j]=nn;
}
polint(xpol,cpol,MPOL,en,&cdft,&cerr);
polint(xpol,spol,MPOL,en,&sdft,&serr);
dftcor(w,delta,a,b,endpts,&corre,&corim,&corfac);
cdft *= corfac;
sdft *= corfac;
cdft += corre;
sdft += corim;
c=delta*cos(w*a);
s=delta*sin(w*a);
*cosint=c*cdft-s*sdft;
*sinint=s*cdft+c*sdft;
free_vector(cpol,1,MPOL);
free_vector(spol,1,MPOL);
free_vector(xpol,1,MPOL);
}
void polin2(float x1a[], float x2a[], float **ya, int m, int n, float x1,
float x2, float *y, float *dy)
{
void polint(float xa[], float ya[], int n, float x, float *y, float *dy);
int j;
float *ymtmp;
ymtmp=vector(1,m);
for (j=1;j<=m;j++) {
polint(x2a,ya[j],n,x2,&ymtmp[j],dy);
}
polint(x1a,ymtmp,m,x1,y,dy);
free_vector(ymtmp,1,m);
}
void polcof(float xa[], float ya[], int n, float cof[])
{
void polint(float xa[], float ya[], int n, float x, float *y, float *dy);
int k,j,i;
float xmin,dy,*x,*y;
x=vector(0,n);
y=vector(0,n);
for (j=0;j<=n;j++) {
x[j]=xa[j];
y[j]=ya[j];
}
for (j=0;j<=n;j++) {
polint(x-1,y-1,n+1-j,0.0,&cof[j],&dy);
xmin=1.0e38;
k = -1;
for (i=0;i<=n-j;i++) {
if (fabs(x[i]) < xmin) {
xmin=fabs(x[i]);
k=i;
}
if (x[i]) y[i]=(y[i]-cof[j])/x[i];
}
for (i=k+1;i<=n-j;i++) {
y[i-1]=y[i];
x[i-1]=x[i];
}
}
free_vector(y,0,n);
free_vector(x,0,n);
}
double CMesh::qromb(meshMemFunc mf, double a, double b) {
const int JMAX=20, JMAXP=JMAX+1, K=5;
const double EPS=1E-10;
double ss, dss;
std::vector<double> s, h, s_t, h_t;
int i,j;
h.push_back(1.0);
for (j=1;j<=JMAX;j++){
s.push_back(trapzd(mf,a,b,j));
if (j>=K){
for (i=0;i<K;i++){
h_t.push_back(h[j-K+i]);
s_t.push_back(s[j-K+i]);
}
polint(h_t,s_t,0.0,ss,dss);
if (fabs(dss) <= EPS*fabs(ss)) {
return ss;
}
h_t.clear();
s_t.clear();
}
h.push_back(0.25*h[j-1]);
}
fprintf(stderr,"Too many steps in routine qromb\n");
exit(1);
return 0.0;
}
double qromo( double a, double b, double eps,
double (*kgvfnc)(double,int,double,double),
double (*choose)(double (*)(double, int, double, double),
double, double, int, int, double, double),
int nk, double ppot, double sigma2)
{
int j,Jmax = 14, Jmaxp = Jmax +1, K=5, Km=K-1;
double ss,dss;
double *h = ALLOC(Jmaxp, double);
double *s = ALLOC(Jmaxp, double);
h[0] = 1;
for( j=0; j<Jmax; j++ ){
s[j]=(*choose)(kgvfnc,a,b,j, nk, ppot, sigma2);
if (j >= K) {
polint( &h[j-K], &s[j-K], K, 0., &ss, &dss);
if (fabs(dss) <= eps*fabs(ss)){
free(h); free(s);
return ss;
}
}
h[j+1]=h[j]/9.0;
}
printf("Too many steps in routing qromo\n");
exit(EXIT_FAILURE);
}
double qromb(double (*funcd)(), double es, double Wind, double AirDens, double ZO,
double EactAir, double F, double hsalt, double phi_r, double ushear, double Zrh,
double a, double b)
// Returns the integral of the function func from a to b. Integration is performed
// by Romberg's method: Numerical Recipes in C Section 4.3
{
void polint(double xa[], double ya[], int n, double x, double *y, double *dy);
double trapzd(double (*funcd)(), double es, double Wind, double AirDens,
double ZO, double EactAir, double F, double hsalt, double phi_r,
double ushear, double Zrh, double a, double b, int n);
double ss, dss;
double s[MAX_ITER+1], h[MAX_ITER+2];
int j;
h[1] = 1.0;
for(j=1; j<=MAX_ITER; j++) {
s[j]=trapzd(funcd,es, Wind, AirDens, ZO, EactAir, F, hsalt, phi_r,
ushear, Zrh, a,b,j);
if(j >= K) {
polint(&h[j-K],&s[j-K],K,0.0,&ss,&dss);
if (fabs(dss) <= MACHEPS*fabs(ss)) return ss;
}
h[j+1]=0.25*h[j];
}
nrerror("Too many steps in routine qromb");
return 0.0;
}
/*==========================================================================
* calc_a: calculate a(t) via interpolation
*==========================================================================*/
double calc_a(double t)
{
int IORD=2;
int j,jl,ju,jm;
double a,da;
double *t_array, *a_array;
t_array = &(simu.timeline.t[0]);
a_array = &(simu.timeline.a[0]);
/* find correct index within timeline */
jl = 0;
ju = MAXTIME+1;
while(ju-jl > 1)
{
jm = (ju+jl)/2;
if(t > t_array[jm])
jl=jm;
else
ju=jm;
}
j=jl;
if(j >= MAXTIME-IORD)
j = MAXTIME-IORD-1;
/* interpolate using IORD points around t_array[j] and a_array[j] */
polint(&t_array[j],&a_array[j],IORD,t,&a,&da);
return(a);
}
//! Numerical recipe Chapiter 3
//! Two-dimensional polynomial interpolation
void polin2(std::vector<double>& x1a,
std::vector<double>& x2a,
std::vector<std::vector<double>>& ya, // les points fix connues
const double x1,const double x2, double &y, double &dy) // les points a interpoler
{
int j,k;
int m= (int)x1a.size();
int n= (int)x2a.size();
std::vector<double> ymtmp(m);
std::vector<double> ya_t(n);
for (j=0;j<m;j++) {
for (k=0;k<n;k++)
ya_t[k]=ya[j][k];
polint(x2a,ya_t,x2,ymtmp[j],dy);
}
polint(x1a,ymtmp,x1,y,dy);
}
static VALUE gp_polinterpolate(VALUE self, VALUE sxa, VALUE sya, VALUE sx) {
rb_io_puts(1, &sxa, rb_stdout);
rb_io_puts(1, &sya, rb_stdout);
rb_io_puts(1, &sx, rb_stdout);
GEN xa = geval(strtoGENstr(StringValueCStr(sxa)));
GEN ya = geval(strtoGENstr(StringValueCStr(sya)));
GEN x = geval(strtoGENstr(StringValueCStr(sx)));
char* pol = GENtostr(polint(xa, ya, x, NULL));
return rb_str_new2(pol);
}
double
qromb(double (*func)(double), double a, double b, double eps, int imax)
{
double ss = 0;
double dss;
int i;
/* allocate enough storage */
if (imax+1 > nmax) {
#ifdef DEBUG
(void)fprintf(stdout, "qromb: malloc %d cells %d bytes\n",
imax+1, (imax+1) * sizeof(double));
#endif
if (h != NULL) {
free(h);
}
h = (double *)malloc((imax+1) * sizeof(double));
if (s != NULL) {
free(s);
}
s = (double *)malloc((imax+1) * sizeof(double));
nmax = imax+1;
}
h[0] = 1;
for (i = 0; i < imax; i++) {
s[i] = trapzd(func, a, b, i);
if (i >= K-1) {
ss = polint(&h[i-(K-1)], &s[i-(K-1)], K, 0.0, &dss);
#ifdef DEBUG
(void)fprintf(stdout, "qromb: a %.15e b %.15e i %d ss %.15e dss %.15e eps %.15e\n",
a, b, i, ss, dss, eps);
#endif
if (fabs(dss) < eps * fabs(ss)) {
return(ss);
}
}
h[i+1] = 0.25 * h[i];
s[i+1] = s[i];
}
#ifdef DEBUG
(void)fprintf(stdout, "qromb: a %.15e b %.15e i %d ss %.15e\n", a, b, i, ss);
#endif
return(ss);
}
/* ---------------------------------------------------------------------- */
LDBLE
qromb_midpnt (LDBLE x1, LDBLE x2)
/* ---------------------------------------------------------------------- */
{
LDBLE ss, dss;
LDBLE sv[MAX_QUAD + 2], h[MAX_QUAD + 2];
int j;
h[0] = 1.0;
sv[0] = midpnt (x1, x2, 1);
for (j = 1; j < MAX_QUAD; j++)
{
sv[j] = midpnt (x1, x2, j + 1);
h[j] = h[j - 1] / 9.0;
if (fabs (sv[j] - sv[j - 1]) <= G_TOL * fabs (sv[j]))
{
sv[j] *= surface_charge_ptr->grams * surface_charge_ptr->specific_area * alpha / F_C_MOL; /* (ee0RT/2)**1/2, (L/mol)**1/2 C / m**2 */
if ((x2 - 1) < 0.0)
sv[j] *= -1.0;
if (debug_diffuse_layer == TRUE)
{
output_msg (OUTPUT_MESSAGE, "Iterations in qromb_midpnt: %d\n", j);
}
return (sv[j]);
}
if (j >= K_POLY - 1)
{
polint (&h[j - K_POLY], &sv[j - K_POLY], K_POLY, 0.0, &ss, &dss);
if (fabs (dss) <= G_TOL * fabs (ss) || fabs (dss) < G_TOL)
{
ss *= surface_charge_ptr->grams * surface_charge_ptr->specific_area * alpha / F_C_MOL; /* (ee0RT/2)**1/2, (L/mol)**1/2 C / m**2 */
if ((x2 - 1) < 0.0)
ss *= -1.0;
if (debug_diffuse_layer == TRUE)
{
output_msg (OUTPUT_MESSAGE, "Iterations in qromb_midpnt: %d\n", j);
}
return (ss);
}
}
}
sprintf (error_string,
"\nToo many iterations integrating diffuse layer.\n");
error_msg (error_string, STOP);
return (-999.9);
}
/* a quick-and-dirty hack for the VDE model which requires H in a table */
double calc_Hubble_VDE(double a)
{
FILE *fhubble;
double *a_array, *h_array;
double h, dh;
int n_array;
char dummyline[MAXSTRING];
int jl,ju,jm,j,IORD=2;
fhubble = fopen("hubble_vde.dat","r");
n_array = -1;
a_array = calloc(1,sizeof(double));
h_array = calloc(1,sizeof(double));
while(fgets(dummyline,MAXSTRING,fhubble) != NULL)
{
n_array++;
a_array = realloc(a_array, (n_array+1)*sizeof(double));
h_array = realloc(h_array, (n_array+1)*sizeof(double));
sscanf(dummyline,"%lf %lf", &(a_array[n_array]), &(h_array[n_array]));
/* possible conversions of what has just been read in */
a_array[n_array] = 1./(1.+a_array[n_array]);
h_array[n_array] *= H0;
}
/* interpolate using IORD points around a_array[j] and h_array[j] */
jl = 0;
ju = n_array+1;
while(ju-jl > 1)
{
jm = (ju+jl)/2;
if(a < a_array[jm])
jl=jm;
else
ju=jm;
}
j=jl;
if(j >= n_array-IORD)
j = n_array-IORD-1;
polint(&a_array[j],&h_array[j],IORD,a,&h,&dh);
//fprintf(stderr,"%d %g %g\n",j,a,a_array[j],h_array[j]);
fclose(fhubble);
return(h);
}
double get_delay(int in, double tau) {
double x = tau / fabs(DELTA_T);
double dd = fabs(DELTA_T);
double y, ya[4], xa[4], dy;
int n1 = (int)x;
int n2 = n1 + 1;
int nodes = NODE;
int n0 = n1;
int n3 = n2 + 1;
int i0, i1, i2, i3;
if (tau < 0.0 || tau > DELAY) {
err_msg("Delay negative or too large");
stop_integration();
return (0.0);
}
xa[1] = n1 * dd;
xa[0] = xa[1] - dd;
xa[2] = xa[1] + dd;
xa[3] = xa[2] + dd;
i1 = (n1 + LatestDelay) % MaxDelay;
i2 = (n2 + LatestDelay) % MaxDelay;
i0 = (n0 + LatestDelay) % MaxDelay;
i3 = (n3 + LatestDelay) % MaxDelay;
if (i1 < 0)
i1 += MaxDelay;
if (i2 < 0)
i2 += MaxDelay;
if (i3 < 0)
i3 += MaxDelay;
if (i0 < 0)
i0 += MaxDelay;
ya[1] = DelayWork[in + (nodes)*i1];
ya[2] = DelayWork[in + (nodes)*i2];
ya[0] = DelayWork[in + (nodes)*i0];
ya[3] = DelayWork[in + (nodes)*i3];
polint(xa, ya, 4, tau, &y, &dy);
return (y);
}
float qromb(float (*func)(float), float a, float b)
{
void polint(float xa[], float ya[], int n, float x, float *y, float *dy);
float trapzd(float (*func)(float), float a, float b, int n);
float ss,dss;
float s[JMAXP+1],h[JMAXP+1];
int j;
h[1]=1.0;
for (j=1;j<=JMAX;j++) {
s[j]=trapzd(func,a,b,j);
if (j >= K) {
polint(&h[j-K],&s[j-K],K,0.0,&ss,&dss);
if (fabs(dss) < EPS*fabs(ss)) return ss;
}
s[j+1]=s[j];
h[j+1]=0.25*h[j];
}
error("Too many steps in routine qromb");
return 0.0;
}
/*==========================================================================
* calc_super_a: calculate a(super_t) via interpolation
*==========================================================================*/
double calc_super_a(double super_t)
{
int IORD=2;
int j,jl,ju,jm;
double a,da;
double *t_array, *a_array;
#ifdef NO_EXPANSION
return (1.0);
#else /* NO_EXPANSION */
t_array = &(simu.timeline.super_t[0]);
a_array = &(simu.timeline.a[0]);
/* find correct index within timeline */
jl = 0;
ju = MAXTIME+1;
while(ju-jl > 1)
{
jm = (ju+jl)/2;
if(super_t > t_array[jm])
jl=jm;
else
ju=jm;
}
j=jl;
if(j >= MAXTIME-IORD)
j = MAXTIME-IORD-1;
/* interpolate using IORD points around t_array[j] and a_array[j] */
polint(&t_array[j],&a_array[j],IORD,super_t,&a,&da);
return(a);
#endif
}
/******************************************************************************
* @brief Integration is performed by Romberg's method: Numerical Recipes
* in C Section 4.3
*****************************************************************************/
double
qromb(double (*funcd)(),
double es,
double Wind,
double AirDens,
double ZO,
double EactAir,
double F,
double hsalt,
double phi_r,
double ushear,
double Zrh,
double a,
double b)
{
extern parameters_struct param;
double ss, dss;
double s[param.BLOWING_MAX_ITER + 1];
double h[param.BLOWING_MAX_ITER + 2];
int j;
h[1] = 1.0;
for (j = 1; j <= param.BLOWING_MAX_ITER; j++) {
s[j] = trapzd(funcd, es, Wind, AirDens, ZO, EactAir, F, hsalt, phi_r,
ushear, Zrh, a, b, j);
if (j >= param.BLOWING_K) {
polint(&h[j - param.BLOWING_K], &s[j - param.BLOWING_K],
param.BLOWING_K, 0.0, &ss, &dss);
if (fabs(dss) <= DBL_EPSILON * fabs(ss)) {
return ss;
}
}
h[j + 1] = 0.25 * h[j];
}
log_err("Too many steps");
return 0.; // To avoid warnings.
}
double interpolate(double *x_array, double *y_array, int n_array, double x)
{
/* interpolate using IORD points around x_array[j] and y_array[j] */
int jl,ju,jm,j,IORD=6;
double h, dh;
jl = 0;
ju = n_array+1;
while(ju-jl > 1)
{
jm = (ju+jl)/2;
if(x < x_array[jm])
jl=jm;
else
ju=jm;
}
j=jl;
if(j >= n_array-IORD)
j = n_array-IORD-1;
polint(&x_array[j],&y_array[j],IORD,x,&h,&dh);
return(h);
}
// Using Numerical Recipes. This is Romberg Integration method.
int Integration::romberg()
{
d_area = 0.0;
double *s = new double[d_max_iterations + 1];
double *h = new double[d_max_iterations + 2];
h[1] = 1.0;
int j;
for(j = 1; j <= d_max_iterations; j++){
s[j] = trapezf(j);
if(j > d_method){
double ss, dss;
polint(&h[j-d_method], &s[j-d_method], d_method, 0.0, &ss, &dss);
if (fabs(dss) <= d_tolerance * fabs(ss)){
d_area = ss;
break;
}
}
h[j+1] = 0.25*h[j];
}
delete[] s;
delete[] h;
return j;
}
template < class T > T qromb( T (*func)(T), T a, T b )
{
T ss, dss;
T s [JMAXP+1], h[JMAXP+1];
int j;
h[1-1] = T(1.0);
for( j=1; j<=JMAX; j++ )
{
s[j-1] = trapzd(func, a, b, j);
if( j >= K )
{
polint(&h[j-K-1], &s[j-K-1], K, T(0.0), &ss, &dss );
if( fabs(dss) <= EPS*fabs(ss) )
return ss;
}
s[j+1-1] = s[j-1];
h[j+1-1] = 0.25 * h[j-1];
}
puts("To many steps in qromb");
return T(0.0);
}
bool testpolynomialinterpolation(bool silent)
{
bool result;
bool waserrors;
bool guardedaccerrors;
bool geninterrors;
bool nevinterrors;
bool nevdinterrors;
bool equidistantinterrors;
bool chebyshev1interrors;
bool chebyshev2interrors;
double epstol;
int n;
int maxn;
int i;
int j;
int pass;
int passcount;
double a;
double b;
double p;
double dp;
double d2p;
double q;
double dq;
double d2q;
ap::real_1d_array x;
ap::real_1d_array y;
ap::real_1d_array w;
double v1;
double v2;
double v3;
double h;
double maxerr;
waserrors = false;
maxn = 5;
passcount = 20;
epstol = 1.0E+4;
//
// Testing general barycentric formula
//
//
// Crash test: three possible types of overflow
//
x.setbounds(0, 2);
y.setbounds(0, 2);
w.setbounds(0, 2);
x(0) = -1;
y(0) = 1;
w(0) = 1;
x(1) = 0;
y(1) = 0.002;
w(1) = 1;
x(2) = 1;
y(2) = 1;
w(2) = 1;
v2 = barycentricinterpolation(x, y, w, 3, double(0));
v2 = equidistantpolynomialinterpolation(-1.0, 1.0, y, 3, double(0));
v1 = 0.5;
while(v1>0)
{
v2 = barycentricinterpolation(x, y, w, 3, v1);
v2 = equidistantpolynomialinterpolation(-1.0, 1.0, y, 3, v1);
v1 = ap::sqr(v1);
}
y(1) = 200;
v1 = 0.5;
while(v1>0)
{
v2 = barycentricinterpolation(x, y, w, 3, v1);
v2 = equidistantpolynomialinterpolation(-1.0, 1.0, y, 3, v1);
v1 = ap::sqr(v1);
}
//
// Accuracy test of guarded formula (near-overflow task)
//
x.setbounds(0, 2);
y.setbounds(0, 2);
w.setbounds(0, 2);
x(0) = -1;
y(0) = -1;
w(0) = 1;
x(1) = 0;
y(1) = 0;
w(1) = -2;
x(2) = 1;
y(2) = 1;
w(2) = 1;
v1 = 0.5;
maxerr = 0;
while(v1>0)
{
v2 = barycentricinterpolation(x, y, w, 3, v1);
maxerr = ap::maxreal(maxerr, fabs(v2-v1)/fabs(v1));
v2 = equidistantpolynomialinterpolation(-1.0, 1.0, y, 3, v1);
maxerr = ap::maxreal(maxerr, fabs(v2-v1)/fabs(v1));
v1 = ap::sqr(v1);
}
guardedaccerrors = maxerr>epstol*ap::machineepsilon;
//
// Testing polynomial interpolation using a
// general barycentric formula. Test on Chebyshev nodes
// (to avoid big condition numbers).
//
maxerr = 0;
h = 0.0001;
for(n = 1; n <= maxn; n++)
{
x.setbounds(0, n-1);
y.setbounds(0, n-1);
w.setbounds(0, n-1);
for(pass = 1; pass <= passcount; pass++)
{
//
// Prepare task
//
v1 = 0.7*ap::randomreal()+0.3;
for(i = 0; i <= n-1; i++)
{
x(i) = cos(i*ap::pi()/n);
y(i) = cos(v1*x(i))+2.3*x(i)-2;
}
for(i = 0; i <= n-1; i++)
{
w(i) = 1.0;
for(j = 0; j <= n-1; j++)
{
if( j!=i )
{
w(i) = w(i)/(x(i)-x(j));
}
}
}
//
// Test at intermediate points
//
v1 = -1;
while(v1<=1.0001)
{
v2 = polint(x, y, n, v1);
v3 = barycentricinterpolation(x, y, w, n, v1);
maxerr = ap::maxreal(maxerr, fabs(v2-v3));
v1 = v1+0.01;
}
//
// Test at nodes
//
for(i = 0; i <= n-1; i++)
{
maxerr = ap::maxreal(maxerr, fabs(barycentricinterpolation(x, y, w, n, x(i))-y(i)));
}
}
}
geninterrors = maxerr>epstol*ap::machineepsilon;
//
// Testing polynomial interpolation using a Neville's algorithm.
// Test on Chebyshev nodes (don't want to work with big condition numbers).
//
maxerr = 0;
for(n = 1; n <= maxn; n++)
{
x.setbounds(0, n-1);
y.setbounds(0, n-1);
for(pass = 1; pass <= passcount; pass++)
{
//
// Prepare task
//
v1 = 0.7*ap::randomreal()+0.3;
for(i = 0; i <= n-1; i++)
{
x(i) = cos(i*ap::pi()/n);
y(i) = cos(v1*x(i))+2.3*x(i)-2;
}
//
// Test
//
v1 = -1;
while(v1<=1.0001)
{
v2 = polint(x, y, n, v1);
v3 = nevilleinterpolation(x, y, n, v1);
maxerr = ap::maxreal(maxerr, fabs(v2-v3));
v1 = v1+0.01;
}
}
}
nevinterrors = maxerr>epstol*ap::machineepsilon;
//
// Testing polynomial interpolation using an
// equidistant barycentric algorithm.
//
maxerr = 0;
for(n = 1; n <= maxn; n++)
{
x.setbounds(0, n-1);
y.setbounds(0, n-1);
for(pass = 1; pass <= passcount; pass++)
{
//
// Prepare task
//
v1 = 0.7*ap::randomreal()+0.3;
a = -(0.5+0.5*ap::randomreal());
b = +(0.5+0.5*ap::randomreal());
for(i = 0; i <= n-1; i++)
{
x(i) = a+(b-a)*i/ap::maxint(n-1, 1);
y(i) = cos(v1*x(i))+2.3*x(i)-2;
}
//
// Test
//
v1 = -1;
while(v1<=1.0001)
{
v2 = polint(x, y, n, v1);
v3 = equidistantpolynomialinterpolation(a, b, y, n, v1);
maxerr = ap::maxreal(maxerr, fabs(v2-v3));
v1 = v1+0.01;
}
}
}
equidistantinterrors = maxerr>epstol*ap::machineepsilon;
//
// Testing polynomial interpolation using
// Chebyshev-1 barycentric algorithm.
//
maxerr = 0;
for(n = 1; n <= maxn; n++)
{
x.setbounds(0, n-1);
y.setbounds(0, n-1);
for(pass = 1; pass <= passcount; pass++)
{
//
// Prepare task
//
v1 = 0.7*ap::randomreal()+0.3;
a = -(0.5+0.5*ap::randomreal());
b = +(0.5+0.5*ap::randomreal());
for(i = 0; i <= n-1; i++)
{
x(i) = 0.5*(a+b)+0.5*(b-a)*cos(ap::pi()*(2*i+1)/(2*(n-1)+2));
y(i) = cos(v1*x(i))+2.3*x(i)-2;
}
//
// Test
//
v1 = a;
while(v1<=b)
{
v2 = polint(x, y, n, v1);
v3 = chebyshev1interpolation(a, b, y, n, v1);
maxerr = ap::maxreal(maxerr, fabs(v2-v3));
v1 = v1+0.01;
}
}
}
chebyshev1interrors = maxerr>epstol*ap::machineepsilon;
//
// Testing polynomial interpolation using
// Chebyshev-2 barycentric algorithm.
//
maxerr = 0;
for(n = 2; n <= maxn; n++)
{
x.setbounds(0, n-1);
y.setbounds(0, n-1);
for(pass = 1; pass <= passcount; pass++)
{
//
// Prepare task
//
v1 = 0.7*ap::randomreal()+0.3;
a = -(0.5+0.5*ap::randomreal());
b = +(0.5+0.5*ap::randomreal());
for(i = 0; i <= n-1; i++)
{
x(i) = 0.5*(a+b)+0.5*(b-a)*cos(ap::pi()*i/(n-1));
y(i) = cos(v1*x(i))+2.3*x(i)-2;
}
//
// Test
//
v1 = a;
while(v1<=b)
{
v2 = polint(x, y, n, v1);
v3 = chebyshev2interpolation(a, b, y, n, v1);
maxerr = ap::maxreal(maxerr, fabs(v2-v3));
v1 = v1+0.01;
}
}
}
chebyshev2interrors = maxerr>epstol*ap::machineepsilon;
//
// Testing polynomial interpolation using a Neville's algorithm.
// with derivatives. Test on Chebyshev nodes (don't want to work
// with big condition numbers).
//
maxerr = 0;
h = 0.0001;
for(n = 1; n <= maxn; n++)
{
x.setbounds(0, n-1);
y.setbounds(0, n-1);
for(pass = 1; pass <= passcount; pass++)
{
//
// Prepare task
//
v2 = 0.7*ap::randomreal()+0.3;
for(i = 0; i <= n-1; i++)
{
x(i) = cos(i*ap::pi()/n);
y(i) = cos(v2*x(i));
}
//
// Test
//
v1 = -1;
while(v1<=1.0001)
{
p = polint(x, y, n, v1);
dp = (polint(x, y, n, v1+h)-polint(x, y, n, v1-h))/(2*h);
d2p = (polint(x, y, n, v1-h)-2*polint(x, y, n, v1)+polint(x, y, n, v1+h))/ap::sqr(h);
nevilledifferentiation(x, y, n, v1, q, dq, d2q);
maxerr = ap::maxreal(maxerr, fabs(p-q));
maxerr = ap::maxreal(maxerr, fabs(dp-dq));
maxerr = ap::maxreal(maxerr, fabs(d2p-d2q));
v1 = v1+0.01;
}
}
}
nevdinterrors = maxerr>0.001;
//
// report
//
waserrors = guardedaccerrors||geninterrors||nevinterrors||equidistantinterrors||chebyshev1interrors||chebyshev2interrors||nevdinterrors;
if( !silent )
{
printf("TESTING POLYNOMIAL INTERPOLATION\n");
//
// Normal tests
//
printf("BARYCENTRIC INTERPOLATION TEST: ");
if( geninterrors )
{
printf("FAILED\n");
}
else
{
printf("OK\n");
}
printf("NEVILLE INTERPOLATON TEST: ");
if( nevinterrors )
{
printf("FAILED\n");
}
else
{
printf("OK\n");
}
printf("EQUIDISTANT INTERPOLATON TEST: ");
if( equidistantinterrors )
{
printf("FAILED\n");
}
else
{
printf("OK\n");
}
printf("CHEBYSHEV-1 INTERPOLATON TEST: ");
if( chebyshev1interrors )
{
printf("FAILED\n");
}
else
{
printf("OK\n");
}
printf("CHEBYSHEV-2 INTERPOLATON TEST: ");
if( chebyshev2interrors )
{
printf("FAILED\n");
}
else
{
printf("OK\n");
}
printf("NEVILLE DIFFERENTIATION TEST: ");
if( nevdinterrors )
{
printf("FAILED\n");
}
else
{
printf("OK\n");
}
printf("GUARDED FORMULA ACCURACY TEST: ");
if( guardedaccerrors )
{
printf("FAILED\n");
}
else
{
printf("OK\n");
}
//
// if we are here then crash test is passed :)
//
printf("CRASH TEST: OK\n");
if( waserrors )
{
printf("TEST FAILED\n");
}
else
{
printf("TEST PASSED\n");
}
printf("\n\n");
}
//
// end
//
result = !waserrors;
return result;
}
/***********************************************************************//**
* @brief Perform Romberg integration
*
* @param[in] a Left integration boundary.
* @param[in] b Right integration boundary.
* @param[in] k Integration order (default: k=5)
*
* Returns the integral of the integrand from a to b. Integration is
* performed by Romberg's method of order 2K, where e.g. K=2 in Simpson's
* rule.
* The number of iterations is limited by m_max_iter. m_eps specifies the
* requested fractional accuracy. By default it is set to 1e-6.
*
* @todo Check that k is smaller than m_max_iter
* @todo Make use of std::vector class
***************************************************************************/
double GIntegral::romb(const double& a, const double& b, const int& k)
{
// Initialise result
double result = 0.0;
// Continue only if integration range is valid
if (b > a) {
// Initialise variables
bool converged = false;
double ss = 0.0;
double dss = 0.0;
// Allocate temporal storage
double* s = new double[m_max_iter+2];
double* h = new double[m_max_iter+2];
// Initialise step size
h[1] = 1.0;
s[0] = 0.0;
// Iterative loop
for (m_iter = 1; m_iter <= m_max_iter; ++m_iter) {
// Integration using Trapezoid rule
s[m_iter] = trapzd(a, b, m_iter, s[m_iter-1]);
// Compile option: Check for NaN/Inf
#if defined(G_NAN_CHECK)
if (is_notanumber(s[m_iter]) || is_infinite(s[m_iter])) {
std::cout << "*** ERROR: GIntegral::romb";
std::cout << "(a=" << a << ", b=" << b << ", k=" << k << "):";
std::cout << " NaN/Inf encountered";
std::cout << " (s[" << m_iter << "]=" << s[m_iter] << ")";
std::cout << std::endl;
}
#endif
// Starting from iteration k on, use polynomial interpolation
if (m_iter >= k) {
ss = polint(&h[m_iter-k], &s[m_iter-k], k, 0.0, &dss);
if (std::abs(dss) <= m_eps * std::abs(ss)) {
converged = true;
result = ss;
break;
}
}
// Reduce step size
h[m_iter+1]= 0.25 * h[m_iter];
} // endfor: iterative loop
// Free temporal storage
delete [] s;
delete [] h;
// Dump warning
if (!m_silent) {
if (!converged) {
std::string msg = "Integration uncertainty "+
gammalib::str(std::abs(dss))+
" exceeds tolerance of "+
gammalib::str(m_eps * std::abs(ss))+
" after "+gammalib::str(m_iter)+
" iterations. Result "+
gammalib::str(result)+
" is inaccurate.";
gammalib::warning(G_ROMB, msg);
}
}
} // endif: integration range was valid
// Return result
return result;
}
/***********************************************************************//**
* @brief Perform Romberg integration
*
* @param[in] a Left integration boundary.
* @param[in] b Right integration boundary.
* @param[in] k Integration order (default: k=5)
*
* Returns the integral of the integrand from a to b. Integration is
* performed by Romberg's method of order 2K, where e.g. K=2 in Simpson's
* rule.
* The number of iterations is limited by m_max_iter. m_eps specifies the
* requested fractional accuracy. By default it is set to 1e-6.
*
* @todo Check that k is smaller than m_max_iter
* @todo Make use of std::vector class
***************************************************************************/
double GIntegral::romb(double a, double b, int k)
{
// Initialise result
bool converged = false;
double result = 0.0;
double ss = 0.0;
double dss = 0.0;
// Continue only if integration range is valid
if (b > a) {
// Allocate temporal storage
double* s = new double[m_max_iter+2];
double* h = new double[m_max_iter+2];
// Initialise step size
h[1] = 1.0;
s[0] = 0.0;
// Iterative loop
for (m_iter = 1; m_iter <= m_max_iter; ++m_iter) {
// Integration using Trapezoid rule
s[m_iter] = trapzd(a, b, m_iter, s[m_iter-1]);
// Compile option: Check for NaN/Inf
#if defined(G_NAN_CHECK)
if (isnotanumber(s[m_iter]) || isinfinite(s[m_iter])) {
std::cout << "*** ERROR: GIntegral::romb";
std::cout << "(a=" << a << ", b=" << b << ", k=" << k << "):";
std::cout << " NaN/Inf encountered";
std::cout << " (s[" << m_iter << "]=" << s[m_iter] << ")";
std::cout << std::endl;
}
#endif
// Starting from iteration k on, use polynomial interpolation
if (m_iter >= k) {
ss = polint(&h[m_iter-k], &s[m_iter-k], k, 0.0, &dss);
if (std::abs(dss) <= m_eps * std::abs(ss)) {
converged = true;
result = ss;
break;
}
}
// Reduce step size
h[m_iter+1]= 0.25 * h[m_iter];
} // endfor: iterative loop
// Free temporal storage
delete [] s;
delete [] h;
// Dump warning
if (!m_silent) {
if (!converged) {
std::cout << "*** WARNING: GIntegral::romb: ";
std::cout << "Integration did not converge ";
std::cout << "(iter=" << m_iter;
std::cout << ", result=" << ss;
std::cout << ", d=" << std::abs(dss);
std::cout << " > " << m_eps * std::abs(ss) << ")";
std::cout << std::endl;
//throw;
}
}
} // endif: integration range was valid
// Return result
return result;
}
double dpoly(int n, double x, double *xp, double *yp)
{
double value, err;
polint (xp - 1, yp - 1, n, x, &value, &err);
return value;
}
