gsl_inte_qawc.h

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