gsl_inte_qawf.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_QAWF_H
00024 #define O2SCL_GSL_INTE_QAWF_H
00025 
00026 #include <o2scl/inte.h>
00027 #include <o2scl/gsl_inte_qawo.h>
00028 #include <o2scl/gsl_inte_qagiu.h>
00029 
00030 #ifndef DOXYGENP
00031 namespace o2scl {
00032 #endif
00033   
00034   /** \brief Adaptive integration for oscillatory integrals (GSL)
00035    */
00036   template<class param_t, class func_t> class gsl_inte_qawf_sin : 
00037   public gsl_inte_qawo_sin<param_t,func_t> {
00038     
00039   public:
00040     
00041     gsl_inte_qawf_sin() {
00042     }
00043     
00044     virtual ~gsl_inte_qawf_sin() {}
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     /** \brief Integrate function \c func from \c a to \c b and place
00056         the result in \c res and the error in \c err
00057     */
00058     virtual int integ_err(func_t &func, double a, double b, 
00059                           param_t &pa, double &res, double &err2) {
00060       
00061       this->otable=gsl_integration_qawo_table_alloc
00062         (this->omega,1.0,GSL_INTEG_SINE,this->tab_size);
00063       cyclew=gsl_integration_workspace_alloc(this->wkspace);
00064       
00065       int status=qawf(func,a,this->tolx,this->wkspace,&res,&err2,pa);
00066       
00067       gsl_integration_qawo_table_free(this->otable);
00068       gsl_integration_workspace_free(cyclew);
00069       
00070       return status;
00071       
00072     }
00073 
00074 #ifndef DOXYGEN_INTERNAL
00075 
00076   protected:
00077     
00078     /// Desc
00079     gsl_integration_workspace *cyclew;
00080     
00081     /** 
00082         \brief Desc
00083     */
00084     int qawf(func_t &func, const double a, 
00085              const double epsabs, const size_t limit, 
00086              double *result, double *abserr, param_t &pa) {
00087 
00088       double area, errsum;
00089       double res_ext, err_ext;
00090       double correc, total_error = 0.0, truncation_error;
00091 
00092       size_t ktmin = 0;
00093       size_t iteration = 0;
00094 
00095       struct extrapolation_table table;
00096 
00097       double cycle;
00098       //double omega = this->otable->omega;
00099 
00100       const double p = 0.9;
00101       double factor = 1;
00102       double initial_eps, eps;
00103       int error_type = 0;
00104 
00105       /* Initialize results */
00106 
00107       initialise (this->w, a, a);
00108 
00109       *result = 0;
00110       *abserr = 0;
00111 
00112       if (limit > this->w->limit)
00113         {
00114           GSL_ERROR ("iteration limit exceeds available workspace", 
00115                      GSL_EINVAL) ;
00116         }
00117 
00118       /* Test on accuracy */
00119 
00120       if (epsabs <= 0)
00121         {
00122           GSL_ERROR ("absolute tolerance epsabs must be positive", 
00123                      GSL_EBADTOL) ;
00124         }
00125 
00126       if (this->omega == 0.0)
00127         {
00128           if (this->otable->sine == GSL_INTEG_SINE)
00129             {
00130               /* The function sin(w x) f(x) is always zero for w = 0 */
00131 
00132               *result = 0;
00133               *abserr = 0;
00134 
00135               return GSL_SUCCESS;
00136             }
00137           else
00138             {
00139               /* The function cos(w x) f(x) is always f(x) for w = 0 */
00140 
00141               gsl_inte_qagiu<param_t,func_t> iu;
00142               
00143               int status=iu.integ_err(func,a,0.0,pa,*result,*abserr);
00144 
00145               return status;
00146             }
00147         }
00148 
00149       if (epsabs > GSL_DBL_MIN / (1 - p))
00150         {
00151           eps = epsabs * (1 - p);
00152         }
00153       else
00154         {
00155           eps = epsabs;
00156         }
00157 
00158       initial_eps = eps;
00159 
00160       area = 0;
00161       errsum = 0;
00162 
00163       res_ext = 0;
00164       err_ext = GSL_DBL_MAX;
00165       correc = 0;
00166       
00167       cycle = (2 * floor (fabs (this->omega)) + 1) * M_PI / fabs (this->omega);
00168 
00169       gsl_integration_qawo_table_set_length (this->otable, cycle);
00170 
00171       initialise_table (&table);
00172 
00173       for (iteration = 0; iteration < limit; iteration++)
00174         {
00175           double area1, error1, reseps, erreps;
00176 
00177           double a1 = a + iteration * cycle;
00178           double b1 = a1 + cycle;
00179 
00180           double epsabs1 = eps * factor;
00181 
00182           int status=qawo(func,a1,epsabs1,0.0,limit,cyclew,this->otable,
00183                           &area1,&error1,pa);
00184           
00185           this->append_interval (this->w, a1, b1, area1, error1);
00186           
00187           factor *= p;
00188 
00189           area = area + area1;
00190           errsum = errsum + error1;
00191 
00192           /* estimate the truncation error as 50 times the final term */
00193 
00194           truncation_error = 50 * fabs (area1);
00195 
00196           total_error = errsum + truncation_error;
00197 
00198           if (total_error < epsabs && iteration > 4)
00199             {
00200               goto compute_result;
00201             }
00202 
00203           if (error1 > correc)
00204             {
00205               correc = error1;
00206             }
00207 
00208           if (status)
00209             {
00210               eps = GSL_MAX_DBL (initial_eps, correc * (1.0 - p));
00211             }
00212 
00213           if (status && total_error < 10 * correc && iteration > 3)
00214             {
00215               goto compute_result;
00216             }
00217 
00218           append_table (&table, area);
00219 
00220           if (table.n < 2)
00221             {
00222               continue;
00223             }
00224 
00225           qelg (&table, &reseps, &erreps);
00226 
00227           ktmin++;
00228 
00229           if (ktmin >= 15 && err_ext < 0.001 * total_error)
00230             {
00231               error_type = 4;
00232             }
00233 
00234           if (erreps < err_ext)
00235             {
00236               ktmin = 0;
00237               err_ext = erreps;
00238               res_ext = reseps;
00239 
00240               if (err_ext + 10 * correc <= epsabs)
00241                 break;
00242               if (err_ext <= epsabs && 10 * correc >= epsabs)
00243                 break;
00244             }
00245 
00246         }
00247 
00248       if (iteration == limit)
00249         error_type = 1;
00250 
00251       if (err_ext == GSL_DBL_MAX)
00252         goto compute_result;
00253 
00254       err_ext = err_ext + 10 * correc;
00255 
00256       *result = res_ext;
00257       *abserr = err_ext;
00258 
00259       if (error_type == 0)
00260         {
00261           return GSL_SUCCESS ;
00262         }
00263 
00264       if (res_ext != 0.0 && area != 0.0)
00265         {
00266           if (err_ext / fabs (res_ext) > errsum / fabs (area))
00267             goto compute_result;
00268         }
00269       else if (err_ext > errsum)
00270         {
00271           goto compute_result;
00272         }
00273       else if (area == 0.0)
00274         {
00275           goto return_error;
00276         }
00277 
00278       if (error_type == 4)
00279         {
00280           err_ext = err_ext + truncation_error;
00281         }
00282 
00283       goto return_error;
00284 
00285     compute_result:
00286 
00287       *result = area;
00288       *abserr = total_error;
00289 
00290     return_error:
00291 
00292       if (error_type > 2)
00293         error_type--;
00294 
00295       if (error_type == 0)
00296         {
00297           return GSL_SUCCESS;
00298         }
00299       else if (error_type == 1)
00300         {
00301           GSL_ERROR ("number of iterations was insufficient", GSL_EMAXITER);
00302         }
00303       else if (error_type == 2)
00304         {
00305           GSL_ERROR ("cannot reach tolerance because of roundoff error",
00306                      GSL_EROUND);
00307         }
00308       else if (error_type == 3)
00309         {
00310           GSL_ERROR 
00311             ("bad integrand behavior found in the integration interval",
00312              GSL_ESING);
00313         }
00314       else if (error_type == 4)
00315         {
00316           GSL_ERROR ("roundoff error detected in the extrapolation table",
00317                      GSL_EROUND);
00318         }
00319       else if (error_type == 5)
00320         {
00321           GSL_ERROR ("integral is divergent, or slowly convergent",
00322                      GSL_EDIVERGE);
00323         }
00324       else
00325         {
00326           GSL_ERROR ("could not integrate function", GSL_EFAILED);
00327         }
00328 
00329     }
00330 
00331     /// Desc
00332     virtual double transform(func_t &func, double x, param_t &pa) {
00333       double wx = this->omega * x;
00334       double sinwx = sin(wx) ;
00335       double y;
00336       func(x,y,pa);
00337       return y*sinwx;
00338     }
00339 
00340 #endif
00341   
00342     /// Return string denoting type ("gsl_inte_qawf_sin")
00343     const char *type() { return "gsl_inte_qawf_sin"; }
00344   
00345   };
00346 
00347   /** \brief Adaptive integration a function with finite limits of 
00348       integration (GSL)
00349 
00350       \todo Verbose output has been setup for this class, but this
00351       needs to be done for the other GSL-like integrators
00352   */
00353   template<class param_t, class func_t> class gsl_inte_qawf_cos : 
00354   public gsl_inte_qawf_sin<param_t,func_t> {
00355     
00356   public:
00357 
00358     gsl_inte_qawf_cos() {
00359     }
00360 
00361     virtual ~gsl_inte_qawf_cos() {}
00362       
00363     /** \brief Integrate function \c func from \c a to \c b and place
00364         the result in \c res and the error in \c err
00365     */
00366     virtual int integ_err(func_t &func, double a, double b, 
00367                           param_t &pa, double &res, double &err2) {
00368 
00369       this->otable=gsl_integration_qawo_table_alloc
00370         (this->omega,b-a,GSL_INTEG_COSINE,this->tab_size);
00371       this->cyclew=gsl_integration_workspace_alloc(this->wkspace);
00372       
00373       int status=qawf(func,a,this->tolx,this->wkspace,&res,&err2,pa);
00374       
00375       gsl_integration_qawo_table_free(this->otable);
00376       gsl_integration_workspace_free(this->cyclew);
00377       
00378       return status;
00379       
00380     }
00381 
00382 #ifndef DOXYGEN_INTERNAL
00383 
00384   protected:
00385     
00386     /// Desc
00387     virtual double transform(func_t &func, double x, param_t &pa) {
00388       double wx = this->omega * x;
00389       double coswx = cos(wx) ;
00390       double y;
00391       func(x,y,pa);
00392       return y*coswx;
00393     }
00394 
00395 #endif
00396   
00397     /// Return string denoting type ("gsl_inte_qawf_cos")
00398     const char *type() { return "gsl_inte_qawf_cos"; }
00399   
00400   };
00401 
00402 #ifndef DOXYGENP
00403 }
00404 #endif
00405 
00406 #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