00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
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
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
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
00056
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
00079 gsl_integration_workspace *cyclew;
00080
00081
00082
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
00099
00100 const double p = 0.9;
00101 double factor = 1;
00102 double initial_eps, eps;
00103 int error_type = 0;
00104
00105
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
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
00131
00132 *result = 0;
00133 *abserr = 0;
00134
00135 return GSL_SUCCESS;
00136 }
00137 else
00138 {
00139
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
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
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
00343 const char *type() { return "gsl_inte_qawf_sin"; }
00344
00345 };
00346
00347
00348
00349
00350
00351
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
00364
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
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
00398 const char *type() { return "gsl_inte_qawf_cos"; }
00399
00400 };
00401
00402 #ifndef DOXYGENP
00403 }
00404 #endif
00405
00406 #endif