00001 /* 00002 ------------------------------------------------------------------- 00003 00004 Copyright (C) 2006, 2007, Andrew W. Steiner 00005 00006 This file is part of O2scl. 00007 00008 O2scl is free software; you can redistribute it and/or modify 00009 it under the terms of the GNU General Public License as published by 00010 the Free Software Foundation; either version 3 of the License, or 00011 (at your option) any later version. 00012 00013 O2scl is distributed in the hope that it will be useful, 00014 but WITHOUT ANY WARRANTY; without even the implied warranty of 00015 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00016 GNU General Public License for more details. 00017 00018 You should have received a copy of the GNU General Public License 00019 along with O2scl. If not, see <http://www.gnu.org/licenses/>. 00020 00021 ------------------------------------------------------------------- 00022 */ 00023 #ifndef O2SCL_GSL_INTE_QAWC_H 00024 #define O2SCL_GSL_INTE_QAWC_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 /** \brief Integration with Chebyshev (GSL) 00034 */ 00035 template<class param_t, class func_t> class gsl_inte_cheb : 00036 public gsl_inte_transform<param_t,func_t> { 00037 00038 public: 00039 00040 /// Desc 00041 void compute_moments (double cc, double *moment) 00042 { 00043 size_t k; 00044 00045 double a0 = log (fabs ((1.0 - cc) / (1.0 + cc))); 00046 double a1 = 2 + a0 * cc; 00047 00048 moment[0] = a0; 00049 moment[1] = a1; 00050 00051 for (k = 2; k < 25; k++) 00052 { 00053 double a2; 00054 00055 if ((k % 2) == 0) 00056 { 00057 a2 = 2.0 * cc * a1 - a0; 00058 } 00059 else 00060 { 00061 const double km1 = k - 1.0; 00062 a2 = 2.0 * cc * a1 - a0 - 4.0 / (km1 * km1 - 1.0); 00063 } 00064 00065 moment[k] = a2; 00066 00067 a0 = a1; 00068 a1 = a2; 00069 } 00070 } 00071 00072 /// Desc 00073 void gsl_integration_qcheb (func_t &f, double a, double b, 00074 double *cheb12, double *cheb24, 00075 param_t &pa) { 00076 size_t i; 00077 double fval[25], v[12]; 00078 00079 /* These are the values of cos(pi*k/24) for k=1..11 needed for the 00080 Chebyshev expansion of f(x) */ 00081 00082 const double x[11] = { 0.9914448613738104, 00083 0.9659258262890683, 00084 0.9238795325112868, 00085 0.8660254037844386, 00086 0.7933533402912352, 00087 0.7071067811865475, 00088 0.6087614290087206, 00089 0.5000000000000000, 00090 0.3826834323650898, 00091 0.2588190451025208, 00092 0.1305261922200516 }; 00093 00094 const double center = 0.5 * (b + a); 00095 const double half_length = 0.5 * (b - a); 00096 00097 double y1, y2, y3; 00098 f(b,y1,pa); 00099 f(center,y2,pa); 00100 f(a,y3,pa); 00101 fval[0] = 0.5 * y1; 00102 fval[12] = y2; 00103 fval[24] = 0.5 * y3; 00104 00105 for (i = 1; i < 12; i++) 00106 { 00107 const size_t j = 24 - i; 00108 const double u = half_length * x[i-1]; 00109 double yp, ym; 00110 f(center+u,yp,pa); 00111 f(center-u,ym,pa); 00112 fval[i] = yp; 00113 fval[j] = ym; 00114 } 00115 00116 for (i = 0; i < 12; i++) 00117 { 00118 const size_t j = 24 - i; 00119 v[i] = fval[i] - fval[j]; 00120 fval[i] = fval[i] + fval[j]; 00121 } 00122 00123 { 00124 const double alam1 = v[0] - v[8]; 00125 const double alam2 = x[5] * (v[2] - v[6] - v[10]); 00126 00127 cheb12[3] = alam1 + alam2; 00128 cheb12[9] = alam1 - alam2; 00129 } 00130 00131 { 00132 const double alam1 = v[1] - v[7] - v[9]; 00133 const double alam2 = v[3] - v[5] - v[11]; 00134 { 00135 const double alam = x[2] * alam1 + x[8] * alam2; 00136 00137 cheb24[3] = cheb12[3] + alam; 00138 cheb24[21] = cheb12[3] - alam; 00139 } 00140 00141 { 00142 const double alam = x[8] * alam1 - x[2] * alam2; 00143 cheb24[9] = cheb12[9] + alam; 00144 cheb24[15] = cheb12[9] - alam; 00145 } 00146 } 00147 00148 { 00149 const double part1 = x[3] * v[4]; 00150 const double part2 = x[7] * v[8]; 00151 const double part3 = x[5] * v[6]; 00152 00153 { 00154 const double alam1 = v[0] + part1 + part2; 00155 const double alam2 = x[1] * v[2] + part3 + x[9] * v[10]; 00156 00157 cheb12[1] = alam1 + alam2; 00158 cheb12[11] = alam1 - alam2; 00159 } 00160 00161 { 00162 const double alam1 = v[0] - part1 + part2; 00163 const double alam2 = x[9] * v[2] - part3 + x[1] * v[10]; 00164 cheb12[5] = alam1 + alam2; 00165 cheb12[7] = alam1 - alam2; 00166 } 00167 } 00168 00169 { 00170 const double alam = (x[0] * v[1] + x[2] * v[3] + x[4] * v[5] 00171 + x[6] * v[7] + x[8] * v[9] + x[10] * v[11]); 00172 cheb24[1] = cheb12[1] + alam; 00173 cheb24[23] = cheb12[1] - alam; 00174 } 00175 00176 { 00177 const double alam = (x[10] * v[1] - x[8] * v[3] + x[6] * v[5] 00178 - x[4] * v[7] + x[2] * v[9] - x[0] * v[11]); 00179 cheb24[11] = cheb12[11] + alam; 00180 cheb24[13] = cheb12[11] - alam; 00181 } 00182 00183 { 00184 const double alam = (x[4] * v[1] - x[8] * v[3] - x[0] * v[5] 00185 - x[10] * v[7] + x[2] * v[9] + x[6] * v[11]); 00186 cheb24[5] = cheb12[5] + alam; 00187 cheb24[19] = cheb12[5] - alam; 00188 } 00189 00190 { 00191 const double alam = (x[6] * v[1] - x[2] * v[3] - x[10] * v[5] 00192 + x[0] * v[7] - x[8] * v[9] - x[4] * v[11]); 00193 cheb24[7] = cheb12[7] + alam; 00194 cheb24[17] = cheb12[7] - alam; 00195 } 00196 00197 for (i = 0; i < 6; i++) 00198 { 00199 const size_t j = 12 - i; 00200 v[i] = fval[i] - fval[j]; 00201 fval[i] = fval[i] + fval[j]; 00202 } 00203 00204 { 00205 const double alam1 = v[0] + x[7] * v[4]; 00206 const double alam2 = x[3] * v[2]; 00207 00208 cheb12[2] = alam1 + alam2; 00209 cheb12[10] = alam1 - alam2; 00210 } 00211 00212 cheb12[6] = v[0] - v[4]; 00213 00214 { 00215 const double alam = x[1] * v[1] + x[5] * v[3] + x[9] * v[5]; 00216 cheb24[2] = cheb12[2] + alam; 00217 cheb24[22] = cheb12[2] - alam; 00218 } 00219 00220 { 00221 const double alam = x[5] * (v[1] - v[3] - v[5]); 00222 cheb24[6] = cheb12[6] + alam; 00223 cheb24[18] = cheb12[6] - alam; 00224 } 00225 00226 { 00227 const double alam = x[9] * v[1] - x[5] * v[3] + x[1] * v[5]; 00228 cheb24[10] = cheb12[10] + alam; 00229 cheb24[14] = cheb12[10] - alam; 00230 } 00231 00232 for (i = 0; i < 3; i++) 00233 { 00234 const size_t j = 6 - i; 00235 v[i] = fval[i] - fval[j]; 00236 fval[i] = fval[i] + fval[j]; 00237 } 00238 00239 cheb12[4] = v[0] + x[7] * v[2]; 00240 cheb12[8] = fval[0] - x[7] * fval[2]; 00241 00242 { 00243 const double alam = x[3] * v[1]; 00244 cheb24[4] = cheb12[4] + alam; 00245 cheb24[20] = cheb12[4] - alam; 00246 } 00247 00248 { 00249 const double alam = x[7] * fval[1] - fval[3]; 00250 cheb24[8] = cheb12[8] + alam; 00251 cheb24[16] = cheb12[8] - alam; 00252 } 00253 00254 cheb12[0] = fval[0] + fval[2]; 00255 00256 { 00257 const double alam = fval[1] + fval[3]; 00258 cheb24[0] = cheb12[0] + alam; 00259 cheb24[24] = cheb12[0] - alam; 00260 } 00261 00262 cheb12[12] = v[0] - v[2]; 00263 cheb24[12] = cheb12[12]; 00264 00265 for (i = 1; i < 12; i++) 00266 { 00267 cheb12[i] *= 1.0 / 6.0; 00268 } 00269 00270 cheb12[0] *= 1.0 / 12.0; 00271 cheb12[12] *= 1.0 / 12.0; 00272 00273 for (i = 1; i < 24; i++) 00274 { 00275 cheb24[i] *= 1.0 / 12.0; 00276 } 00277 00278 cheb24[0] *= 1.0 / 24.0; 00279 cheb24[24] *= 1.0 / 24.0; 00280 } 00281 00282 }; 00283 00284 /** 00285 \brief Adaptive Cauchy principal value integration (GSL) 00286 */ 00287 template<class param_t, class func_t> class gsl_inte_qawc : 00288 public gsl_inte_cheb<param_t,func_t> { 00289 00290 public: 00291 00292 gsl_inte_qawc() { 00293 } 00294 00295 virtual ~gsl_inte_qawc() {} 00296 00297 /** \brief Integrate function \c func from \c a to \c b. 00298 */ 00299 virtual double integ(func_t &func, double a, double b, param_t &pa) { 00300 double res, err; 00301 integ_err(func,a,b,pa,res,err); 00302 this->interror=err; 00303 return res; 00304 } 00305 00306 /// The singularity 00307 double s; 00308 00309 /** \brief Integrate function \c func from \c a to \c b and place 00310 the result in \c res and the error in \c err 00311 */ 00312 virtual int integ_err(func_t &func, double a, double b, 00313 param_t &pa, double &res, double &err2) { 00314 00315 int status=qawc(func,a,b,s,this->tolx,this->tolf,this->wkspace, 00316 &res,&err2,pa); 00317 00318 return status; 00319 00320 } 00321 00322 #ifndef DOXYGEN_INTERNAL 00323 00324 protected: 00325 00326 /** 00327 \brief Desc 00328 */ 00329 int qawc(func_t &func, const double a, const double b, const double c, 00330 const double epsabs, const double epsrel, const size_t limit, 00331 double *result, double *abserr, param_t &pa) { 00332 00333 double area, errsum; 00334 double result0, abserr0; 00335 double tolerance; 00336 size_t iteration = 0; 00337 int roundoff_type1 = 0, roundoff_type2 = 0, error_type = 0; 00338 int err_reliable; 00339 int sign = 1; 00340 double lower, higher; 00341 00342 /* Initialize results */ 00343 00344 *result = 0; 00345 *abserr = 0; 00346 00347 if (limit > this->w->limit) 00348 { 00349 GSL_ERROR ("iteration limit exceeds available workspace", 00350 GSL_EINVAL) ; 00351 } 00352 00353 if (b < a) 00354 { 00355 lower = b ; 00356 higher = a ; 00357 sign = -1 ; 00358 } 00359 else 00360 { 00361 lower = a; 00362 higher = b; 00363 } 00364 00365 initialise (this->w, lower, higher); 00366 00367 if (epsabs <= 0 && (epsrel < 50 * GSL_DBL_EPSILON || epsrel < 0.5e-28)) 00368 { 00369 GSL_ERROR 00370 ("tolerance cannot be acheived with given epsabs and epsrel", 00371 GSL_EBADTOL); 00372 } 00373 00374 if (c == a || c == b) 00375 { 00376 GSL_ERROR ("cannot integrate with singularity on endpoint", 00377 GSL_EINVAL); 00378 } 00379 00380 /* perform the first integration */ 00381 00382 qc25c (func, lower, higher, c, &result0, &abserr0, &err_reliable, pa); 00383 00384 set_initial_result (this->w, result0, abserr0); 00385 00386 /* Test on accuracy, use 0.01 relative error as an extra safety 00387 margin on the first iteration (ignored for subsequent iterations) */ 00388 00389 tolerance = GSL_MAX_DBL (epsabs, epsrel * fabs (result0)); 00390 00391 if (abserr0 < tolerance && abserr0 < 0.01 * fabs(result0)) 00392 { 00393 *result = sign * result0; 00394 *abserr = abserr0; 00395 00396 return GSL_SUCCESS; 00397 } 00398 else if (limit == 1) 00399 { 00400 *result = sign * result0; 00401 *abserr = abserr0; 00402 00403 GSL_ERROR ("a maximum of one iteration was insufficient", 00404 GSL_EMAXITER); 00405 } 00406 00407 area = result0; 00408 errsum = abserr0; 00409 00410 iteration = 1; 00411 00412 do 00413 { 00414 double a1, b1, a2, b2; 00415 double a_i, b_i, r_i, e_i; 00416 double area1 = 0, area2 = 0, area12 = 0; 00417 double error1 = 0, error2 = 0, error12 = 0; 00418 int err_reliable1, err_reliable2; 00419 00420 /* Bisect the subinterval with the largest error estimate */ 00421 00422 retrieve (this->w, &a_i, &b_i, &r_i, &e_i); 00423 00424 a1 = a_i; 00425 b1 = 0.5 * (a_i + b_i); 00426 a2 = b1; 00427 b2 = b_i; 00428 00429 if (c > a1 && c <= b1) 00430 { 00431 b1 = 0.5 * (c + b2) ; 00432 a2 = b1; 00433 } 00434 else if (c > b1 && c < b2) 00435 { 00436 b1 = 0.5 * (a1 + c) ; 00437 a2 = b1; 00438 } 00439 00440 qc25c (func, a1, b1, c, &area1, &error1, &err_reliable1, pa); 00441 qc25c (func, a2, b2, c, &area2, &error2, &err_reliable2, pa); 00442 00443 area12 = area1 + area2; 00444 error12 = error1 + error2; 00445 00446 errsum += (error12 - e_i); 00447 area += area12 - r_i; 00448 00449 if (err_reliable1 && err_reliable2) 00450 { 00451 double delta = r_i - area12; 00452 00453 if (fabs (delta) <= 1.0e-5 * fabs (area12) && 00454 error12 >= 0.99 * e_i) 00455 { 00456 roundoff_type1++; 00457 } 00458 if (iteration >= 10 && error12 > e_i) 00459 { 00460 roundoff_type2++; 00461 } 00462 } 00463 00464 tolerance = GSL_MAX_DBL (epsabs, epsrel * fabs (area)); 00465 00466 if (errsum > tolerance) 00467 { 00468 if (roundoff_type1 >= 6 || roundoff_type2 >= 20) 00469 { 00470 error_type = 2; /* round off error */ 00471 } 00472 00473 /* set error flag in the case of bad integrand behaviour at 00474 a point of the integration range */ 00475 00476 if (this->subinterval_too_small (a1, a2, b2)) 00477 { 00478 error_type = 3; 00479 } 00480 } 00481 00482 update (this->w, a1, b1, area1, error1, a2, b2, area2, error2); 00483 00484 retrieve (this->w, &a_i, &b_i, &r_i, &e_i); 00485 00486 iteration++; 00487 00488 } 00489 while (iteration < limit && !error_type && errsum > tolerance); 00490 00491 *result = sign * sum_results (this->w); 00492 *abserr = errsum; 00493 00494 if (errsum <= tolerance) 00495 { 00496 return GSL_SUCCESS; 00497 } 00498 else if (error_type == 2) 00499 { 00500 GSL_ERROR ("roundoff error prevents tolerance from being achieved", 00501 GSL_EROUND); 00502 } 00503 else if (error_type == 3) 00504 { 00505 GSL_ERROR 00506 ("bad integrand behavior found in the integration interval", 00507 GSL_ESING); 00508 } 00509 else if (iteration == limit) 00510 { 00511 GSL_ERROR ("maximum number of subdivisions reached", GSL_EMAXITER); 00512 } 00513 else 00514 { 00515 GSL_ERROR ("could not integrate function", GSL_EFAILED); 00516 } 00517 00518 } 00519 00520 /// Desc 00521 void qc25c (func_t &func, double a, double b, double c, 00522 double *result, double *abserr, int *err_reliable, 00523 param_t &pa) 00524 { 00525 double cc = (2 * c - b - a) / (b - a); 00526 00527 if (fabs (cc) > 1.1) 00528 { 00529 double resabs, resasc; 00530 00531 double fv1[8], fv2[8]; 00532 gsl_integration_qk_o2scl(func,8,o2scl_inte_qag_coeffs::qk15_xgk, 00533 o2scl_inte_qag_coeffs::qk15_wg, 00534 o2scl_inte_qag_coeffs::qk15_wgk, 00535 fv1,fv2,a,b,result,abserr,&resabs,&resasc, 00536 pa); 00537 00538 if (*abserr == resasc) 00539 { 00540 *err_reliable = 0; 00541 } 00542 else 00543 { 00544 *err_reliable = 1; 00545 } 00546 00547 return; 00548 } 00549 else 00550 { 00551 double cheb12[13], cheb24[25], moment[25]; 00552 double res12 = 0, res24 = 0; 00553 size_t i; 00554 this->gsl_integration_qcheb (func, a, b, cheb12, cheb24, pa); 00555 this->compute_moments (cc, moment); 00556 00557 for (i = 0; i < 13; i++) 00558 { 00559 res12 += cheb12[i] * moment[i]; 00560 } 00561 00562 for (i = 0; i < 25; i++) 00563 { 00564 res24 += cheb24[i] * moment[i]; 00565 } 00566 00567 *result = res24; 00568 *abserr = fabs(res24 - res12) ; 00569 *err_reliable = 0; 00570 00571 return; 00572 } 00573 } 00574 00575 /// Desc 00576 virtual double transform(func_t &func, double x, param_t &pa) 00577 { 00578 double y; 00579 func(x,y,pa); 00580 return y/(x-s); 00581 } 00582 00583 #endif 00584 00585 /// Return string denoting type ("gsl_inte_qawc") 00586 const char *type() { return "gsl_inte_qawc"; } 00587 00588 }; 00589 00590 #ifndef DOXYGENP 00591 } 00592 #endif 00593 00594 #endif
Documentation generated with Doxygen and provided under the GNU Free Documentation License. See License Information for details.
Project hosting provided by
,
O2scl Sourceforge Project Page