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