Object-oriented Scientific Computing Library: Version 0.910
gsl_inte_qawc.h
00001 /*
00002   -------------------------------------------------------------------
00003   
00004   Copyright (C) 2006-2012, Jerry Gagelman
00005   and Andrew W. Steiner
00006   
00007   This file is part of O2scl.
00008   
00009   O2scl is free software; you can redistribute it and/or modify
00010   it under the terms of the GNU General Public License as published by
00011   the Free Software Foundation; either version 3 of the License, or
00012   (at your option) any later version.
00013   
00014   O2scl is distributed in the hope that it will be useful,
00015   but WITHOUT ANY WARRANTY; without even the implied warranty of
00016   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00017   GNU General Public License for more details.
00018   
00019   You should have received a copy of the GNU General Public License
00020   along with O2scl. If not, see <http://www.gnu.org/licenses/>.
00021 
00022   -------------------------------------------------------------------
00023 */
00024 #ifndef O2SCL_GSL_INTE_QAWC_H
00025 #define O2SCL_GSL_INTE_QAWC_H
00026 
00027 #include <o2scl/err_hnd.h>
00028 #include <o2scl/inte.h>
00029 #include <o2scl/gsl_inte_singular.h>
00030 
00031 #ifndef DOXYGENP
00032 namespace o2scl {
00033 #endif
00034   
00035   /** \brief Chebyshev integration base class (GSL)
00036 
00037       This class provides the basic Chebyshev integration functions
00038       for use in the GSL-based integration classes which
00039       require them. See \ref gslinte_subsect in the User's 
00040       guide for general information about the GSL integration classes.
00041   */
00042   template<class func_t> class gsl_inte_cheb : 
00043   public gsl_inte_transform<func_t> {
00044     
00045   protected:
00046     
00047     /// Compute the Chebyshev moments
00048     void compute_moments(double cc, double *moment) {
00049       size_t k;
00050       
00051       double a0 = log (fabs ((1.0 - cc) / (1.0 + cc)));
00052       double a1 = 2 + a0 * cc;
00053 
00054       moment[0] = a0;
00055       moment[1] = a1;
00056 
00057       for (k = 2; k < 25; k++) {
00058         double a2;
00059         
00060         if ((k % 2) == 0) {
00061           a2 = 2.0 * cc * a1 - a0;
00062         } else {
00063           const double km1 = k - 1.0;
00064           a2 = 2.0 * cc * a1 - a0 - 4.0 / (km1 * km1 - 1.0);
00065         }
00066         
00067         moment[k] = a2;
00068         
00069         a0 = a1;
00070         a1 = a2;
00071       }
00072     }
00073 
00074     /** \brief Compute Chebyshev series expansion using a FFT method
00075 
00076         The Chebyshev coefficients for the truncated expansions,
00077         \f[ 
00078         f(x) = 
00079         \frac{a_0}{2}T_0(x) + \frac{a_d}{2}T_d(x) + 
00080         \sum_{k=}^{d-1} a_k^{(d)}T_k(x),
00081         \f]
00082         are computed for \f$ d=12 \f$ and \f$ d=24 \f$ using an FFT
00083         algorithm from \ref Tolstov62 that is adapted so that the both
00084         sets of coefficients are computed simultaneously.
00085 
00086         Given the function specified in \c f, this function computes
00087         the 13 Chebyshev coefficients, \f$ C^{12}_{k} \f$ of degree 12
00088         and 25 Chebyshev coefficients of degree 24, \f$ C^{24}_{k}
00089         \f$, for the interval \f$ [a,b] \f$ using a FFT method.
00090         
00091         These coefficients are constructed to approximate
00092         the original function with
00093         \f[
00094         f = \sum_{k=1}^{13} C^{12}_{k} T_{k-1}(x)
00095         \f]
00096         and 
00097         \f[
00098         f = \sum_{k=1}^{25} C^{24}_{k} T_{k-1}(x)
00099         \f]
00100         where \f$ T_{k-1}(x) \f$ is the Chebyshev polynomial of
00101         degree \f$ k-1 \f$ evaluated at the point \f$ x \f$.
00102 
00103         It is assumed that memory for \c cheb12 and \c cheb24 has
00104         been allocated beforehand.
00105 
00106         Originally written in QUADPACK by R. Piessens and E. de
00107         Doncker, translated into C for GSL by Brian Gough, and then
00108         rewritten for \o2.
00109     */
00110     template<class func2_t> 
00111       void inte_cheb_series(func2_t &f, double a, double b, 
00112                             double *cheb12, double *cheb24) {
00113       size_t i;
00114       double fval[25], v[12];
00115       
00116       /* These are the values of cos(pi*k/24) for k=1..11 needed for the
00117          Chebyshev expansion of f(x) */
00118       
00119       const double x[11] = { 0.9914448613738104,     
00120                              0.9659258262890683,
00121                              0.9238795325112868,     
00122                              0.8660254037844386,
00123                              0.7933533402912352,     
00124                              0.7071067811865475,
00125                              0.6087614290087206,     
00126                              0.5000000000000000,
00127                              0.3826834323650898,     
00128                              0.2588190451025208,
00129                              0.1305261922200516 };
00130   
00131       const double center = 0.5 * (b + a);
00132       const double half_length =  0.5 * (b - a);
00133 
00134       double y1, y2, y3;
00135       y1=f(b);
00136       y2=f(center);
00137       y3=f(a);
00138       fval[0] = 0.5 * y1;
00139       fval[12] = y2;
00140       fval[24] = 0.5 * y3;
00141 
00142       for (i = 1; i < 12; i++) {
00143         const size_t j = 24 - i;
00144         const double u = half_length * x[i-1];
00145         double yp, ym;
00146         yp=f(center+u);
00147         ym=f(center-u);
00148         fval[i] = yp;
00149         fval[j] = ym;
00150       }
00151 
00152       for (i = 0; i < 12; i++) {
00153         const size_t j = 24 - i;
00154         v[i] = fval[i] - fval[j];
00155         fval[i] = fval[i] + fval[j];
00156       }
00157 
00158       {
00159         const double alam1 = v[0] - v[8];
00160         const double alam2 = x[5] * (v[2] - v[6] - v[10]);
00161 
00162         cheb12[3] = alam1 + alam2;
00163         cheb12[9] = alam1 - alam2;
00164       }
00165 
00166       {
00167         const double alam1 = v[1] - v[7] - v[9];
00168         const double alam2 = v[3] - v[5] - v[11];
00169         {
00170           const double alam = x[2] * alam1 + x[8] * alam2;
00171 
00172           cheb24[3] = cheb12[3] + alam;
00173           cheb24[21] = cheb12[3] - alam;
00174         }
00175 
00176         {
00177           const double alam = x[8] * alam1 - x[2] * alam2;
00178           cheb24[9] = cheb12[9] + alam;
00179           cheb24[15] = cheb12[9] - alam;
00180         }
00181       }
00182 
00183       {
00184         const double part1 = x[3] * v[4];
00185         const double part2 = x[7] * v[8];
00186         const double part3 = x[5] * v[6];
00187     
00188         {
00189           const double alam1 = v[0] + part1 + part2;
00190           const double alam2 = x[1] * v[2] + part3 + x[9] * v[10];
00191       
00192           cheb12[1] = alam1 + alam2;
00193           cheb12[11] = alam1 - alam2;
00194         }
00195     
00196         {
00197           const double alam1 = v[0] - part1 + part2;
00198           const double alam2 = x[9] * v[2] - part3 + x[1] * v[10];
00199           cheb12[5] = alam1 + alam2;
00200           cheb12[7] = alam1 - alam2;
00201         }
00202       }
00203 
00204       {
00205         const double alam = (x[0] * v[1] + x[2] * v[3] + x[4] * v[5]
00206                              + x[6] * v[7] + x[8] * v[9] + x[10] * v[11]);
00207         cheb24[1] = cheb12[1] + alam;
00208         cheb24[23] = cheb12[1] - alam;
00209       }
00210 
00211       {
00212         const double alam = (x[10] * v[1] - x[8] * v[3] + x[6] * v[5] 
00213                              - x[4] * v[7] + x[2] * v[9] - x[0] * v[11]);
00214         cheb24[11] = cheb12[11] + alam;
00215         cheb24[13] = cheb12[11] - alam;
00216       }
00217 
00218       {
00219         const double alam = (x[4] * v[1] - x[8] * v[3] - x[0] * v[5] 
00220                              - x[10] * v[7] + x[2] * v[9] + x[6] * v[11]);
00221         cheb24[5] = cheb12[5] + alam;
00222         cheb24[19] = cheb12[5] - alam;
00223       }
00224 
00225       {
00226         const double alam = (x[6] * v[1] - x[2] * v[3] - x[10] * v[5] 
00227                              + x[0] * v[7] - x[8] * v[9] - x[4] * v[11]);
00228         cheb24[7] = cheb12[7] + alam;
00229         cheb24[17] = cheb12[7] - alam;
00230       }
00231 
00232       for (i = 0; i < 6; i++) {
00233         const size_t j = 12 - i;
00234         v[i] = fval[i] - fval[j];
00235         fval[i] = fval[i] + fval[j];
00236       }
00237 
00238       {
00239         const double alam1 = v[0] + x[7] * v[4];
00240         const double alam2 = x[3] * v[2];
00241 
00242         cheb12[2] = alam1 + alam2;
00243         cheb12[10] = alam1 - alam2;
00244       }
00245 
00246       cheb12[6] = v[0] - v[4];
00247 
00248       {
00249         const double alam = x[1] * v[1] + x[5] * v[3] + x[9] * v[5];
00250         cheb24[2] = cheb12[2] + alam;
00251         cheb24[22] = cheb12[2] - alam;
00252       }
00253 
00254       {
00255         const double alam = x[5] * (v[1] - v[3] - v[5]);
00256         cheb24[6] = cheb12[6] + alam;
00257         cheb24[18] = cheb12[6] - alam;
00258       }
00259 
00260       {
00261         const double alam = x[9] * v[1] - x[5] * v[3] + x[1] * v[5];
00262         cheb24[10] = cheb12[10] + alam;
00263         cheb24[14] = cheb12[10] - alam;
00264       }
00265 
00266       for (i = 0; i < 3; i++) {
00267         const size_t j = 6 - i;
00268         v[i] = fval[i] - fval[j];
00269         fval[i] = fval[i] + fval[j];
00270       }
00271 
00272       cheb12[4] = v[0] + x[7] * v[2];
00273       cheb12[8] = fval[0] - x[7] * fval[2];
00274 
00275       {
00276         const double alam = x[3] * v[1];
00277         cheb24[4] = cheb12[4] + alam;
00278         cheb24[20] = cheb12[4] - alam;
00279       }
00280 
00281       {
00282         const double alam = x[7] * fval[1] - fval[3];
00283         cheb24[8] = cheb12[8] + alam;
00284         cheb24[16] = cheb12[8] - alam;
00285       }
00286 
00287       cheb12[0] = fval[0] + fval[2];
00288 
00289       {
00290         const double alam = fval[1] + fval[3];
00291         cheb24[0] = cheb12[0] + alam;
00292         cheb24[24] = cheb12[0] - alam;
00293       }
00294 
00295       cheb12[12] = v[0] - v[2];
00296       cheb24[12] = cheb12[12];
00297 
00298       for (i = 1; i < 12; i++) {
00299         cheb12[i] *= 1.0 / 6.0;
00300       }
00301 
00302       cheb12[0] *= 1.0 / 12.0;
00303       cheb12[12] *= 1.0 / 12.0;
00304 
00305       for (i = 1; i < 24; i++) {
00306         cheb24[i] *= 1.0 / 12.0;
00307       }
00308 
00309       cheb24[0] *= 1.0 / 24.0;
00310       cheb24[24] *= 1.0 / 24.0;
00311     }
00312 
00313   };
00314 
00315   /** \brief Adaptive Cauchy principal value integration (GSL)
00316 
00317       The Cauchy principal value of the integral of 
00318       \f[
00319       \int_a^b \frac{f(x)}{x-c}~dx =
00320       \lim_{\epsilon\to 0^+}
00321       \left\{ \int_a^{c-\epsilon} \frac{f(x)}{x-c}~dx +
00322       \int_{c+\epsilon}^b \frac{f(x)}{x-c}~dx \right\}.
00323       \f]
00324       over \f$ (a,b), \f$ with a singularity at \f$ c, \f$ is
00325       computed. The adaptive refinement algorithm described for
00326       gsl_inte_qag is used with modifications to ensure that
00327       subdivisions do not occur at the singular point \f$ x = c\f$ .
00328       When a subinterval contains the point \f$ x = c \f$ or is close
00329       to it, a special 25-point modified Clenshaw-Curtis rule is used
00330       to control the singularity. Further away from the singularity
00331       the algorithm uses a Gauss-Kronrod integration rule.
00332       
00333       The location of the singularity must be specified before-hand in
00334       gsl_inte_qawc::s, and the singularity must not be at one of the
00335       endpoints. Note that when integrating a function of the form \f$
00336       \frac{f(x)}{(x-s)} \f$, the denominator \f$ (x-s) \f$ must not
00337       be specified in the argument \c func to integ(). Note that this
00338       is different from how the \ref cern_cauchy operates.
00339 
00340       See \ref gslinte_subsect in the User's guide for general
00341       information about the GSL integration classes.
00342 
00343       \future Make cern_cauchy and this class consistent in the
00344       way which they require the user to provide the denominator
00345       in the integrand
00346   */
00347   template<class func_t> class gsl_inte_qawc : 
00348   public gsl_inte_cheb<func_t> {
00349     
00350   public:
00351 
00352     gsl_inte_qawc() {
00353     }
00354 
00355     virtual ~gsl_inte_qawc() {}
00356     
00357     /// The singularity
00358     double s;
00359 
00360     /** \brief Integrate function \c func from \c a to \c b and place
00361         the result in \c res and the error in \c err
00362     */
00363     virtual int integ_err(func_t &func, double a, double b, 
00364                           double &res, double &err) {
00365       
00366       this->last_conv=0;
00367       return qawc(func,a,b,s,this->tol_abs,this->tol_rel,&res,&err);
00368     }
00369 
00370 #ifndef DOXYGEN_INTERNAL
00371 
00372   protected:
00373 
00374     /** \brief The full GSL integration routine called by integ_err()
00375      */
00376     int qawc(func_t &func, const double a, const double b, const double c,
00377              const double epsabs, const double epsrel, 
00378              double *result, double *abserr) {
00379       
00380       double area, errsum;
00381       double result0, abserr0;
00382       double tolerance;
00383       size_t iteration = 0;
00384       int roundoff_type1 = 0, roundoff_type2 = 0, error_type = 0;
00385       int err_reliable;
00386       int sign = 1;
00387       double lower, higher;
00388 
00389       /* Initialize results */
00390 
00391       *result = 0;
00392       *abserr = 0;
00393 
00394       size_t limit=this->w->limit;
00395 
00396       if (b < a)  {
00397         lower = b; 
00398         higher = a;
00399         sign = -1;
00400       } else {
00401         lower = a;
00402         higher = b;
00403       }
00404 
00405       this->w->initialise(lower,higher);
00406 
00407       if (epsabs <= 0 && (epsrel < 50 * GSL_DBL_EPSILON || 
00408                           epsrel < 0.5e-28)) {
00409         this->last_iter=0;
00410         std::string estr="Tolerance cannot be achieved with given ";
00411         estr+="value of tol_abs, "+dtos(epsabs)+", and tol_rel, "+
00412           dtos(epsrel)+", in gsl_inte_qawc::qawc().";
00413         O2SCL_ERR_RET(estr.c_str(),gsl_ebadtol);
00414       }
00415 
00416       if (c == a || c == b) {
00417         this->last_iter=0;
00418         std::string estr="Cannot integrate with singularity on endpoint ";
00419         estr+="in gsl_inte_qawc::qawc().";
00420         O2SCL_ERR_RET(estr.c_str(),gsl_einval);
00421       }      
00422 
00423       /* perform the first integration */
00424       
00425       qc25c (func, lower, higher, c, &result0, &abserr0, &err_reliable);
00426 
00427       this->w->set_initial_result (result0, abserr0);
00428 
00429       /* Test on accuracy, use 0.01 relative error as an extra safety
00430          margin on the first iteration (ignored for subsequent iterations) 
00431       */
00432       tolerance = GSL_MAX_DBL (epsabs, epsrel * fabs (result0));
00433 
00434       if (abserr0 < tolerance && abserr0 < 0.01 * fabs(result0)) {
00435 
00436         this->last_iter=1;
00437         *result = sign * result0;
00438         *abserr = abserr0;
00439         return gsl_success;
00440 
00441       } else if (limit == 1) {
00442 
00443         *result = sign * result0;
00444         *abserr = abserr0;
00445 
00446         this->last_iter=1;
00447         this->last_conv=gsl_emaxiter;
00448         std::string estr="A maximum of 1 iteration was insufficient ";
00449         estr+="in gsl_inte_qawc::qawc().";
00450         O2SCL_CONV_RET(estr.c_str(),gsl_emaxiter,this->err_nonconv);
00451       }
00452 
00453       area = result0;
00454       errsum = abserr0;
00455 
00456       iteration = 1;
00457 
00458       do {
00459 
00460         double a1, b1, a2, b2;
00461         double a_i, b_i, r_i, e_i;
00462         double area1 = 0, area2 = 0, area12 = 0;
00463         double error1 = 0, error2 = 0, error12 = 0;
00464         int err_reliable1, err_reliable2;
00465 
00466         /* Bisect the subinterval with the largest error estimate */
00467 
00468         this->w->retrieve (&a_i, &b_i, &r_i, &e_i);
00469 
00470         a1 = a_i; 
00471         b1 = 0.5 * (a_i + b_i);
00472         a2 = b1;
00473         b2 = b_i;
00474 
00475         if (c > a1 && c <= b1) {
00476           b1 = 0.5 * (c + b2) ;
00477           a2 = b1;
00478         } else if (c > b1 && c < b2) {
00479           b1 = 0.5 * (a1 + c) ;
00480           a2 = b1;
00481         }
00482 
00483         qc25c (func, a1, b1, c, &area1, &error1, &err_reliable1);
00484         qc25c (func, a2, b2, c, &area2, &error2, &err_reliable2);
00485 
00486         area12 = area1 + area2;
00487         error12 = error1 + error2;
00488 
00489         errsum += (error12 - e_i);
00490         area += area12 - r_i;
00491 
00492         if (err_reliable1 && err_reliable2) {
00493           double delta = r_i - area12;
00494 
00495           if (fabs (delta) <= 1.0e-5 * fabs (area12) && 
00496               error12 >= 0.99 * e_i) {
00497             roundoff_type1++;
00498           }
00499           if (iteration >= 10 && error12 > e_i) {
00500             roundoff_type2++;
00501           }
00502         }
00503 
00504         tolerance = GSL_MAX_DBL (epsabs, epsrel * fabs (area));
00505 
00506         if (errsum > tolerance) {
00507           if (roundoff_type1 >= 6 || roundoff_type2 >= 20) {
00508             error_type = 2;   /* round off error */
00509           }
00510 
00511           /* set error flag in the case of bad integrand behaviour at
00512              a point of the integration range */
00513 
00514           if (this->w->subinterval_too_small (a1, a2, b2)) {
00515             error_type = 3;
00516           }
00517         }
00518 
00519         this->w->update (a1, b1, area1, error1, a2, b2, area2, error2);
00520 
00521         this->w->retrieve (&a_i, &b_i, &r_i, &e_i);
00522 
00523         if (this->verbose>0) {
00524           std::cout << "gsl_inte_qawc Iter: " << iteration;
00525           std::cout.setf(std::ios::showpos);
00526           std::cout << " Res: " << area;
00527           std::cout.unsetf(std::ios::showpos);
00528           std::cout << " Err: " << errsum
00529                     << " Tol: " << tolerance << std::endl;
00530           if (this->verbose>1) {
00531             char ch;
00532             std::cout << "Press a key and type enter to continue. " ;
00533             std::cin >> ch;
00534           }
00535         }
00536 
00537         iteration++;
00538 
00539       } while (iteration < limit && !error_type && errsum > tolerance);
00540 
00541       *result = sign * this->w->sum_results();
00542       *abserr = errsum;
00543 
00544       this->last_iter=iteration;
00545       if (errsum <= tolerance) {
00546         return GSL_SUCCESS;
00547       } else if (error_type == 2) {
00548         this->last_conv=gsl_eround;
00549         std::string estr="Roundoff error prevents tolerance ";
00550         estr+="from being achieved in gsl_inte_qawc::qawc().";
00551         O2SCL_CONV_RET(estr.c_str(),gsl_eround,this->err_nonconv);
00552       } else if (error_type == 3) {
00553         this->last_conv=gsl_esing;
00554         std::string estr="Bad integrand behavior ";
00555         estr+=" in gsl_inte_qawc::qawc().";
00556         O2SCL_CONV_RET(estr.c_str(),gsl_esing,this->err_nonconv);
00557       } else if (iteration == limit) {
00558         this->last_conv=gsl_emaxiter;
00559         std::string estr="Maximum number of subdivisions ("+itos(iteration);
00560         estr+=") reached in gsl_inte_qawc::qawc().";
00561         O2SCL_CONV_RET(estr.c_str(),gsl_emaxiter,this->err_nonconv);
00562       } else {
00563         std::string estr="Could not integrate function in gsl_inte_qawc::";
00564         estr+="qawc() (it may have returned a non-finite result).";
00565         O2SCL_ERR_RET(estr.c_str(),gsl_efailed);
00566       }
00567 
00568       // No return statement needed since the above if statement
00569       // always forces a return
00570     }
00571 
00572     /// 25-point quadrature for Cauchy principal values
00573     void qc25c(func_t &func, double a, double b, double c, 
00574                double *result, double *abserr, int *err_reliable) {
00575 
00576       double cc = (2 * c - b - a) / (b - a);
00577       
00578       if (fabs (cc) > 1.1) {
00579         double resabs, resasc;
00580             
00581         gauss_kronrod(func,a,b,result,abserr,&resabs,&resasc);
00582       
00583         if (*abserr == resasc) {
00584           *err_reliable = 0;
00585         } else {
00586           *err_reliable = 1;
00587         }
00588 
00589         return;
00590 
00591       } else {
00592 
00593         double cheb12[13], cheb24[25], moment[25];
00594         double res12 = 0, res24 = 0;
00595         size_t i;
00596         this->inte_cheb_series(func, a, b, cheb12, cheb24);
00597         this->compute_moments (cc, moment);
00598           
00599         for (i = 0; i < 13; i++) {
00600           res12 += cheb12[i] * moment[i];
00601         }
00602           
00603         for (i = 0; i < 25; i++) {
00604           res24 += cheb24[i] * moment[i];
00605         }
00606           
00607         *result = res24;
00608         *abserr = fabs(res24 - res12) ;
00609         *err_reliable = 0;
00610 
00611         return;
00612       }
00613     }
00614 
00615     /// Add the singularity to the function
00616     virtual double transform(double t, func_t &func) {
00617       double y;
00618       y=func(t);
00619       return y/(t-s);
00620     }
00621 
00622 #endif
00623   
00624     /// Return string denoting type ("gsl_inte_qawc")
00625     const char *type() { return "gsl_inte_qawc"; }
00626   
00627   };
00628 
00629 #ifndef DOXYGENP
00630 }
00631 #endif
00632 
00633 #endif
 All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Defines

Documentation generated with Doxygen. Provided under the GNU Free Documentation License (see License Information).

Get Object-oriented Scientific Computing
Lib at SourceForge.net. Fast, secure and Free Open Source software
downloads.