00001 /* 00002 ------------------------------------------------------------------- 00003 00004 Copyright (C) 2006, 2007, 2008, 2009, 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 /** 00034 \brief Chebyshev integration base class (GSL) 00035 00036 This class provides the basic Chebyshev integration functions 00037 for use in the GSL-based integration classes which 00038 require them. 00039 00040 */ 00041 template<class param_t, class func_t> class gsl_inte_cheb : 00042 public gsl_inte_transform<param_t,func_t> { 00043 00044 public: 00045 00046 /// Compute the Chebyshev moments 00047 void compute_moments(double cc, double *moment) { 00048 size_t k; 00049 00050 double a0 = log (fabs ((1.0 - cc) / (1.0 + cc))); 00051 double a1 = 2 + a0 * cc; 00052 00053 moment[0] = a0; 00054 moment[1] = a1; 00055 00056 for (k = 2; k < 25; k++) { 00057 double a2; 00058 00059 if ((k % 2) == 0) { 00060 a2 = 2.0 * cc * a1 - a0; 00061 } else { 00062 const double km1 = k - 1.0; 00063 a2 = 2.0 * cc * a1 - a0 - 4.0 / (km1 * km1 - 1.0); 00064 } 00065 00066 moment[k] = a2; 00067 00068 a0 = a1; 00069 a1 = a2; 00070 } 00071 } 00072 00073 /** \brief Perform the integration 00074 00075 piessens,robert,appl. math. & progr. div. - k.u.leuven 00076 de doncker,elise,appl. math. & progr. div. - k.u.leuven 00077 00078 this routine computes the chebyshev series expansion 00079 of degrees 12 and 24 of a function using a 00080 fast fourier transform method 00081 f(x) = sum(k=1,..,13) (cheb12(k)*t(k-1,x)), 00082 f(x) = sum(k=1,..,25) (cheb24(k)*t(k-1,x)), 00083 where t(k,x) is the chebyshev polynomial of degree k. 00084 00085 00086 x - double precision 00087 vector of dimension 11 containing the 00088 values cos(k*pi/24), k = 1, ..., 11 00089 00090 fval - double precision 00091 vector of dimension 25 containing the 00092 function values at the points 00093 (b+a+(b-a)*cos(k*pi/24))/2, k = 0, ...,24, 00094 where (a,b) is the approximation interval. 00095 fval(1) and fval(25) are divided by two 00096 (these values are destroyed at output). 00097 00098 on return 00099 cheb12 - double precision 00100 vector of dimension 13 containing the 00101 chebyshev coefficients for degree 12 00102 00103 cheb24 - double precision 00104 vector of dimension 25 containing the 00105 chebyshev coefficients for degree 24 00106 00107 */ 00108 void gsl_integration_qcheb(func_t &f, double a, double b, 00109 double *cheb12, double *cheb24, 00110 param_t &pa) { 00111 size_t i; 00112 double fval[25], v[12]; 00113 00114 /* These are the values of cos(pi*k/24) for k=1..11 needed for the 00115 Chebyshev expansion of f(x) */ 00116 00117 const double x[11] = { 0.9914448613738104, 00118 0.9659258262890683, 00119 0.9238795325112868, 00120 0.8660254037844386, 00121 0.7933533402912352, 00122 0.7071067811865475, 00123 0.6087614290087206, 00124 0.5000000000000000, 00125 0.3826834323650898, 00126 0.2588190451025208, 00127 0.1305261922200516 }; 00128 00129 const double center = 0.5 * (b + a); 00130 const double half_length = 0.5 * (b - a); 00131 00132 double y1, y2, y3; 00133 f(b,y1,pa); 00134 f(center,y2,pa); 00135 f(a,y3,pa); 00136 fval[0] = 0.5 * y1; 00137 fval[12] = y2; 00138 fval[24] = 0.5 * y3; 00139 00140 for (i = 1; i < 12; i++) { 00141 const size_t j = 24 - i; 00142 const double u = half_length * x[i-1]; 00143 double yp, ym; 00144 f(center+u,yp,pa); 00145 f(center-u,ym,pa); 00146 fval[i] = yp; 00147 fval[j] = ym; 00148 } 00149 00150 for (i = 0; i < 12; i++) { 00151 const size_t j = 24 - i; 00152 v[i] = fval[i] - fval[j]; 00153 fval[i] = fval[i] + fval[j]; 00154 } 00155 00156 { 00157 const double alam1 = v[0] - v[8]; 00158 const double alam2 = x[5] * (v[2] - v[6] - v[10]); 00159 00160 cheb12[3] = alam1 + alam2; 00161 cheb12[9] = alam1 - alam2; 00162 } 00163 00164 { 00165 const double alam1 = v[1] - v[7] - v[9]; 00166 const double alam2 = v[3] - v[5] - v[11]; 00167 { 00168 const double alam = x[2] * alam1 + x[8] * alam2; 00169 00170 cheb24[3] = cheb12[3] + alam; 00171 cheb24[21] = cheb12[3] - alam; 00172 } 00173 00174 { 00175 const double alam = x[8] * alam1 - x[2] * alam2; 00176 cheb24[9] = cheb12[9] + alam; 00177 cheb24[15] = cheb12[9] - alam; 00178 } 00179 } 00180 00181 { 00182 const double part1 = x[3] * v[4]; 00183 const double part2 = x[7] * v[8]; 00184 const double part3 = x[5] * v[6]; 00185 00186 { 00187 const double alam1 = v[0] + part1 + part2; 00188 const double alam2 = x[1] * v[2] + part3 + x[9] * v[10]; 00189 00190 cheb12[1] = alam1 + alam2; 00191 cheb12[11] = alam1 - alam2; 00192 } 00193 00194 { 00195 const double alam1 = v[0] - part1 + part2; 00196 const double alam2 = x[9] * v[2] - part3 + x[1] * v[10]; 00197 cheb12[5] = alam1 + alam2; 00198 cheb12[7] = alam1 - alam2; 00199 } 00200 } 00201 00202 { 00203 const double alam = (x[0] * v[1] + x[2] * v[3] + x[4] * v[5] 00204 + x[6] * v[7] + x[8] * v[9] + x[10] * v[11]); 00205 cheb24[1] = cheb12[1] + alam; 00206 cheb24[23] = cheb12[1] - alam; 00207 } 00208 00209 { 00210 const double alam = (x[10] * v[1] - x[8] * v[3] + x[6] * v[5] 00211 - x[4] * v[7] + x[2] * v[9] - x[0] * v[11]); 00212 cheb24[11] = cheb12[11] + alam; 00213 cheb24[13] = cheb12[11] - alam; 00214 } 00215 00216 { 00217 const double alam = (x[4] * v[1] - x[8] * v[3] - x[0] * v[5] 00218 - x[10] * v[7] + x[2] * v[9] + x[6] * v[11]); 00219 cheb24[5] = cheb12[5] + alam; 00220 cheb24[19] = cheb12[5] - alam; 00221 } 00222 00223 { 00224 const double alam = (x[6] * v[1] - x[2] * v[3] - x[10] * v[5] 00225 + x[0] * v[7] - x[8] * v[9] - x[4] * v[11]); 00226 cheb24[7] = cheb12[7] + alam; 00227 cheb24[17] = cheb12[7] - alam; 00228 } 00229 00230 for (i = 0; i < 6; i++) { 00231 const size_t j = 12 - i; 00232 v[i] = fval[i] - fval[j]; 00233 fval[i] = fval[i] + fval[j]; 00234 } 00235 00236 { 00237 const double alam1 = v[0] + x[7] * v[4]; 00238 const double alam2 = x[3] * v[2]; 00239 00240 cheb12[2] = alam1 + alam2; 00241 cheb12[10] = alam1 - alam2; 00242 } 00243 00244 cheb12[6] = v[0] - v[4]; 00245 00246 { 00247 const double alam = x[1] * v[1] + x[5] * v[3] + x[9] * v[5]; 00248 cheb24[2] = cheb12[2] + alam; 00249 cheb24[22] = cheb12[2] - alam; 00250 } 00251 00252 { 00253 const double alam = x[5] * (v[1] - v[3] - v[5]); 00254 cheb24[6] = cheb12[6] + alam; 00255 cheb24[18] = cheb12[6] - alam; 00256 } 00257 00258 { 00259 const double alam = x[9] * v[1] - x[5] * v[3] + x[1] * v[5]; 00260 cheb24[10] = cheb12[10] + alam; 00261 cheb24[14] = cheb12[10] - alam; 00262 } 00263 00264 for (i = 0; i < 3; i++) { 00265 const size_t j = 6 - i; 00266 v[i] = fval[i] - fval[j]; 00267 fval[i] = fval[i] + fval[j]; 00268 } 00269 00270 cheb12[4] = v[0] + x[7] * v[2]; 00271 cheb12[8] = fval[0] - x[7] * fval[2]; 00272 00273 { 00274 const double alam = x[3] * v[1]; 00275 cheb24[4] = cheb12[4] + alam; 00276 cheb24[20] = cheb12[4] - alam; 00277 } 00278 00279 { 00280 const double alam = x[7] * fval[1] - fval[3]; 00281 cheb24[8] = cheb12[8] + alam; 00282 cheb24[16] = cheb12[8] - alam; 00283 } 00284 00285 cheb12[0] = fval[0] + fval[2]; 00286 00287 { 00288 const double alam = fval[1] + fval[3]; 00289 cheb24[0] = cheb12[0] + alam; 00290 cheb24[24] = cheb12[0] - alam; 00291 } 00292 00293 cheb12[12] = v[0] - v[2]; 00294 cheb24[12] = cheb12[12]; 00295 00296 for (i = 1; i < 12; i++) { 00297 cheb12[i] *= 1.0 / 6.0; 00298 } 00299 00300 cheb12[0] *= 1.0 / 12.0; 00301 cheb12[12] *= 1.0 / 12.0; 00302 00303 for (i = 1; i < 24; i++) { 00304 cheb24[i] *= 1.0 / 12.0; 00305 } 00306 00307 cheb24[0] *= 1.0 / 24.0; 00308 cheb24[24] *= 1.0 / 24.0; 00309 } 00310 00311 }; 00312 00313 /** 00314 \brief Adaptive Cauchy principal value integration (GSL) 00315 00316 The location of the singularity must be specified before-hand in 00317 gsl_inte_qawc::s, and the singularity must not be at one of the 00318 endpoints. Note that when integrating a function of the form 00319 \f$ \frac{f(x)}{(x-s)} \f$, the denominator \f$ (x-s) \f$ must 00320 not be specified in the argument \c func to integ(). This is 00321 different from how the \ref cern_cauchy operates. 00322 00323 The number of subdivisions of the original interval which 00324 this class is allowed to make is dictated by the workspace 00325 size for the integration class, which can be set using 00326 \ref gsl_inte_table::set_wkspace() . 00327 00328 \future Make cern_cauchy and this class consistent in the 00329 way which they require the user to provide the denominator 00330 in the integrand 00331 */ 00332 template<class param_t, class func_t> class gsl_inte_qawc : 00333 public gsl_inte_cheb<param_t,func_t> { 00334 00335 public: 00336 00337 gsl_inte_qawc() { 00338 } 00339 00340 virtual ~gsl_inte_qawc() {} 00341 00342 /** \brief Integrate function \c func from \c a to \c b. 00343 */ 00344 virtual double integ(func_t &func, double a, double b, param_t &pa) { 00345 double res, err; 00346 integ_err(func,a,b,pa,res,err); 00347 this->interror=err; 00348 return res; 00349 } 00350 00351 /// The singularity 00352 double s; 00353 00354 /** \brief Integrate function \c func from \c a to \c b and place 00355 the result in \c res and the error in \c err 00356 */ 00357 virtual int integ_err(func_t &func, double a, double b, 00358 param_t &pa, double &res, double &err2) { 00359 00360 int status=qawc(func,a,b,s,this->tolx,this->tolf,this->wkspace, 00361 &res,&err2,pa); 00362 00363 return status; 00364 00365 } 00366 00367 #ifndef DOXYGEN_INTERNAL 00368 00369 protected: 00370 00371 /** 00372 \brief The full GSL integration routine called by integ_err() 00373 */ 00374 int qawc(func_t &func, const double a, const double b, const double c, 00375 const double epsabs, const double epsrel, const size_t limit, 00376 double *result, double *abserr, param_t &pa) { 00377 00378 double area, errsum; 00379 double result0, abserr0; 00380 double tolerance; 00381 size_t iteration = 0; 00382 int roundoff_type1 = 0, roundoff_type2 = 0, error_type = 0; 00383 int err_reliable; 00384 int sign = 1; 00385 double lower, higher; 00386 00387 /* Initialize results */ 00388 00389 *result = 0; 00390 *abserr = 0; 00391 00392 if (limit > this->w->limit) { 00393 std::string estr="Iteration limit exceeds workspace "; 00394 estr+="in gsl_inte_qawc::qawc()."; 00395 O2SCL_ERR_RET(estr.c_str(),gsl_einval); 00396 } 00397 00398 if (b < a) { 00399 lower = b ; 00400 higher = a ; 00401 sign = -1 ; 00402 } else { 00403 lower = a; 00404 higher = b; 00405 } 00406 00407 initialise (this->w, lower, higher); 00408 00409 if (epsabs <= 0 && (epsrel < 50 * GSL_DBL_EPSILON || 00410 epsrel < 0.5e-28)) { 00411 std::string estr="Tolerance cannot be achieved with given "; 00412 estr+="value of 'tolx' and 'tolf' in gsl_inte_qawc::qawc()."; 00413 O2SCL_ERR_RET(estr.c_str(),gsl_ebadtol); 00414 } 00415 00416 if (c == a || c == b) { 00417 std::string estr="Cannot integrate with singularity on endpoint "; 00418 estr+="in gsl_inte_qawc::qawc()."; 00419 O2SCL_ERR_RET(estr.c_str(),gsl_einval); 00420 } 00421 00422 /* perform the first integration */ 00423 00424 qc25c (func, lower, higher, c, &result0, &abserr0, &err_reliable, pa); 00425 00426 set_initial_result (this->w, result0, abserr0); 00427 00428 /* Test on accuracy, use 0.01 relative error as an extra safety 00429 margin on the first iteration (ignored for subsequent iterations) 00430 */ 00431 tolerance = GSL_MAX_DBL (epsabs, epsrel * fabs (result0)); 00432 00433 if (abserr0 < tolerance && abserr0 < 0.01 * fabs(result0)) { 00434 *result = sign * result0; 00435 *abserr = abserr0; 00436 00437 return GSL_SUCCESS; 00438 00439 } else if (limit == 1) { 00440 00441 *result = sign * result0; 00442 *abserr = abserr0; 00443 00444 std::string estr="A maximum of 1 iteration was insufficient "; 00445 estr+="in gsl_inte_qawc::qawc()."; 00446 O2SCL_ERR_RET(estr.c_str(),gsl_emaxiter); 00447 } 00448 00449 area = result0; 00450 errsum = abserr0; 00451 00452 iteration = 1; 00453 00454 do { 00455 00456 double a1, b1, a2, b2; 00457 double a_i, b_i, r_i, e_i; 00458 double area1 = 0, area2 = 0, area12 = 0; 00459 double error1 = 0, error2 = 0, error12 = 0; 00460 int err_reliable1, err_reliable2; 00461 00462 /* Bisect the subinterval with the largest error estimate */ 00463 00464 retrieve (this->w, &a_i, &b_i, &r_i, &e_i); 00465 00466 a1 = a_i; 00467 b1 = 0.5 * (a_i + b_i); 00468 a2 = b1; 00469 b2 = b_i; 00470 00471 if (c > a1 && c <= b1) { 00472 b1 = 0.5 * (c + b2) ; 00473 a2 = b1; 00474 } else if (c > b1 && c < b2) { 00475 b1 = 0.5 * (a1 + c) ; 00476 a2 = b1; 00477 } 00478 00479 qc25c (func, a1, b1, c, &area1, &error1, &err_reliable1, pa); 00480 qc25c (func, a2, b2, c, &area2, &error2, &err_reliable2, pa); 00481 00482 area12 = area1 + area2; 00483 error12 = error1 + error2; 00484 00485 errsum += (error12 - e_i); 00486 area += area12 - r_i; 00487 00488 if (err_reliable1 && err_reliable2) { 00489 double delta = r_i - area12; 00490 00491 if (fabs (delta) <= 1.0e-5 * fabs (area12) && 00492 error12 >= 0.99 * e_i) { 00493 roundoff_type1++; 00494 } 00495 if (iteration >= 10 && error12 > e_i) { 00496 roundoff_type2++; 00497 } 00498 } 00499 00500 tolerance = GSL_MAX_DBL (epsabs, epsrel * fabs (area)); 00501 00502 if (errsum > tolerance) { 00503 if (roundoff_type1 >= 6 || roundoff_type2 >= 20) { 00504 error_type = 2; /* round off error */ 00505 } 00506 00507 /* set error flag in the case of bad integrand behaviour at 00508 a point of the integration range */ 00509 00510 if (this->subinterval_too_small (a1, a2, b2)) { 00511 error_type = 3; 00512 } 00513 } 00514 00515 update (this->w, a1, b1, area1, error1, a2, b2, area2, error2); 00516 00517 retrieve (this->w, &a_i, &b_i, &r_i, &e_i); 00518 00519 iteration++; 00520 00521 } while (iteration < limit && !error_type && errsum > tolerance); 00522 00523 *result = sign * sum_results (this->w); 00524 *abserr = errsum; 00525 00526 if (errsum <= tolerance) { 00527 return GSL_SUCCESS; 00528 } else if (error_type == 2) { 00529 std::string estr="Roundoff error prevents tolerance "; 00530 estr+="from being achieved in gsl_inte_qawc::qawc()."; 00531 O2SCL_ERR_RET(estr.c_str(),gsl_eround); 00532 } else if (error_type == 3) { 00533 std::string estr="Bad integrand behavior "; 00534 estr+=" in gsl_inte_qawc::qawc()."; 00535 O2SCL_ERR_RET(estr.c_str(),gsl_esing); 00536 } else if (iteration == limit) { 00537 std::string estr="Maximum number of subdivisions reached"; 00538 estr+=" in gsl_inte_qawc::qawc()."; 00539 O2SCL_ERR_RET(estr.c_str(),gsl_emaxiter); 00540 } else { 00541 std::string estr="Could not integrate function in gsl_inte_qawc::"; 00542 estr+="qawc() (it may have returned a non-finite result)."; 00543 O2SCL_ERR_RET(estr.c_str(),gsl_efailed); 00544 } 00545 00546 // No return statement needed since the above if statement 00547 // always forces a return 00548 } 00549 00550 /// 25-point quadrature for Cauchy principal values 00551 void qc25c(func_t &func, double a, double b, double c, 00552 double *result, double *abserr, int *err_reliable, 00553 param_t &pa) { 00554 double cc = (2 * c - b - a) / (b - a); 00555 00556 if (fabs (cc) > 1.1) { 00557 double resabs, resasc; 00558 00559 double fv1[8], fv2[8]; 00560 gsl_integration_qk_o2scl(func,8,o2scl_inte_qag_coeffs::qk15_xgk, 00561 o2scl_inte_qag_coeffs::qk15_wg, 00562 o2scl_inte_qag_coeffs::qk15_wgk, 00563 fv1,fv2,a,b,result,abserr,&resabs,&resasc, 00564 pa); 00565 00566 if (*abserr == resasc) { 00567 *err_reliable = 0; 00568 } else { 00569 *err_reliable = 1; 00570 } 00571 00572 return; 00573 } else { 00574 00575 double cheb12[13], cheb24[25], moment[25]; 00576 double res12 = 0, res24 = 0; 00577 size_t i; 00578 this->gsl_integration_qcheb (func, a, b, cheb12, cheb24, pa); 00579 this->compute_moments (cc, moment); 00580 00581 for (i = 0; i < 13; i++) { 00582 res12 += cheb12[i] * moment[i]; 00583 } 00584 00585 for (i = 0; i < 25; i++) { 00586 res24 += cheb24[i] * moment[i]; 00587 } 00588 00589 *result = res24; 00590 *abserr = fabs(res24 - res12) ; 00591 *err_reliable = 0; 00592 00593 return; 00594 } 00595 } 00596 00597 /// Add the singularity to the function 00598 virtual double transform(func_t &func, double x, param_t &pa) { 00599 double y; 00600 func(x,y,pa); 00601 return y/(x-s); 00602 } 00603 00604 #endif 00605 00606 /// Return string denoting type ("gsl_inte_qawc") 00607 const char *type() { return "gsl_inte_qawc"; } 00608 00609 }; 00610 00611 #ifndef DOXYGENP 00612 } 00613 #endif 00614 00615 #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