static void
check_array (value vf)
{
mlsize_t len = Double_array_length (Field (vf, 0));
size_t off = Long_val (Field (vf, 1));
size_t n = Long_val (Field (vf, 2));
size_t stride = Long_val (Field (vf, 3));
if (off + (n - 1) * stride >= len)
GSL_ERROR_VOID ("Inconsistent array specification", GSL_EBADLEN);
}
static void
ran0_set (void *vstate, unsigned long int s)
{
ran0_state_t *state = (ran0_state_t *) vstate;
if (s == mask)
{
GSL_ERROR_VOID ("ran0 should not use seed == mask",
GSL_EINVAL);
}
state->x = s ^ mask;
return;
}
static void
qc25f (gsl_function * f, double a, double b,
gsl_integration_qawo_table * wf, size_t level,
double *result, double *abserr, double *resabs, double *resasc)
{
const double center = 0.5 * (a + b);
const double half_length = 0.5 * (b - a);
const double omega = wf->omega ;
const double par = omega * half_length;
if (fabs (par) < 2)
{
gsl_function weighted_function;
struct fn_fourier_params fn_params;
fn_params.function = f;
fn_params.omega = omega;
if (wf->sine == GSL_INTEG_SINE)
{
weighted_function.function = &fn_sin;
}
else
{
weighted_function.function = &fn_cos;
}
weighted_function.params = &fn_params;
gsl_integration_qk15 (&weighted_function, a, b, result, abserr,
resabs, resasc);
return;
}
else
{
double *moment;
double cheb12[13], cheb24[25];
double result_abs, res12_cos, res12_sin, res24_cos, res24_sin;
double est_cos, est_sin;
double c, s;
size_t i;
gsl_integration_qcheb (f, a, b, cheb12, cheb24);
if (level >= wf->n)
{
/* table overflow should not happen, check before calling */
GSL_ERROR_VOID("table overflow in internal function", GSL_ESANITY);
}
/* obtain moments from the table */
moment = wf->chebmo + 25 * level;
res12_cos = cheb12[12] * moment[12];
res12_sin = 0 ;
for (i = 0; i < 6; i++)
{
size_t k = 10 - 2 * i;
res12_cos += cheb12[k] * moment[k];
res12_sin += cheb12[k + 1] * moment[k + 1];
}
res24_cos = cheb24[24] * moment[24];
res24_sin = 0 ;
result_abs = fabs(cheb24[24]) ;
for (i = 0; i < 12; i++)
{
size_t k = 22 - 2 * i;
res24_cos += cheb24[k] * moment[k];
res24_sin += cheb24[k + 1] * moment[k + 1];
result_abs += fabs(cheb24[k]) + fabs(cheb24[k+1]);
}
est_cos = fabs(res24_cos - res12_cos);
est_sin = fabs(res24_sin - res12_sin);
c = half_length * cos(center * omega);
s = half_length * sin(center * omega);
if (wf->sine == GSL_INTEG_SINE)
{
*result = c * res24_sin + s * res24_cos;
*abserr = fabs(c * est_sin) + fabs(s * est_cos);
}
else
{
*result = c * res24_cos - s * res24_sin;
*abserr = fabs(c * est_cos) + fabs(s * est_sin);
}
*resabs = result_abs * half_length;
*resasc = GSL_DBL_MAX;
return;
}
}
static inline void check_array_size(value a, value b)
{
if(Double_array_length(a) != Double_array_length(b))
GSL_ERROR_VOID("array sizes differ", GSL_EBADLEN);
}
