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 GSL_ERROR ("iteration limit exceeds available workspace", 00100 GSL_EINVAL) ; 00101 } 00102 00103 if (b <= a) { 00104 GSL_ERROR ("limits must form an ascending sequence, a < b", 00105 GSL_EINVAL) ; 00106 } 00107 00108 if (epsabs <= 0 && (epsrel < 50 * GSL_DBL_EPSILON || 00109 epsrel < 0.5e-28)) { 00110 GSL_ERROR ("tolerance cannot be acheived with given epsabs and epsrel", 00111 GSL_EBADTOL); 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 { 00130 append_interval (workspace, a1, b1, area1, error1); 00131 append_interval (workspace, a2, b2, area2, error2); 00132 } 00133 else 00134 { 00135 append_interval (workspace, a2, b2, area2, error2); 00136 append_interval (workspace, a1, b1, area1, error1); 00137 } 00138 00139 result0 = area1 + area2; 00140 abserr0 = error1 + error2; 00141 } 00142 00143 /* Test on accuracy */ 00144 00145 tolerance = GSL_MAX_DBL (epsabs, epsrel * fabs (result0)); 00146 00147 /* Test on accuracy, use 0.01 relative error as an extra safety 00148 margin on the first iteration (ignored for subsequent iterations) */ 00149 00150 if (abserr0 < tolerance && abserr0 < 0.01 * fabs(result0)) 00151 { 00152 *result = result0; 00153 *abserr = abserr0; 00154 00155 return GSL_SUCCESS; 00156 } 00157 else if (limit == 1) 00158 { 00159 *result = result0; 00160 *abserr = abserr0; 00161 00162 GSL_ERROR ("a maximum of one iteration was insufficient", 00163 GSL_EMAXITER); 00164 } 00165 00166 area = result0; 00167 errsum = abserr0; 00168 00169 iteration = 2; 00170 00171 do 00172 { 00173 double a1, b1, a2, b2; 00174 double a_i, b_i, r_i, e_i; 00175 double area1 = 0, area2 = 0, area12 = 0; 00176 double error1 = 0, error2 = 0, error12 = 0; 00177 int err_reliable1, err_reliable2; 00178 00179 /* Bisect the subinterval with the largest error estimate */ 00180 00181 retrieve (workspace, &a_i, &b_i, &r_i, &e_i); 00182 00183 a1 = a_i; 00184 b1 = 0.5 * (a_i + b_i); 00185 a2 = b1; 00186 b2 = b_i; 00187 00188 qc25s (f, a, b, a1, b1, t, &area1, &error1, &err_reliable1); 00189 qc25s (f, a, b, a2, b2, t, &area2, &error2, &err_reliable2); 00190 00191 area12 = area1 + area2; 00192 error12 = error1 + error2; 00193 00194 errsum += (error12 - e_i); 00195 area += area12 - r_i; 00196 00197 if (err_reliable1 && err_reliable2) 00198 { 00199 double delta = r_i - area12; 00200 00201 if (fabs (delta) <= 1.0e-5 * fabs (area12) && 00202 error12 >= 0.99 * e_i) 00203 { 00204 roundoff_type1++; 00205 } 00206 if (iteration >= 10 && error12 > e_i) 00207 { 00208 roundoff_type2++; 00209 } 00210 } 00211 00212 tolerance = GSL_MAX_DBL (epsabs, epsrel * fabs (area)); 00213 00214 if (errsum > tolerance) 00215 { 00216 if (roundoff_type1 >= 6 || roundoff_type2 >= 20) 00217 { 00218 error_type = 2; /* round off error */ 00219 } 00220 00221 /* set error flag in the case of bad integrand behaviour at 00222 a point of the integration range */ 00223 00224 if (subinterval_too_small (a1, a2, b2)) 00225 { 00226 error_type = 3; 00227 } 00228 } 00229 00230 update (workspace, a1, b1, area1, error1, a2, b2, area2, error2); 00231 00232 retrieve (workspace, &a_i, &b_i, &r_i, &e_i); 00233 00234 iteration++; 00235 00236 } 00237 while (iteration < limit && !error_type && errsum > tolerance); 00238 00239 *result = sum_results (workspace); 00240 *abserr = errsum; 00241 00242 if (errsum <= tolerance) 00243 { 00244 return GSL_SUCCESS; 00245 } 00246 else if (error_type == 2) 00247 { 00248 GSL_ERROR ("roundoff error prevents tolerance from being achieved", 00249 GSL_EROUND); 00250 } 00251 else if (error_type == 3) 00252 { 00253 GSL_ERROR 00254 ("bad integrand behavior found in the integration interval", 00255 GSL_ESING); 00256 } 00257 else if (iteration == limit) 00258 { 00259 GSL_ERROR ("maximum number of subdivisions reached", GSL_EMAXITER); 00260 } 00261 else 00262 { 00263 GSL_ERROR ("could not integrate function", GSL_EFAILED); 00264 } 00265 00266 } 00267 00268 struct fn_qaws_params 00269 { 00270 gsl_function *function; 00271 double a; 00272 double b; 00273 gsl_integration_qaws_table *table; 00274 }; 00275 00276 double fn_qaws (double t, void *params); 00277 double fn_qaws_L (double x, void *params); 00278 double fn_qaws_R (double x, void *params); 00279 00280 void 00281 compute_result (const double * r, const double * cheb12, const double * cheb24, 00282 double * result12, double * result24); 00283 00284 00285 void 00286 qc25s (gsl_function * f, double a, double b, double a1, double b1, 00287 gsl_integration_qaws_table * t, 00288 double *result, double *abserr, int *err_reliable); 00289 00290 void 00291 qc25s (gsl_function * f, double a, double b, double a1, double b1, 00292 gsl_integration_qaws_table * t, 00293 double *result, double *abserr, int *err_reliable) 00294 { 00295 gsl_function weighted_function; 00296 struct fn_qaws_params fn_params; 00297 00298 fn_params.function = f; 00299 fn_params.a = a; 00300 fn_params.b = b; 00301 fn_params.table = t; 00302 00303 weighted_function.params = &fn_params; 00304 00305 if (a1 == a && (t->alpha != 0.0 || t->mu != 0)) 00306 { 00307 double cheb12[13], cheb24[25]; 00308 00309 double factor = pow(0.5 * (b1 - a1), t->alpha + 1.0); 00310 00311 weighted_function.function = &fn_qaws_R; 00312 00313 gsl_integration_qcheb (&weighted_function, a1, b1, cheb12, cheb24); 00314 00315 if (t->mu == 0) 00316 { 00317 double res12 = 0, res24 = 0; 00318 double u = factor; 00319 00320 compute_result (t->ri, cheb12, cheb24, &res12, &res24); 00321 00322 *result = u * res24; 00323 *abserr = fabs(u * (res24 - res12)); 00324 } 00325 else 00326 { 00327 double res12a = 0, res24a = 0; 00328 double res12b = 0, res24b = 0; 00329 00330 double u = factor * log(b1 - a1); 00331 double v = factor; 00332 00333 compute_result (t->ri, cheb12, cheb24, &res12a, &res24a); 00334 compute_result (t->rg, cheb12, cheb24, &res12b, &res24b); 00335 00336 *result = u * res24a + v * res24b; 00337 *abserr = fabs(u * (res24a - res12a)) + fabs(v * (res24b - res12b)); 00338 } 00339 00340 *err_reliable = 0; 00341 00342 return; 00343 } 00344 else if (b1 == b && (t->beta != 0.0 || t->nu != 0)) 00345 { 00346 double cheb12[13], cheb24[25]; 00347 double factor = pow(0.5 * (b1 - a1), t->beta + 1.0); 00348 00349 weighted_function.function = &fn_qaws_L; 00350 00351 gsl_integration_qcheb (&weighted_function, a1, b1, cheb12, cheb24); 00352 00353 if (t->nu == 0) 00354 { 00355 double res12 = 0, res24 = 0; 00356 double u = factor; 00357 00358 compute_result (t->rj, cheb12, cheb24, &res12, &res24); 00359 00360 *result = u * res24; 00361 *abserr = fabs(u * (res24 - res12)); 00362 } 00363 else 00364 { 00365 double res12a = 0, res24a = 0; 00366 double res12b = 0, res24b = 0; 00367 00368 double u = factor * log(b1 - a1); 00369 double v = factor; 00370 00371 compute_result (t->rj, cheb12, cheb24, &res12a, &res24a); 00372 compute_result (t->rh, cheb12, cheb24, &res12b, &res24b); 00373 00374 *result = u * res24a + v * res24b; 00375 *abserr = fabs(u * (res24a - res12a)) + fabs(v * (res24b - res12b)); 00376 } 00377 00378 *err_reliable = 0; 00379 00380 return; 00381 } 00382 else 00383 { 00384 double resabs, resasc; 00385 00386 weighted_function.function = &fn_qaws; 00387 00388 gsl_integration_qk15 (&weighted_function, a1, b1, result, abserr, 00389 &resabs, &resasc); 00390 00391 if (*abserr == resasc) 00392 { 00393 *err_reliable = 0; 00394 } 00395 else 00396 { 00397 *err_reliable = 1; 00398 } 00399 00400 return; 00401 } 00402 00403 } 00404 00405 double 00406 fn_qaws (double x, void *params) 00407 { 00408 struct fn_qaws_params *p = (struct fn_qaws_params *) params; 00409 gsl_function *f = p->function; 00410 gsl_integration_qaws_table *t = p->table; 00411 00412 double factor = 1.0; 00413 00414 if (t->alpha != 0.0) 00415 factor *= pow(x - p->a, t->alpha); 00416 00417 if (t->beta != 0.0) 00418 factor *= pow(p->b - x, t->beta); 00419 00420 if (t->mu == 1) 00421 factor *= log(x - p->a); 00422 00423 if (t->nu == 1) 00424 factor *= log(p->b - x); 00425 00426 return factor * GSL_FN_EVAL (f, x); 00427 } 00428 00429 double 00430 fn_qaws_L (double x, void *params) 00431 { 00432 struct fn_qaws_params *p = (struct fn_qaws_params *) params; 00433 gsl_function *f = p->function; 00434 gsl_integration_qaws_table *t = p->table; 00435 00436 double factor = 1.0; 00437 00438 if (t->alpha != 0.0) 00439 factor *= pow(x - p->a, t->alpha); 00440 00441 if (t->mu == 1) 00442 factor *= log(x - p->a); 00443 00444 return factor * GSL_FN_EVAL (f, x); 00445 } 00446 00447 double 00448 fn_qaws_R (double x, void *params) 00449 { 00450 struct fn_qaws_params *p = (struct fn_qaws_params *) params; 00451 gsl_function *f = p->function; 00452 gsl_integration_qaws_table *t = p->table; 00453 00454 double factor = 1.0; 00455 00456 if (t->beta != 0.0) 00457 factor *= pow(p->b - x, t->beta); 00458 00459 if (t->nu == 1) 00460 factor *= log(p->b - x); 00461 00462 return factor * GSL_FN_EVAL (f, x); 00463 } 00464 00465 00466 void 00467 compute_result (const double * r, const double * cheb12, const double * cheb24, 00468 double * result12, double * result24) 00469 { 00470 size_t i; 00471 double res12 = 0; 00472 double res24 = 0; 00473 00474 for (i = 0; i < 13; i++) 00475 { 00476 res12 += r[i] * cheb12[i]; 00477 } 00478 00479 for (i = 0; i < 25; i++) 00480 { 00481 res24 += r[i] * cheb24[i]; 00482 } 00483 00484 *result12 = res12; 00485 *result24 = res24; 00486 } 00487 00488 00489 /// Desc 00490 virtual double transform(func_t &func, double x, param_t &pa) 00491 { 00492 double y; 00493 func(x,y,pa); 00494 return y/(x-s); 00495 } 00496 00497 #endif 00498 00499 /// Return string denoting type ("gsl_inte_qaws") 00500 const char *type() { return "gsl_inte_qaws"; } 00501 00502 }; 00503 00504 #ifndef DOXYGENP 00505 } 00506 #endif 00507 00508 #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