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