Esempio n. 1
0
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));
}
Esempio n. 2
0
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;
}
Esempio n. 3
0
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;
}
Esempio n. 4
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);
    }

}