static VALUE rb_gsl_integration_qawo(int argc, VALUE *argv, VALUE obj)
{
double a, epsabs, epsrel;
double result, abserr;
size_t limit;
gsl_function *F = NULL;
gsl_integration_workspace *w = NULL;
gsl_integration_qawo_table *t = NULL;
int status, intervals, itmp, flag = 0, flagt = 0;
switch (TYPE(obj)) {
case T_MODULE: case T_CLASS: case T_OBJECT:
if (argc < 2) rb_raise(rb_eArgError, "too few arguments");
CHECK_FUNCTION(argv[0]);
Data_Get_Struct(argv[0], gsl_function, F);
itmp = 1;
break;
default:
if (argc < 1) rb_raise(rb_eArgError, "too few arguments");
Data_Get_Struct(obj, gsl_function, F);
itmp = 0;
break;
}
Need_Float(argv[itmp]);
a = NUM2DBL(argv[itmp]);
flagt = get_qawo_table(argv[argc-1], &t);
flag = get_epsabs_epsrel_limit_workspace(argc-1, argv, itmp+1, &epsabs, &epsrel,
&limit, &w);
status = gsl_integration_qawo(F, a, epsabs, epsrel, limit, w, t, &result, &abserr);
intervals = w->size;
if (flag == 1) gsl_integration_workspace_free(w);
if (flagt == 1) gsl_integration_qawo_table_free(t);
return rb_ary_new3(4, rb_float_new(result), rb_float_new(abserr), INT2FIX(intervals),
INT2FIX(status));
}
gsl_complex integrate_line_segment(Params *params,
gsl_complex p0,
gsl_complex p1)
{
gsl_complex k = gsl_complex_sub(p1, p0);
const double r = params->r;
const double a = 0.0; // parameter interval start
const double b = 1.0; // parameter interval end
const double L = b - a; // length of parameter interval
const size_t table_size = 1000;
// calculate frequency of oscillatory part
double omega = GSL_REAL(k) * r;
gsl_integration_workspace *ws = gsl_integration_workspace_alloc(table_size);
// prepare sine/cosine tables for integration
gsl_integration_qawo_table *table_cos = gsl_integration_qawo_table_alloc(omega, L, GSL_INTEG_COSINE, table_size);
gsl_integration_qawo_table *table_sin = gsl_integration_qawo_table_alloc(omega, L, GSL_INTEG_SINE, table_size);
LineSegmentParams lsp;
lsp.p0 = p0;
lsp.k = k;
lsp.damping = params->r * GSL_IMAG(k);
lsp.params = params;
//fprintf(stderr, "p0 = %g %g, p1 = %g %g, k = %g %g, r = %g, omega = %g, damping = %g\n",
// GSL_REAL(p0), GSL_IMAG(p0), GSL_REAL(p1), GSL_IMAG(p1),
// GSL_REAL(k), GSL_IMAG(k), r, omega, lsp.damping);
gsl_function F;
F.function = &line_segment_integrand_wrapper;
F.params = &lsp;
double result_real_cos, abserr_real_cos;
double result_real_sin, abserr_real_sin;
double result_imag_cos, abserr_imag_cos;
double result_imag_sin, abserr_imag_sin;
double epsabs = 1e-9;
double epsrel = 1e-9;
lsp.part = REAL;
gsl_integration_qawo(&F, a, epsabs, epsrel, table_size, ws, table_cos, &result_real_cos, &abserr_real_cos);
gsl_integration_qawo(&F, a, epsabs, epsrel, table_size, ws, table_sin, &result_real_sin, &abserr_real_sin);
lsp.part = IMAG;
gsl_integration_qawo(&F, a, epsabs, epsrel, table_size, ws, table_cos, &result_imag_cos, &abserr_imag_cos);
gsl_integration_qawo(&F, a, epsabs, epsrel, table_size, ws, table_sin, &result_imag_sin, &abserr_imag_sin);
//fprintf(stderr, " cos: %g (+- %g) %g (+- %g) sin: %g (+- %g) %g (+- %g)\n",
// result_real_cos, abserr_real_cos, result_imag_cos, abserr_imag_cos,
// result_real_sin, abserr_real_sin, result_imag_sin, abserr_imag_sin);
gsl_complex cos_part = gsl_complex_rect(result_real_cos, result_imag_cos);
gsl_complex sin_part = gsl_complex_rect(-result_imag_sin, result_real_sin);
gsl_complex sum = gsl_complex_add(cos_part, sin_part);
gsl_complex result = gsl_complex_mul(
k,
gsl_complex_mul(sum, gsl_complex_exp(gsl_complex_mul_imag(p0, params->r))));
gsl_integration_qawo_table_free(table_sin);
gsl_integration_qawo_table_free(table_cos);
gsl_integration_workspace_free(ws);
return result;
}
int main_gsl_quad() {
// Na postawie N i K bede ustalal jak wiele moze byc przedzialów,
// Ustalilem recznie, na wyczucie.
//
int DEEP = (int)( log(2.0E7 / N) );
// printf("%d\n", DEEP);
int DLIMIT = Pow(2,DEEP);
double result1, result2, diff1, diff2;
double result3, result4, diff3, diff4;
F = gsl_vector_alloc((int)N); // Macierz G jest trojdiagonalna symetryczna
G1 = gsl_vector_alloc((int)N); // wiec mozna ja opisac jedynie poprzez 2
G2 = gsl_vector_alloc((int)N-1); // wektory- diagonali i poddiagonali.
X = gsl_vector_alloc((int)N); //
for (int i = 0; i < N; ++i)
gsl_vector_set(G1, i, 2*(i-1.0)/h);
for (int i = 0; i < N-1; ++i)
gsl_vector_set(G2, i, -(2.0*i+1.0)/2.0/h);
workspace = gsl_integration_workspace_alloc(LIMIT);
if ( K > 20 ) {
DLIMIT = (int) log10(sqrt(5*K))*DLIMIT;
DEEP = (int) log2(DLIMIT);
}
DLIMIT *= 4;
DEEP *= 4;
table = gsl_integration_qawo_table_alloc(K*PI, h, GSL_INTEG_SINE, DEEP);
fun.function = &f2q_sin;
// printf("%d %d\n", DEEP, DLIMIT);
// Mamy doczynienia z funkcja oscylujaca, uzyjmy wiec specjalnych
// kwadratur GSLa, oddzielnie dla sinus oddzielnie dla cosinus,
//
for (f2qi = 1; f2qi <= N; ++f2qi) { // sinus
fisign = 1;
if ( f2qi < 2 ) // wartosci na siebie nachodza
gsl_integration_qawo(&fun, (f2qi-1)*h, 0.0E0, EPSILON, DLIMIT, workspace, table, &result1, &diff1);
else result1 = -result3;
fisign = -1;
gsl_integration_qawo(&fun, (f2qi )*h, 0.0E0, EPSILON, DLIMIT, workspace, table, &result3, &diff3);
gsl_vector_set(F, f2qi-1, result1+result3);
// if( f2qi % 1000 == 0 ) { printf("%d \r", f2qi); fflush(stdout); }
}
gsl_integration_qawo_table_free(table);
table = gsl_integration_qawo_table_alloc(K*PI, h, GSL_INTEG_COSINE, DEEP);
fun.function = &f2q_cos;
for (f2qi = 1; f2qi <= N; ++f2qi) { // cosinus
fisign = 1;
if ( f2qi < 2 ) // wartosci na siebie nachodza
gsl_integration_qawo(&fun, (f2qi-1)*h, 0.0E0, EPSILON, DLIMIT, workspace, table, &result2, &diff2);
else result2 = -result4;
fisign = -1;
gsl_integration_qawo(&fun, (f2qi )*h, 0.0E0, EPSILON, DLIMIT, workspace, table, &result4, &diff4);
gsl_vector_set(F, f2qi-1, result1+result3+gsl_vector_get(F, f2qi-1));
// if( f2qi % 1000 == 0 ) { printf("%d \r", f2qi); fflush(stdout); }
}
gsl_integration_qawo_table_free(table);
// Mamy F wiec znajdujemy X (h*), rozwiazujac uklad Gh=F
// gdzie G symetryczna trojdiagonalna,
//
// fprintf(stderr,"2 quad done.\n");
gsl_linalg_solve_symm_tridiag(G1,G2,F,X);
// for (int i = 0; i < N; ++i)
// fprintf(stderr,"h[%d] = %.15e\n",i,gsl_vector_get(X,i));
fprintf(stderr,"2 linalg done.\n");
return 0;
}
int
gsl_integration_qawf (gsl_function * f,
const double a,
const double epsabs,
const size_t limit,
gsl_integration_workspace * workspace,
gsl_integration_workspace * cycle_workspace,
gsl_integration_qawo_table * wf,
double *result, double *abserr)
{
double area, errsum;
double res_ext, err_ext;
double correc, total_error = 0.0, truncation_error;
size_t ktmin = 0;
size_t iteration = 0;
struct extrapolation_table table;
double cycle;
double omega = wf->omega;
const double p = 0.9;
double factor = 1;
double initial_eps, eps;
int error_type = 0;
/* Initialize results */
initialise (workspace, a, a);
*result = 0;
*abserr = 0;
if (limit > workspace->limit)
{
GSL_ERROR ("iteration limit exceeds available workspace", GSL_EINVAL) ;
}
/* Test on accuracy */
if (epsabs <= 0)
{
GSL_ERROR ("absolute tolerance epsabs must be positive", GSL_EBADTOL) ;
}
if (omega == 0.0)
{
if (wf->sine == GSL_INTEG_SINE)
{
/* The function sin(w x) f(x) is always zero for w = 0 */
*result = 0;
*abserr = 0;
return GSL_SUCCESS;
}
else
{
/* The function cos(w x) f(x) is always f(x) for w = 0 */
int status = gsl_integration_qagiu (f, a, epsabs, 0.0,
cycle_workspace->limit,
cycle_workspace,
result, abserr);
return status;
}
}
if (epsabs > GSL_DBL_MIN / (1 - p))
{
eps = epsabs * (1 - p);
}
else
{
eps = epsabs;
}
initial_eps = eps;
area = 0;
errsum = 0;
res_ext = 0;
err_ext = GSL_DBL_MAX;
correc = 0;
cycle = (2 * floor (fabs (omega)) + 1) * M_PI / fabs (omega);
gsl_integration_qawo_table_set_length (wf, cycle);
initialise_table (&table);
for (iteration = 0; iteration < limit; iteration++)
{
double area1, error1, reseps, erreps;
double a1 = a + iteration * cycle;
double b1 = a1 + cycle;
double epsabs1 = eps * factor;
int status = gsl_integration_qawo (f, a1, epsabs1, 0.0, limit,
cycle_workspace, wf,
&area1, &error1);
append_interval (workspace, a1, b1, area1, error1);
factor *= p;
area = area + area1;
errsum = errsum + error1;
/* estimate the truncation error as 50 times the final term */
truncation_error = 50 * fabs (area1);
total_error = errsum + truncation_error;
if (total_error < epsabs && iteration > 4)
{
goto compute_result;
}
if (error1 > correc)
{
correc = error1;
}
if (status)
{
eps = GSL_MAX_DBL (initial_eps, correc * (1.0 - p));
}
if (status && total_error < 10 * correc && iteration > 3)
{
goto compute_result;
}
append_table (&table, area);
if (table.n < 2)
{
continue;
}
qelg (&table, &reseps, &erreps);
ktmin++;
if (ktmin >= 15 && err_ext < 0.001 * total_error)
{
error_type = 4;
}
if (erreps < err_ext)
{
ktmin = 0;
err_ext = erreps;
res_ext = reseps;
if (err_ext + 10 * correc <= epsabs)
break;
if (err_ext <= epsabs && 10 * correc >= epsabs)
break;
}
}
if (iteration == limit)
error_type = 1;
if (err_ext == GSL_DBL_MAX)
goto compute_result;
err_ext = err_ext + 10 * correc;
*result = res_ext;
*abserr = err_ext;
if (error_type == 0)
{
return GSL_SUCCESS ;
}
if (res_ext != 0.0 && area != 0.0)
{
if (err_ext / fabs (res_ext) > errsum / fabs (area))
goto compute_result;
}
else if (err_ext > errsum)
{
goto compute_result;
}
else if (area == 0.0)
{
goto return_error;
}
if (error_type == 4)
{
err_ext = err_ext + truncation_error;
}
goto return_error;
compute_result:
*result = area;
*abserr = total_error;
return_error:
if (error_type > 2)
error_type--;
if (error_type == 0)
{
return GSL_SUCCESS;
}
else if (error_type == 1)
{
GSL_ERROR ("number of iterations was insufficient", GSL_EMAXITER);
}
else if (error_type == 2)
{
GSL_ERROR ("cannot reach tolerance because of roundoff error",
GSL_EROUND);
}
else if (error_type == 3)
{
GSL_ERROR ("bad integrand behavior found in the integration interval",
GSL_ESING);
}
else if (error_type == 4)
{
GSL_ERROR ("roundoff error detected in the extrapolation table",
GSL_EROUND);
}
else if (error_type == 5)
{
GSL_ERROR ("integral is divergent, or slowly convergent",
GSL_EDIVERGE);
}
else
{
GSL_ERROR ("could not integrate function", GSL_EFAILED);
}
}
