gsl_inte_qawc.h

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

Documentation generated with Doxygen and provided under the GNU Free Documentation License. See License Information for details.

Project hosting provided by SourceForge.net Logo, O2scl Sourceforge Project Page