gsl_inte_qaws.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_QAWS_H
00024 #define O2SCL_GSL_INTE_QAWS_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   /** 
00034       \brief Adaptive Cauchy principal value integration (GSL)
00035   */
00036   template<class param_t, class func_t> class gsl_inte_qaws : 
00037   public gsl_inte_cheb<param_t,func_t> {
00038     
00039   public:
00040 
00041     gsl_inte_qaws() {
00042     }
00043 
00044     virtual ~gsl_inte_qaws() {}
00045       
00046     /** \brief Integrate function \c func from \c a to \c b.
00047      */
00048     virtual double integ(func_t &func, double a, double b, param_t &pa) {
00049       double res, err;
00050       integ_err(func,a,b,pa,res,err);
00051       this->interror=err;
00052       return res;
00053     }
00054     
00055     /// The singularity
00056     double s;
00057 
00058     /** \brief Integrate function \c func from \c a to \c b and place
00059         the result in \c res and the error in \c err
00060     */
00061     virtual int integ_err(func_t &func, double a, double b, 
00062                           param_t &pa, double &res, double &err2) {
00063 
00064       int status=qaws(func,a,b,s,this->tolx,this->tolf,this->wkspace,
00065                       &res,&err2,pa);
00066       
00067       return status;
00068       
00069     }
00070 
00071 #ifndef DOXYGEN_INTERNAL
00072 
00073   protected:
00074 
00075     /** 
00076         \brief Desc
00077     */
00078     int qaws(func_t &func, const double a, const double b, const double c,
00079              const double epsabs, const double epsrel, const size_t limit,
00080              double *result, double *abserr, param_t &pa) {
00081       //int
00082       //gsl_integration_qaws (gsl_function * f,
00083       //const double a, const double b,
00084       //gsl_integration_qaws_table * t,
00085       //const double epsabs, const double epsrel,
00086       //const size_t limit,
00087       //gsl_integration_workspace * workspace,
00088       //double *result, double *abserr)
00089       double area, errsum;
00090       double result0, abserr0;
00091       double tolerance;
00092       size_t iteration = 0;
00093       int roundoff_type1 = 0, roundoff_type2 = 0, error_type = 0;
00094 
00095       /* Initialize results */
00096 
00097       initialise (workspace, a, b);
00098 
00099       *result = 0;
00100       *abserr = 0;
00101 
00102       if (limit > workspace->limit)
00103         {
00104           GSL_ERROR ("iteration limit exceeds available workspace", GSL_EINVAL) ;
00105         }
00106 
00107       if (b <= a) 
00108         {
00109           GSL_ERROR ("limits must form an ascending sequence, a < b", GSL_EINVAL) ;
00110         }
00111 
00112       if (epsabs <= 0 && (epsrel < 50 * GSL_DBL_EPSILON || epsrel < 0.5e-28))
00113         {
00114           GSL_ERROR ("tolerance cannot be acheived with given epsabs and epsrel",
00115                      GSL_EBADTOL);
00116         }
00117 
00118       /* perform the first integration */
00119 
00120       {
00121         double area1, area2;
00122         double error1, error2;
00123         int err_reliable1, err_reliable2;
00124         double a1 = a;
00125         double b1 = 0.5 * (a + b);
00126         double a2 = b1;
00127         double b2 = b;
00128 
00129         qc25s (f, a, b, a1, b1, t, &area1, &error1, &err_reliable1);
00130         qc25s (f, a, b, a2, b2, t, &area2, &error2, &err_reliable2);
00131     
00132         if (error1 > error2)
00133           {
00134             append_interval (workspace, a1, b1, area1, error1);
00135             append_interval (workspace, a2, b2, area2, error2);
00136           }
00137         else
00138           {
00139             append_interval (workspace, a2, b2, area2, error2);
00140             append_interval (workspace, a1, b1, area1, error1);
00141           }
00142     
00143         result0 = area1 + area2;
00144         abserr0 = error1 + error2;
00145       }
00146 
00147       /* Test on accuracy */
00148 
00149       tolerance = GSL_MAX_DBL (epsabs, epsrel * fabs (result0));
00150 
00151       /* Test on accuracy, use 0.01 relative error as an extra safety
00152          margin on the first iteration (ignored for subsequent iterations) */
00153 
00154       if (abserr0 < tolerance && abserr0 < 0.01 * fabs(result0))
00155         {
00156           *result = result0;
00157           *abserr = abserr0;
00158 
00159           return GSL_SUCCESS;
00160         }
00161       else if (limit == 1)
00162         {
00163           *result = result0;
00164           *abserr = abserr0;
00165 
00166           GSL_ERROR ("a maximum of one iteration was insufficient", GSL_EMAXITER);
00167         }
00168 
00169       area = result0;
00170       errsum = abserr0;
00171 
00172       iteration = 2;
00173 
00174       do
00175         {
00176           double a1, b1, a2, b2;
00177           double a_i, b_i, r_i, e_i;
00178           double area1 = 0, area2 = 0, area12 = 0;
00179           double error1 = 0, error2 = 0, error12 = 0;
00180           int err_reliable1, err_reliable2;
00181 
00182           /* Bisect the subinterval with the largest error estimate */
00183 
00184           retrieve (workspace, &a_i, &b_i, &r_i, &e_i);
00185 
00186           a1 = a_i; 
00187           b1 = 0.5 * (a_i + b_i);
00188           a2 = b1;
00189           b2 = b_i;
00190 
00191           qc25s (f, a, b, a1, b1, t, &area1, &error1, &err_reliable1);
00192           qc25s (f, a, b, a2, b2, t, &area2, &error2, &err_reliable2);
00193 
00194           area12 = area1 + area2;
00195           error12 = error1 + error2;
00196 
00197           errsum += (error12 - e_i);
00198           area += area12 - r_i;
00199 
00200           if (err_reliable1 && err_reliable2)
00201             {
00202               double delta = r_i - area12;
00203 
00204               if (fabs (delta) <= 1.0e-5 * fabs (area12) && error12 >= 0.99 * e_i)
00205                 {
00206                   roundoff_type1++;
00207                 }
00208               if (iteration >= 10 && error12 > e_i)
00209                 {
00210                   roundoff_type2++;
00211                 }
00212             }
00213 
00214           tolerance = GSL_MAX_DBL (epsabs, epsrel * fabs (area));
00215 
00216           if (errsum > tolerance)
00217             {
00218               if (roundoff_type1 >= 6 || roundoff_type2 >= 20)
00219                 {
00220                   error_type = 2;   /* round off error */
00221                 }
00222 
00223               /* set error flag in the case of bad integrand behaviour at
00224                  a point of the integration range */
00225 
00226               if (subinterval_too_small (a1, a2, b2))
00227                 {
00228                   error_type = 3;
00229                 }
00230             }
00231 
00232           update (workspace, a1, b1, area1, error1, a2, b2, area2, error2);
00233 
00234           retrieve (workspace, &a_i, &b_i, &r_i, &e_i);
00235 
00236           iteration++;
00237 
00238         }
00239       while (iteration < limit && !error_type && errsum > tolerance);
00240 
00241       *result = sum_results (workspace);
00242       *abserr = errsum;
00243 
00244       if (errsum <= tolerance)
00245         {
00246           return GSL_SUCCESS;
00247         }
00248       else if (error_type == 2)
00249         {
00250           GSL_ERROR ("roundoff error prevents tolerance from being achieved",
00251                      GSL_EROUND);
00252         }
00253       else if (error_type == 3)
00254         {
00255           GSL_ERROR ("bad integrand behavior found in the integration interval",
00256                      GSL_ESING);
00257         }
00258       else if (iteration == limit)
00259         {
00260           GSL_ERROR ("maximum number of subdivisions reached", GSL_EMAXITER);
00261         }
00262       else
00263         {
00264           GSL_ERROR ("could not integrate function", GSL_EFAILED);
00265         }
00266 
00267     }
00268 
00269     struct fn_qaws_params
00270     {
00271       gsl_function *function;
00272       double a;
00273       double b;
00274       gsl_integration_qaws_table *table;
00275     };
00276 
00277     static double fn_qaws (double t, void *params);
00278     static double fn_qaws_L (double x, void *params);
00279     static double fn_qaws_R (double x, void *params);
00280 
00281     static void
00282       compute_result (const double * r, const double * cheb12, const double * cheb24,
00283                       double * result12, double * result24);
00284 
00285 
00286     static void
00287       qc25s (gsl_function * f, double a, double b, double a1, double b1,
00288              gsl_integration_qaws_table * t,
00289              double *result, double *abserr, int *err_reliable);
00290 
00291     static void
00292       qc25s (gsl_function * f, double a, double b, double a1, double b1,
00293              gsl_integration_qaws_table * t,
00294              double *result, double *abserr, int *err_reliable)
00295       {
00296         gsl_function weighted_function;
00297         struct fn_qaws_params fn_params;
00298   
00299         fn_params.function = f;
00300         fn_params.a = a;
00301         fn_params.b = b;
00302         fn_params.table = t;
00303 
00304         weighted_function.params = &fn_params;
00305     
00306         if (a1 == a && (t->alpha != 0.0 || t->mu != 0))
00307           {
00308             double cheb12[13], cheb24[25];
00309 
00310             double factor = pow(0.5 * (b1 - a1), t->alpha + 1.0);
00311 
00312             weighted_function.function = &fn_qaws_R;
00313 
00314             gsl_integration_qcheb (&weighted_function, a1, b1, cheb12, cheb24);
00315 
00316             if (t->mu == 0)
00317               {
00318                 double res12 = 0, res24 = 0;
00319                 double u = factor;
00320 
00321                 compute_result (t->ri, cheb12, cheb24, &res12, &res24);
00322 
00323                 *result = u * res24;
00324                 *abserr = fabs(u * (res24 - res12));
00325               }
00326             else 
00327               {
00328                 double res12a = 0, res24a = 0;
00329                 double res12b = 0, res24b = 0;
00330 
00331                 double u = factor * log(b1 - a1);
00332                 double v = factor;
00333 
00334                 compute_result (t->ri, cheb12, cheb24, &res12a, &res24a);
00335                 compute_result (t->rg, cheb12, cheb24, &res12b, &res24b);
00336 
00337                 *result = u * res24a + v * res24b;
00338                 *abserr = fabs(u * (res24a - res12a)) + fabs(v * (res24b - res12b));
00339               }
00340 
00341             *err_reliable = 0;
00342 
00343             return;
00344           }
00345         else if (b1 == b && (t->beta != 0.0 || t->nu != 0))
00346           {
00347             double cheb12[13], cheb24[25];
00348             double factor = pow(0.5 * (b1 - a1), t->beta + 1.0);
00349 
00350             weighted_function.function = &fn_qaws_L;
00351 
00352             gsl_integration_qcheb (&weighted_function, a1, b1, cheb12, cheb24);
00353 
00354             if (t->nu == 0)
00355               {
00356                 double res12 = 0, res24 = 0;
00357                 double u = factor;
00358 
00359                 compute_result (t->rj, cheb12, cheb24, &res12, &res24);
00360 
00361                 *result = u * res24;
00362                 *abserr = fabs(u * (res24 - res12));
00363               }
00364             else 
00365               {
00366                 double res12a = 0, res24a = 0;
00367                 double res12b = 0, res24b = 0;
00368 
00369                 double u = factor * log(b1 - a1);
00370                 double v = factor;
00371 
00372                 compute_result (t->rj, cheb12, cheb24, &res12a, &res24a);
00373                 compute_result (t->rh, cheb12, cheb24, &res12b, &res24b);
00374 
00375                 *result = u * res24a + v * res24b;
00376                 *abserr = fabs(u * (res24a - res12a)) + fabs(v * (res24b - res12b));
00377               }
00378 
00379             *err_reliable = 0;
00380 
00381             return;
00382           }
00383         else
00384           {
00385             double resabs, resasc;
00386 
00387             weighted_function.function = &fn_qaws;
00388   
00389             gsl_integration_qk15 (&weighted_function, a1, b1, result, abserr,
00390                                   &resabs, &resasc);
00391 
00392             if (*abserr == resasc)
00393               {
00394                 *err_reliable = 0;
00395               }
00396             else 
00397               {
00398                 *err_reliable = 1;
00399               }
00400 
00401             return;
00402           }
00403 
00404       }
00405 
00406     static double
00407       fn_qaws (double x, void *params)
00408       {
00409         struct fn_qaws_params *p = (struct fn_qaws_params *) params;
00410         gsl_function *f = p->function;
00411         gsl_integration_qaws_table *t = p->table;
00412 
00413         double factor = 1.0;
00414   
00415         if (t->alpha != 0.0)
00416           factor *= pow(x - p->a, t->alpha);
00417 
00418         if (t->beta != 0.0)
00419           factor *= pow(p->b - x, t->beta);
00420 
00421         if (t->mu == 1)
00422           factor *= log(x - p->a);
00423 
00424         if (t->nu == 1)
00425           factor *= log(p->b - x);
00426 
00427         return factor * GSL_FN_EVAL (f, x);
00428       }
00429 
00430     static double
00431       fn_qaws_L (double x, void *params)
00432       {
00433         struct fn_qaws_params *p = (struct fn_qaws_params *) params;
00434         gsl_function *f = p->function;
00435         gsl_integration_qaws_table *t = p->table;
00436 
00437         double factor = 1.0;
00438   
00439         if (t->alpha != 0.0)
00440           factor *= pow(x - p->a, t->alpha);
00441 
00442         if (t->mu == 1)
00443           factor *= log(x - p->a);
00444 
00445         return factor * GSL_FN_EVAL (f, x);
00446       }
00447 
00448     static double
00449       fn_qaws_R (double x, void *params)
00450       {
00451         struct fn_qaws_params *p = (struct fn_qaws_params *) params;
00452         gsl_function *f = p->function;
00453         gsl_integration_qaws_table *t = p->table;
00454 
00455         double factor = 1.0;
00456   
00457         if (t->beta != 0.0)
00458           factor *= pow(p->b - x, t->beta);
00459 
00460         if (t->nu == 1)
00461           factor *= log(p->b - x);
00462 
00463         return factor * GSL_FN_EVAL (f, x);
00464       }
00465 
00466 
00467     static void
00468       compute_result (const double * r, const double * cheb12, const double * cheb24,
00469                       double * result12, double * result24)
00470       {
00471         size_t i;
00472         double res12 = 0;
00473         double res24 = 0;
00474   
00475         for (i = 0; i < 13; i++)
00476           {
00477             res12 += r[i] * cheb12[i];
00478           }
00479   
00480         for (i = 0; i < 25; i++)
00481           {
00482             res24 += r[i] * cheb24[i];
00483           }
00484   
00485         *result12 = res12;
00486         *result24 = res24;
00487       }
00488 
00489 
00490     /// Desc
00491     virtual double transform(func_t &func, double x, param_t &pa)
00492     {
00493       double y;
00494       func(x,y,pa);
00495       return y/(x-s);
00496     }
00497 
00498 #endif
00499   
00500     /// Return string denoting type ("gsl_inte_qaws")
00501     const char *type() { return "gsl_inte_qaws"; }
00502   
00503   };
00504 
00505 #ifndef DOXYGENP
00506 }
00507 #endif
00508 
00509 #endif

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