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