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