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