gsl_inte_qag.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_QAG_H
00024 #define O2SCL_GSL_INTE_QAG_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 Adaptive integration a function with finite limits of 
00034       integration (GSL)
00035       
00036       \todo Verbose output has been setup for this class, but this
00037       needs to be done for some of the other GSL-like integrators
00038   */
00039   template<class param_t, class func_t> class gsl_inte_qag : 
00040   public gsl_inte_kronrod<param_t,func_t> {
00041     
00042 #ifndef DOXYGEN_INTERNAL
00043 
00044   protected:
00045 
00046     /// Select the number of integration points
00047     int lkey;
00048 
00049 #endif
00050 
00051   public:
00052 
00053     gsl_inte_qag(int key=1) {
00054       lkey=1;
00055       if (key>=1 && key<=6){
00056         lkey=key;
00057       }
00058     }
00059 
00060     virtual ~gsl_inte_qag() {}
00061       
00062     /** 
00063         \brief Set the number of integration points
00064  
00065         The possible values for \c key  are:
00066         - 1: GSL_INTEG_GAUSS15 (default)
00067         - 2: GSL_INTEG_GAUSS21
00068         - 3: GSL_INTEG_GAUSS31
00069         - 4: GSL_INTEG_GAUSS41
00070         - 5: GSL_INTEG_GAUSS51
00071         - 6: GSL_INTEG_GAUSS61
00072  
00073         If an integer other than 1-6 is given, the default
00074         (GSL_INTEG_GAUSS15) is assumed, and the error handler is called.
00075     */
00076     int set_key(int key) {
00077       if (key>=1 && key<=6){
00078         lkey=key;
00079         return 0;
00080       }
00081       lkey=1;
00082       set_err_ret("Invalid key in gsl_inte_qag::set_key().",gsl_einval);
00083     }
00084      
00085     /** \brief Return the key used (1-6)
00086      */
00087     int get_key() { return lkey; }
00088   
00089     /** \brief Integrate function \c func from \c a to \c b.
00090      */
00091     virtual double integ(func_t &func, double a, double b, param_t &pa) {
00092       double res, err;
00093       integ_err(func,a,b,pa,res,err);
00094       this->interror=err;
00095       return res;
00096     }
00097     
00098     /** \brief Integrate function \c func from \c a to \c b and place
00099         the result in \c res and the error in \c err
00100     */
00101     virtual int integ_err(func_t &func, double a, double b, 
00102                           param_t &pa, double &res, double &err2) {
00103       
00104       int status;
00105       gsl_integration_rule * integration_rule = gsl_integration_qk15;
00106 
00107       if (lkey < GSL_INTEG_GAUSS15) {
00108         lkey = GSL_INTEG_GAUSS15;
00109       } else if (lkey > GSL_INTEG_GAUSS61) {
00110         lkey = GSL_INTEG_GAUSS61;
00111       }
00112 
00113       switch (lkey) {
00114       case GSL_INTEG_GAUSS15:
00115         {
00116           double fv1[8], fv2[8];
00117           status=qag(func,8,o2scl_inte_qag_coeffs::qk15_xgk,
00118                      o2scl_inte_qag_coeffs::qk15_wg,
00119                      o2scl_inte_qag_coeffs::qk15_wgk,
00120                      fv1,fv2,a,b,this->tolx,this->tolf,this->wkspace,
00121                      &res,&err2,pa);
00122         }
00123         break;
00124       case GSL_INTEG_GAUSS21:
00125         {
00126           double fv1[11], fv2[11];
00127           status=qag(func,11,o2scl_inte_qag_coeffs::qk21_xgk,
00128                      o2scl_inte_qag_coeffs::qk21_wg,
00129                      o2scl_inte_qag_coeffs::qk21_wgk,
00130                      fv1,fv2,a,b,this->tolx,this->tolf,this->wkspace,
00131                      &res,&err2,pa);
00132         }
00133         break;
00134       case GSL_INTEG_GAUSS31:
00135         {
00136           double fv1[16], fv2[16];
00137           status=qag(func,16,o2scl_inte_qag_coeffs::qk31_xgk,
00138                      o2scl_inte_qag_coeffs::qk31_wg,
00139                      o2scl_inte_qag_coeffs::qk31_wgk,
00140                      fv1,fv2,a,b,this->tolx,this->tolf,this->wkspace,
00141                      &res,&err2,pa);
00142         }
00143         break;
00144       case GSL_INTEG_GAUSS41:
00145         {
00146           double fv1[21], fv2[21];
00147           status=qag(func,21,o2scl_inte_qag_coeffs::qk41_xgk,
00148                      o2scl_inte_qag_coeffs::qk41_wg,
00149                      o2scl_inte_qag_coeffs::qk41_wgk,
00150                      fv1,fv2,a,b,this->tolx,this->tolf,this->wkspace,
00151                      &res,&err2,pa);
00152         }
00153         break;
00154       case GSL_INTEG_GAUSS51:
00155         {
00156           double fv1[26], fv2[26];
00157           status=qag(func,26,o2scl_inte_qag_coeffs::qk51_xgk,
00158                      o2scl_inte_qag_coeffs::qk51_wg,
00159                      o2scl_inte_qag_coeffs::qk51_wgk,
00160                      fv1,fv2,a,b,this->tolx,this->tolf,this->wkspace,
00161                      &res,&err2,pa);
00162         }
00163         break;
00164       case GSL_INTEG_GAUSS61:
00165         {
00166           double fv1[31], fv2[31];
00167           status=qag(func,31,o2scl_inte_qag_coeffs::qk61_xgk,
00168                      o2scl_inte_qag_coeffs::qk61_wg,
00169                      o2scl_inte_qag_coeffs::qk61_wgk,
00170                      fv1,fv2,a,b,this->tolx,this->tolf,this->wkspace,
00171                      &res,&err2,pa);
00172         }
00173         break;
00174       default:
00175         std::string estr="Incorrect key in gsl_inte_qag::integ_err().";
00176         set_err_ret(estr.c_str(),gsl_esanity);
00177       }
00178 
00179       return status;
00180     
00181     }
00182 
00183 #ifndef DOXYGEN_INTERNAL
00184 
00185   protected:
00186 
00187     /** 
00188         \brief Perform an adaptive integration given the coefficients,
00189         and returning \c result
00190     */
00191     int qag(func_t &func, const int qn, const double xgk[], 
00192             const double wg[], const double wgk[], double fv1[], 
00193             double fv2[], const double a, const double b, 
00194             const double l_epsabs, const double l_epsrel, const size_t limit, 
00195             double *result, double *abserr, param_t &pa)
00196     {
00197       double area, errsum;
00198       double result0, abserr0, resabs0, resasc0;
00199       double tolerance;
00200       size_t iteration = 0;
00201       int roundoff_type1 = 0, roundoff_type2 = 0, error_type = 0;
00202       
00203       double round_off;
00204       
00205       /* Initialize results */
00206       
00207       initialise (this->w, a, b);
00208       
00209       *result = 0;
00210       *abserr = 0;
00211       
00212       if (limit > this->w->limit) {
00213 
00214         this->last_iter=0;
00215         
00216         std::string estr="Iteration limit exceeds workspace ";
00217         estr+="in gsl_inte_qag::qag().";
00218         set_err_ret(estr.c_str(),gsl_einval);
00219       }
00220       
00221       if (l_epsabs <= 0 && 
00222           (l_epsrel < 50 * GSL_DBL_EPSILON || l_epsrel < 0.5e-28)) {
00223         
00224         this->last_iter=0;
00225         
00226         std::string estr="Tolerance cannot be achieved with given ";
00227         estr+="value of 'tolx' and 'tolf' in gsl_inte_qag::qag().";
00228         set_err_ret(estr.c_str(),gsl_ebadtol);
00229       }
00230         
00231       /* perform the first integration */
00232         
00233       gsl_integration_qk_o2scl(func,qn,xgk,wg,wgk,fv1,fv2,a,b,
00234                              &result0,&abserr0,&resabs0,&resasc0,pa);
00235       
00236       set_initial_result(this->w,result0,abserr0);
00237       
00238       /* Test on accuracy */
00239       
00240       tolerance = GSL_MAX_DBL(l_epsabs, l_epsrel * fabs (result0));
00241       
00242       /* need IEEE rounding here to match original quadpack behavior */
00243           
00244       round_off=gsl_coerce_double(50 * GSL_DBL_EPSILON * resabs0);
00245           
00246       if (abserr0 <= round_off && abserr0 > tolerance) {
00247 
00248         *result = result0;
00249         *abserr = abserr0;
00250 
00251         // We start with 1 here, because an integration
00252         // was already performed above
00253         this->last_iter=1;
00254 
00255         std::string estr="Cannot reach tolerance because of roundoff error ";
00256         estr+="on first attempt in gsl_inte_qag::qag().";
00257         set_err_ret(estr.c_str(),gsl_eround);
00258 
00259       } else if ((abserr0 <= tolerance && 
00260                   abserr0 != resasc0) || abserr0 == 0.0) {
00261         *result = result0;
00262         *abserr = abserr0;
00263           
00264         // We start with 1 here, because an integration
00265         // was already performed above
00266         this->last_iter=1;
00267 
00268         return gsl_success;
00269 
00270       } else if (limit == 1) {
00271 
00272         *result = result0;
00273         *abserr = abserr0;
00274         
00275         // We start with 1 here, because an integration
00276         // was already performed above
00277         this->last_iter=1;
00278 
00279         std::string estr="A maximum of 1 iteration was insufficient ";
00280         estr+="in gsl_inte_qag::qag().";
00281         set_err_ret(estr.c_str(),gsl_emaxiter);
00282       }
00283       
00284       area = result0;
00285       errsum = abserr0;
00286       
00287       iteration = 1;
00288       do {
00289         double a1, b1, a2, b2;
00290         double a_i, b_i, r_i, e_i;
00291         double area1 = 0, area2 = 0, area12 = 0;
00292         double error1 = 0, error2 = 0, error12 = 0;
00293         double resasc1, resasc2;
00294         double resabs1, resabs2;
00295           
00296         /* Bisect the subinterval with the largest error estimate */
00297           
00298         retrieve (this->w, &a_i, &b_i, &r_i, &e_i);
00299           
00300         a1 = a_i;
00301         b1 = 0.5 * (a_i + b_i);
00302         a2 = b1;
00303         b2 = b_i;
00304           
00305         gsl_integration_qk_o2scl(func,qn,xgk,wg,wgk,fv1,fv2,a1,b1,
00306                                &area1,&error1,&resabs1,&resasc1,pa);
00307         gsl_integration_qk_o2scl(func,qn,xgk,wg,wgk,fv1,fv2,a2,b2,
00308                                &area2,&error2,&resabs2,&resasc2,pa);
00309           
00310         area12 = area1 + area2;
00311         error12 = error1 + error2;
00312           
00313         errsum += (error12 - e_i);
00314         area += area12 - r_i;
00315           
00316         if (resasc1 != error1 && resasc2 != error2) {
00317           double delta = r_i - area12;
00318           
00319           if (fabs (delta) <= 1.0e-5 * fabs (area12) && 
00320               error12 >= 0.99 * e_i) {
00321             roundoff_type1++;
00322           }
00323           if (iteration >= 10 && error12 > e_i) {
00324             roundoff_type2++;
00325           }
00326         }
00327         
00328         tolerance = GSL_MAX_DBL (l_epsabs, l_epsrel * fabs (area));
00329           
00330         if (errsum > tolerance) {
00331           if (roundoff_type1 >= 6 || roundoff_type2 >= 20) {
00332             error_type = 2;   /* round off error */
00333           }
00334           /* set error flag in the case of bad integrand behaviour at
00335              a point of the integration range */
00336           
00337           if (this->subinterval_too_small (a1, a2, b2)) {
00338             error_type = 3;
00339           }
00340         }
00341         
00342         update (this->w, a1, b1, area1, error1, a2, b2, area2, error2);
00343           
00344         retrieve (this->w, &a_i, &b_i, &r_i, &e_i);
00345           
00346         if (this->verbose>0) {
00347           std::cout << "gsl_inte_qag Iter: " << iteration;
00348           std::cout.setf(std::ios::showpos);
00349           std::cout << " Res: " << area;
00350           std::cout.unsetf(std::ios::showpos);
00351           std::cout << " Err: " << errsum
00352                     << " Tol: " << tolerance << std::endl;
00353           if (this->verbose>1) {
00354             char ch;
00355             std::cout << "Press a key and type enter to continue. " ;
00356             std::cin >> ch;
00357           }
00358         }
00359           
00360         iteration++;
00361         
00362       } while (iteration < limit && !error_type && 
00363                errsum > tolerance);
00364           
00365       *result = sum_results (this->w);
00366       *abserr = errsum;
00367       
00368       this->last_iter=iteration;
00369       
00370       if (errsum <= tolerance) {
00371         return gsl_success;
00372       } else if (error_type == 2) {
00373         std::string estr="Roundoff error prevents tolerance ";
00374         estr+="from being achieved in gsl_inte_qag::qag().";
00375         set_err_ret(estr.c_str(),gsl_eround);
00376       } else if (error_type == 3) {
00377         std::string estr="Bad integrand behavior ";
00378         estr+=" in gsl_inte_qag::qag().";
00379         set_err_ret(estr.c_str(),gsl_esing);
00380       } else if (iteration == limit) {
00381         std::string estr="Maximum number of subdivisions reached";
00382         estr+=" in gsl_inte_qag::qag().";
00383         set_err_ret(estr.c_str(),gsl_emaxiter);
00384       } else {
00385         std::string estr="Could not integrate function in gsl_inte_qag::";
00386         estr+="qag() (it may have returned a non-finite result).";
00387         set_err_ret(estr.c_str(),gsl_efailed);
00388       }
00389       
00390       // No return statement needed since the above if statement
00391       // always forces a return
00392     }
00393     
00394 #endif
00395   
00396     /// Return string denoting type ("gsl_inte_qag")
00397     const char *type() { return "gsl_inte_qag"; }
00398   
00399   };
00400 
00401 #ifndef DOXYGENP
00402 }
00403 #endif
00404 
00405 #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