00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023 #ifndef O2SCL_GSL_INTE_QAWS_H
00024 #define O2SCL_GSL_INTE_QAWS_H
00025
00026 #include <o2scl/inte.h>
00027 #include <o2scl/gsl_inte_qag_b.h>
00028
00029 #ifndef DOXYGENP
00030 namespace o2scl {
00031 #endif
00032
00033
00034
00035
00036 template<class param_t, class func_t> class gsl_inte_qaws :
00037 public gsl_inte_cheb<param_t,func_t> {
00038
00039 public:
00040
00041 gsl_inte_qaws() {
00042 }
00043
00044 virtual ~gsl_inte_qaws() {}
00045
00046
00047
00048 virtual double integ(func_t &func, double a, double b, param_t &pa) {
00049 double res, err;
00050 integ_err(func,a,b,pa,res,err);
00051 this->interror=err;
00052 return res;
00053 }
00054
00055
00056 double s;
00057
00058
00059
00060
00061 virtual int integ_err(func_t &func, double a, double b,
00062 param_t &pa, double &res, double &err2) {
00063
00064 int status=qaws(func,a,b,s,this->tolx,this->tolf,this->wkspace,
00065 &res,&err2,pa);
00066
00067 return status;
00068
00069 }
00070
00071 #ifndef DOXYGEN_INTERNAL
00072
00073 protected:
00074
00075
00076
00077
00078 int qaws(func_t &func, const double a, const double b, const double c,
00079 const double epsabs, const double epsrel, const size_t limit,
00080 double *result, double *abserr, param_t &pa) {
00081
00082
00083
00084
00085
00086
00087
00088
00089 double area, errsum;
00090 double result0, abserr0;
00091 double tolerance;
00092 size_t iteration = 0;
00093 int roundoff_type1 = 0, roundoff_type2 = 0, error_type = 0;
00094
00095
00096
00097 initialise (workspace, a, b);
00098
00099 *result = 0;
00100 *abserr = 0;
00101
00102 if (limit > workspace->limit)
00103 {
00104 GSL_ERROR ("iteration limit exceeds available workspace", GSL_EINVAL) ;
00105 }
00106
00107 if (b <= a)
00108 {
00109 GSL_ERROR ("limits must form an ascending sequence, a < b", GSL_EINVAL) ;
00110 }
00111
00112 if (epsabs <= 0 && (epsrel < 50 * GSL_DBL_EPSILON || epsrel < 0.5e-28))
00113 {
00114 GSL_ERROR ("tolerance cannot be acheived with given epsabs and epsrel",
00115 GSL_EBADTOL);
00116 }
00117
00118
00119
00120 {
00121 double area1, area2;
00122 double error1, error2;
00123 int err_reliable1, err_reliable2;
00124 double a1 = a;
00125 double b1 = 0.5 * (a + b);
00126 double a2 = b1;
00127 double b2 = b;
00128
00129 qc25s (f, a, b, a1, b1, t, &area1, &error1, &err_reliable1);
00130 qc25s (f, a, b, a2, b2, t, &area2, &error2, &err_reliable2);
00131
00132 if (error1 > error2)
00133 {
00134 append_interval (workspace, a1, b1, area1, error1);
00135 append_interval (workspace, a2, b2, area2, error2);
00136 }
00137 else
00138 {
00139 append_interval (workspace, a2, b2, area2, error2);
00140 append_interval (workspace, a1, b1, area1, error1);
00141 }
00142
00143 result0 = area1 + area2;
00144 abserr0 = error1 + error2;
00145 }
00146
00147
00148
00149 tolerance = GSL_MAX_DBL (epsabs, epsrel * fabs (result0));
00150
00151
00152
00153
00154 if (abserr0 < tolerance && abserr0 < 0.01 * fabs(result0))
00155 {
00156 *result = result0;
00157 *abserr = abserr0;
00158
00159 return GSL_SUCCESS;
00160 }
00161 else if (limit == 1)
00162 {
00163 *result = result0;
00164 *abserr = abserr0;
00165
00166 GSL_ERROR ("a maximum of one iteration was insufficient", GSL_EMAXITER);
00167 }
00168
00169 area = result0;
00170 errsum = abserr0;
00171
00172 iteration = 2;
00173
00174 do
00175 {
00176 double a1, b1, a2, b2;
00177 double a_i, b_i, r_i, e_i;
00178 double area1 = 0, area2 = 0, area12 = 0;
00179 double error1 = 0, error2 = 0, error12 = 0;
00180 int err_reliable1, err_reliable2;
00181
00182
00183
00184 retrieve (workspace, &a_i, &b_i, &r_i, &e_i);
00185
00186 a1 = a_i;
00187 b1 = 0.5 * (a_i + b_i);
00188 a2 = b1;
00189 b2 = b_i;
00190
00191 qc25s (f, a, b, a1, b1, t, &area1, &error1, &err_reliable1);
00192 qc25s (f, a, b, a2, b2, t, &area2, &error2, &err_reliable2);
00193
00194 area12 = area1 + area2;
00195 error12 = error1 + error2;
00196
00197 errsum += (error12 - e_i);
00198 area += area12 - r_i;
00199
00200 if (err_reliable1 && err_reliable2)
00201 {
00202 double delta = r_i - area12;
00203
00204 if (fabs (delta) <= 1.0e-5 * fabs (area12) && error12 >= 0.99 * e_i)
00205 {
00206 roundoff_type1++;
00207 }
00208 if (iteration >= 10 && error12 > e_i)
00209 {
00210 roundoff_type2++;
00211 }
00212 }
00213
00214 tolerance = GSL_MAX_DBL (epsabs, epsrel * fabs (area));
00215
00216 if (errsum > tolerance)
00217 {
00218 if (roundoff_type1 >= 6 || roundoff_type2 >= 20)
00219 {
00220 error_type = 2;
00221 }
00222
00223
00224
00225
00226 if (subinterval_too_small (a1, a2, b2))
00227 {
00228 error_type = 3;
00229 }
00230 }
00231
00232 update (workspace, a1, b1, area1, error1, a2, b2, area2, error2);
00233
00234 retrieve (workspace, &a_i, &b_i, &r_i, &e_i);
00235
00236 iteration++;
00237
00238 }
00239 while (iteration < limit && !error_type && errsum > tolerance);
00240
00241 *result = sum_results (workspace);
00242 *abserr = errsum;
00243
00244 if (errsum <= tolerance)
00245 {
00246 return GSL_SUCCESS;
00247 }
00248 else if (error_type == 2)
00249 {
00250 GSL_ERROR ("roundoff error prevents tolerance from being achieved",
00251 GSL_EROUND);
00252 }
00253 else if (error_type == 3)
00254 {
00255 GSL_ERROR ("bad integrand behavior found in the integration interval",
00256 GSL_ESING);
00257 }
00258 else if (iteration == limit)
00259 {
00260 GSL_ERROR ("maximum number of subdivisions reached", GSL_EMAXITER);
00261 }
00262 else
00263 {
00264 GSL_ERROR ("could not integrate function", GSL_EFAILED);
00265 }
00266
00267 }
00268
00269 struct fn_qaws_params
00270 {
00271 gsl_function *function;
00272 double a;
00273 double b;
00274 gsl_integration_qaws_table *table;
00275 };
00276
00277 static double fn_qaws (double t, void *params);
00278 static double fn_qaws_L (double x, void *params);
00279 static double fn_qaws_R (double x, void *params);
00280
00281 static void
00282 compute_result (const double * r, const double * cheb12, const double * cheb24,
00283 double * result12, double * result24);
00284
00285
00286 static void
00287 qc25s (gsl_function * f, double a, double b, double a1, double b1,
00288 gsl_integration_qaws_table * t,
00289 double *result, double *abserr, int *err_reliable);
00290
00291 static void
00292 qc25s (gsl_function * f, double a, double b, double a1, double b1,
00293 gsl_integration_qaws_table * t,
00294 double *result, double *abserr, int *err_reliable)
00295 {
00296 gsl_function weighted_function;
00297 struct fn_qaws_params fn_params;
00298
00299 fn_params.function = f;
00300 fn_params.a = a;
00301 fn_params.b = b;
00302 fn_params.table = t;
00303
00304 weighted_function.params = &fn_params;
00305
00306 if (a1 == a && (t->alpha != 0.0 || t->mu != 0))
00307 {
00308 double cheb12[13], cheb24[25];
00309
00310 double factor = pow(0.5 * (b1 - a1), t->alpha + 1.0);
00311
00312 weighted_function.function = &fn_qaws_R;
00313
00314 gsl_integration_qcheb (&weighted_function, a1, b1, cheb12, cheb24);
00315
00316 if (t->mu == 0)
00317 {
00318 double res12 = 0, res24 = 0;
00319 double u = factor;
00320
00321 compute_result (t->ri, cheb12, cheb24, &res12, &res24);
00322
00323 *result = u * res24;
00324 *abserr = fabs(u * (res24 - res12));
00325 }
00326 else
00327 {
00328 double res12a = 0, res24a = 0;
00329 double res12b = 0, res24b = 0;
00330
00331 double u = factor * log(b1 - a1);
00332 double v = factor;
00333
00334 compute_result (t->ri, cheb12, cheb24, &res12a, &res24a);
00335 compute_result (t->rg, cheb12, cheb24, &res12b, &res24b);
00336
00337 *result = u * res24a + v * res24b;
00338 *abserr = fabs(u * (res24a - res12a)) + fabs(v * (res24b - res12b));
00339 }
00340
00341 *err_reliable = 0;
00342
00343 return;
00344 }
00345 else if (b1 == b && (t->beta != 0.0 || t->nu != 0))
00346 {
00347 double cheb12[13], cheb24[25];
00348 double factor = pow(0.5 * (b1 - a1), t->beta + 1.0);
00349
00350 weighted_function.function = &fn_qaws_L;
00351
00352 gsl_integration_qcheb (&weighted_function, a1, b1, cheb12, cheb24);
00353
00354 if (t->nu == 0)
00355 {
00356 double res12 = 0, res24 = 0;
00357 double u = factor;
00358
00359 compute_result (t->rj, cheb12, cheb24, &res12, &res24);
00360
00361 *result = u * res24;
00362 *abserr = fabs(u * (res24 - res12));
00363 }
00364 else
00365 {
00366 double res12a = 0, res24a = 0;
00367 double res12b = 0, res24b = 0;
00368
00369 double u = factor * log(b1 - a1);
00370 double v = factor;
00371
00372 compute_result (t->rj, cheb12, cheb24, &res12a, &res24a);
00373 compute_result (t->rh, cheb12, cheb24, &res12b, &res24b);
00374
00375 *result = u * res24a + v * res24b;
00376 *abserr = fabs(u * (res24a - res12a)) + fabs(v * (res24b - res12b));
00377 }
00378
00379 *err_reliable = 0;
00380
00381 return;
00382 }
00383 else
00384 {
00385 double resabs, resasc;
00386
00387 weighted_function.function = &fn_qaws;
00388
00389 gsl_integration_qk15 (&weighted_function, a1, b1, result, abserr,
00390 &resabs, &resasc);
00391
00392 if (*abserr == resasc)
00393 {
00394 *err_reliable = 0;
00395 }
00396 else
00397 {
00398 *err_reliable = 1;
00399 }
00400
00401 return;
00402 }
00403
00404 }
00405
00406 static double
00407 fn_qaws (double x, void *params)
00408 {
00409 struct fn_qaws_params *p = (struct fn_qaws_params *) params;
00410 gsl_function *f = p->function;
00411 gsl_integration_qaws_table *t = p->table;
00412
00413 double factor = 1.0;
00414
00415 if (t->alpha != 0.0)
00416 factor *= pow(x - p->a, t->alpha);
00417
00418 if (t->beta != 0.0)
00419 factor *= pow(p->b - x, t->beta);
00420
00421 if (t->mu == 1)
00422 factor *= log(x - p->a);
00423
00424 if (t->nu == 1)
00425 factor *= log(p->b - x);
00426
00427 return factor * GSL_FN_EVAL (f, x);
00428 }
00429
00430 static double
00431 fn_qaws_L (double x, void *params)
00432 {
00433 struct fn_qaws_params *p = (struct fn_qaws_params *) params;
00434 gsl_function *f = p->function;
00435 gsl_integration_qaws_table *t = p->table;
00436
00437 double factor = 1.0;
00438
00439 if (t->alpha != 0.0)
00440 factor *= pow(x - p->a, t->alpha);
00441
00442 if (t->mu == 1)
00443 factor *= log(x - p->a);
00444
00445 return factor * GSL_FN_EVAL (f, x);
00446 }
00447
00448 static double
00449 fn_qaws_R (double x, void *params)
00450 {
00451 struct fn_qaws_params *p = (struct fn_qaws_params *) params;
00452 gsl_function *f = p->function;
00453 gsl_integration_qaws_table *t = p->table;
00454
00455 double factor = 1.0;
00456
00457 if (t->beta != 0.0)
00458 factor *= pow(p->b - x, t->beta);
00459
00460 if (t->nu == 1)
00461 factor *= log(p->b - x);
00462
00463 return factor * GSL_FN_EVAL (f, x);
00464 }
00465
00466
00467 static void
00468 compute_result (const double * r, const double * cheb12, const double * cheb24,
00469 double * result12, double * result24)
00470 {
00471 size_t i;
00472 double res12 = 0;
00473 double res24 = 0;
00474
00475 for (i = 0; i < 13; i++)
00476 {
00477 res12 += r[i] * cheb12[i];
00478 }
00479
00480 for (i = 0; i < 25; i++)
00481 {
00482 res24 += r[i] * cheb24[i];
00483 }
00484
00485 *result12 = res12;
00486 *result24 = res24;
00487 }
00488
00489
00490
00491 virtual double transform(func_t &func, double x, param_t &pa)
00492 {
00493 double y;
00494 func(x,y,pa);
00495 return y/(x-s);
00496 }
00497
00498 #endif
00499
00500
00501 const char *type() { return "gsl_inte_qaws"; }
00502
00503 };
00504
00505 #ifndef DOXYGENP
00506 }
00507 #endif
00508
00509 #endif