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_B_H 00024 #define O2SCL_GSL_INTE_QAG_B_H 00025 00026 #include <cmath> 00027 #include <gsl/gsl_integration.h> 00028 #include <o2scl/inte.h> 00029 #include <o2scl/gsl_inte.h> 00030 00031 /** 00032 \brief A namespace for the GSL adaptive integration coefficients 00033 00034 <b>Documentation from GSL</b>: \n 00035 Gauss quadrature weights and kronrod quadrature abscissae and 00036 weights as evaluated with 80 decimal digit arithmetic by 00037 L. W. Fullerton, Bell Labs, Nov. 1981. 00038 */ 00039 namespace o2scl_inte_qag_coeffs { 00040 00041 /** abscissae of the 15-point kronrod rule */ 00042 static const double qk15_xgk[8] = 00043 { 00044 0.991455371120812639206854697526329, 00045 0.949107912342758524526189684047851, 00046 0.864864423359769072789712788640926, 00047 0.741531185599394439863864773280788, 00048 0.586087235467691130294144838258730, 00049 0.405845151377397166906606412076961, 00050 0.207784955007898467600689403773245, 00051 0.000000000000000000000000000000000 00052 }; 00053 00054 /* xgk[1], xgk[3], ... abscissae of the 7-point gauss rule. 00055 xgk[0], xgk[2], ... abscissae to optimally extend the 7-point 00056 gauss rule */ 00057 00058 /** weights of the 7-point gauss rule */ 00059 static const double qk15_wg[4] = 00060 { 00061 0.129484966168869693270611432679082, 00062 0.279705391489276667901467771423780, 00063 0.381830050505118944950369775488975, 00064 0.417959183673469387755102040816327 00065 }; 00066 00067 /** weights of the 15-point kronrod rule */ 00068 static const double qk15_wgk[8] = 00069 { 00070 0.022935322010529224963732008058970, 00071 0.063092092629978553290700663189204, 00072 0.104790010322250183839876322541518, 00073 0.140653259715525918745189590510238, 00074 0.169004726639267902826583426598550, 00075 0.190350578064785409913256402421014, 00076 0.204432940075298892414161999234649, 00077 0.209482141084727828012999174891714 00078 }; 00079 00080 /** abscissae of the 21-point kronrod rule */ 00081 static const double qk21_xgk[11] = 00082 { 00083 0.995657163025808080735527280689003, 00084 0.973906528517171720077964012084452, 00085 0.930157491355708226001207180059508, 00086 0.865063366688984510732096688423493, 00087 0.780817726586416897063717578345042, 00088 0.679409568299024406234327365114874, 00089 0.562757134668604683339000099272694, 00090 0.433395394129247190799265943165784, 00091 0.294392862701460198131126603103866, 00092 0.148874338981631210884826001129720, 00093 0.000000000000000000000000000000000 00094 }; 00095 00096 /* xgk[1], xgk[3], ...abscissae of the 10-point gauss rule. 00097 xgk[0], xgk[2], ...abscissae to optimally extend the 10-point 00098 gauss rule */ 00099 00100 /** weights of the 10-point gauss rule */ 00101 static const double qk21_wg[5] = 00102 { 00103 0.066671344308688137593568809893332, 00104 0.149451349150580593145776339657697, 00105 0.219086362515982043995534934228163, 00106 0.269266719309996355091226921569469, 00107 0.295524224714752870173892994651338 00108 }; 00109 00110 /** weights of the 21-point kronrod rule */ 00111 static const double qk21_wgk[11] = 00112 { 00113 0.011694638867371874278064396062192, 00114 0.032558162307964727478818972459390, 00115 0.054755896574351996031381300244580, 00116 0.075039674810919952767043140916190, 00117 0.093125454583697605535065465083366, 00118 0.109387158802297641899210590325805, 00119 0.123491976262065851077958109831074, 00120 0.134709217311473325928054001771707, 00121 0.142775938577060080797094273138717, 00122 0.147739104901338491374841515972068, 00123 0.149445554002916905664936468389821 00124 }; 00125 00126 /** abscissae of the 31-point kronrod rule */ 00127 static const double qk31_xgk[16] = 00128 { 00129 0.998002298693397060285172840152271, 00130 0.987992518020485428489565718586613, 00131 0.967739075679139134257347978784337, 00132 0.937273392400705904307758947710209, 00133 0.897264532344081900882509656454496, 00134 0.848206583410427216200648320774217, 00135 0.790418501442465932967649294817947, 00136 0.724417731360170047416186054613938, 00137 0.650996741297416970533735895313275, 00138 0.570972172608538847537226737253911, 00139 0.485081863640239680693655740232351, 00140 0.394151347077563369897207370981045, 00141 0.299180007153168812166780024266389, 00142 0.201194093997434522300628303394596, 00143 0.101142066918717499027074231447392, 00144 0.000000000000000000000000000000000 00145 }; 00146 00147 /* xgk[1], xgk[3], ...abscissae of the 15-point gauss rule. 00148 xgk[0], xgk[2], ...abscissae to optimally extend the 15-point 00149 gauss rule */ 00150 00151 /** weights of the 15-point gauss rule */ 00152 static const double qk31_wg[8] = 00153 { 00154 0.030753241996117268354628393577204, 00155 0.070366047488108124709267416450667, 00156 0.107159220467171935011869546685869, 00157 0.139570677926154314447804794511028, 00158 0.166269205816993933553200860481209, 00159 0.186161000015562211026800561866423, 00160 0.198431485327111576456118326443839, 00161 0.202578241925561272880620199967519 00162 }; 00163 00164 /** weights of the 31-point kronrod rule */ 00165 static const double qk31_wgk[16] = 00166 { 00167 0.005377479872923348987792051430128, 00168 0.015007947329316122538374763075807, 00169 0.025460847326715320186874001019653, 00170 0.035346360791375846222037948478360, 00171 0.044589751324764876608227299373280, 00172 0.053481524690928087265343147239430, 00173 0.062009567800670640285139230960803, 00174 0.069854121318728258709520077099147, 00175 0.076849680757720378894432777482659, 00176 0.083080502823133021038289247286104, 00177 0.088564443056211770647275443693774, 00178 0.093126598170825321225486872747346, 00179 0.096642726983623678505179907627589, 00180 0.099173598721791959332393173484603, 00181 0.100769845523875595044946662617570, 00182 0.101330007014791549017374792767493 00183 }; 00184 00185 /** abscissae of the 41-point kronrod rule */ 00186 static const double qk41_xgk[21] = 00187 { 00188 0.998859031588277663838315576545863, 00189 0.993128599185094924786122388471320, 00190 0.981507877450250259193342994720217, 00191 0.963971927277913791267666131197277, 00192 0.940822633831754753519982722212443, 00193 0.912234428251325905867752441203298, 00194 0.878276811252281976077442995113078, 00195 0.839116971822218823394529061701521, 00196 0.795041428837551198350638833272788, 00197 0.746331906460150792614305070355642, 00198 0.693237656334751384805490711845932, 00199 0.636053680726515025452836696226286, 00200 0.575140446819710315342946036586425, 00201 0.510867001950827098004364050955251, 00202 0.443593175238725103199992213492640, 00203 0.373706088715419560672548177024927, 00204 0.301627868114913004320555356858592, 00205 0.227785851141645078080496195368575, 00206 0.152605465240922675505220241022678, 00207 0.076526521133497333754640409398838, 00208 0.000000000000000000000000000000000 00209 }; 00210 00211 /* xgk[1], xgk[3], ...abscissae of the 20-point gauss rule. 00212 xgk[0], xgk[2], ...abscissae to optimally extend the 20-point 00213 gauss rule */ 00214 00215 /** weights of the 20-point gauss rule */ 00216 static const double qk41_wg[11] = 00217 { 00218 0.017614007139152118311861962351853, 00219 0.040601429800386941331039952274932, 00220 0.062672048334109063569506535187042, 00221 0.083276741576704748724758143222046, 00222 0.101930119817240435036750135480350, 00223 0.118194531961518417312377377711382, 00224 0.131688638449176626898494499748163, 00225 0.142096109318382051329298325067165, 00226 0.149172986472603746787828737001969, 00227 0.152753387130725850698084331955098 00228 }; 00229 00230 /** weights of the 41-point kronrod rule */ 00231 static const double qk41_wgk[21] = 00232 { 00233 0.003073583718520531501218293246031, 00234 0.008600269855642942198661787950102, 00235 0.014626169256971252983787960308868, 00236 0.020388373461266523598010231432755, 00237 0.025882133604951158834505067096153, 00238 0.031287306777032798958543119323801, 00239 0.036600169758200798030557240707211, 00240 0.041668873327973686263788305936895, 00241 0.046434821867497674720231880926108, 00242 0.050944573923728691932707670050345, 00243 0.055195105348285994744832372419777, 00244 0.059111400880639572374967220648594, 00245 0.062653237554781168025870122174255, 00246 0.065834597133618422111563556969398, 00247 0.068648672928521619345623411885368, 00248 0.071054423553444068305790361723210, 00249 0.073030690332786667495189417658913, 00250 0.074582875400499188986581418362488, 00251 0.075704497684556674659542775376617, 00252 0.076377867672080736705502835038061, 00253 0.076600711917999656445049901530102 00254 }; 00255 00256 /** abscissae of the 51-point kronrod rule */ 00257 static const double qk51_xgk[26] = 00258 { 00259 0.999262104992609834193457486540341, 00260 0.995556969790498097908784946893902, 00261 0.988035794534077247637331014577406, 00262 0.976663921459517511498315386479594, 00263 0.961614986425842512418130033660167, 00264 0.942974571228974339414011169658471, 00265 0.920747115281701561746346084546331, 00266 0.894991997878275368851042006782805, 00267 0.865847065293275595448996969588340, 00268 0.833442628760834001421021108693570, 00269 0.797873797998500059410410904994307, 00270 0.759259263037357630577282865204361, 00271 0.717766406813084388186654079773298, 00272 0.673566368473468364485120633247622, 00273 0.626810099010317412788122681624518, 00274 0.577662930241222967723689841612654, 00275 0.526325284334719182599623778158010, 00276 0.473002731445714960522182115009192, 00277 0.417885382193037748851814394594572, 00278 0.361172305809387837735821730127641, 00279 0.303089538931107830167478909980339, 00280 0.243866883720988432045190362797452, 00281 0.183718939421048892015969888759528, 00282 0.122864692610710396387359818808037, 00283 0.061544483005685078886546392366797, 00284 0.000000000000000000000000000000000 00285 }; 00286 00287 /* xgk[1], xgk[3], ...abscissae of the 25-point gauss rule. 00288 xgk[0], xgk[2], ...abscissae to optimally extend the 25-point 00289 gauss rule */ 00290 00291 /** weights of the 25-point gauss rule */ 00292 static const double qk51_wg[13] = 00293 { 00294 0.011393798501026287947902964113235, 00295 0.026354986615032137261901815295299, 00296 0.040939156701306312655623487711646, 00297 0.054904695975835191925936891540473, 00298 0.068038333812356917207187185656708, 00299 0.080140700335001018013234959669111, 00300 0.091028261982963649811497220702892, 00301 0.100535949067050644202206890392686, 00302 0.108519624474263653116093957050117, 00303 0.114858259145711648339325545869556, 00304 0.119455763535784772228178126512901, 00305 0.122242442990310041688959518945852, 00306 0.123176053726715451203902873079050 00307 }; 00308 00309 /** weights of the 51-point kronrod rule */ 00310 static const double qk51_wgk[26] = 00311 { 00312 0.001987383892330315926507851882843, 00313 0.005561932135356713758040236901066, 00314 0.009473973386174151607207710523655, 00315 0.013236229195571674813656405846976, 00316 0.016847817709128298231516667536336, 00317 0.020435371145882835456568292235939, 00318 0.024009945606953216220092489164881, 00319 0.027475317587851737802948455517811, 00320 0.030792300167387488891109020215229, 00321 0.034002130274329337836748795229551, 00322 0.037116271483415543560330625367620, 00323 0.040083825504032382074839284467076, 00324 0.042872845020170049476895792439495, 00325 0.045502913049921788909870584752660, 00326 0.047982537138836713906392255756915, 00327 0.050277679080715671963325259433440, 00328 0.052362885806407475864366712137873, 00329 0.054251129888545490144543370459876, 00330 0.055950811220412317308240686382747, 00331 0.057437116361567832853582693939506, 00332 0.058689680022394207961974175856788, 00333 0.059720340324174059979099291932562, 00334 0.060539455376045862945360267517565, 00335 0.061128509717053048305859030416293, 00336 0.061471189871425316661544131965264, 00337 0.061580818067832935078759824240066 00338 }; 00339 00340 /* wgk[25] was calculated from the values of wgk[0..24] */ 00341 00342 /** abscissae of the 61-point kronrod rule */ 00343 static const double qk61_xgk[31] = 00344 { 00345 0.999484410050490637571325895705811, 00346 0.996893484074649540271630050918695, 00347 0.991630996870404594858628366109486, 00348 0.983668123279747209970032581605663, 00349 0.973116322501126268374693868423707, 00350 0.960021864968307512216871025581798, 00351 0.944374444748559979415831324037439, 00352 0.926200047429274325879324277080474, 00353 0.905573307699907798546522558925958, 00354 0.882560535792052681543116462530226, 00355 0.857205233546061098958658510658944, 00356 0.829565762382768397442898119732502, 00357 0.799727835821839083013668942322683, 00358 0.767777432104826194917977340974503, 00359 0.733790062453226804726171131369528, 00360 0.697850494793315796932292388026640, 00361 0.660061064126626961370053668149271, 00362 0.620526182989242861140477556431189, 00363 0.579345235826361691756024932172540, 00364 0.536624148142019899264169793311073, 00365 0.492480467861778574993693061207709, 00366 0.447033769538089176780609900322854, 00367 0.400401254830394392535476211542661, 00368 0.352704725530878113471037207089374, 00369 0.304073202273625077372677107199257, 00370 0.254636926167889846439805129817805, 00371 0.204525116682309891438957671002025, 00372 0.153869913608583546963794672743256, 00373 0.102806937966737030147096751318001, 00374 0.051471842555317695833025213166723, 00375 0.000000000000000000000000000000000 00376 }; 00377 00378 /* xgk[1], xgk[3], ... abscissae of the 30-point gauss rule. 00379 xgk[0], xgk[2], ... abscissae to optimally extend the 30-point 00380 gauss rule */ 00381 00382 /** weights of the 30-point gauss rule */ 00383 static const double qk61_wg[15] = 00384 { 00385 0.007968192496166605615465883474674, 00386 0.018466468311090959142302131912047, 00387 0.028784707883323369349719179611292, 00388 0.038799192569627049596801936446348, 00389 0.048402672830594052902938140422808, 00390 0.057493156217619066481721689402056, 00391 0.065974229882180495128128515115962, 00392 0.073755974737705206268243850022191, 00393 0.080755895229420215354694938460530, 00394 0.086899787201082979802387530715126, 00395 0.092122522237786128717632707087619, 00396 0.096368737174644259639468626351810, 00397 0.099593420586795267062780282103569, 00398 0.101762389748405504596428952168554, 00399 0.102852652893558840341285636705415 00400 }; 00401 00402 /** weights of the 61-point kronrod rule */ 00403 static const double qk61_wgk[31] = 00404 { 00405 0.001389013698677007624551591226760, 00406 0.003890461127099884051267201844516, 00407 0.006630703915931292173319826369750, 00408 0.009273279659517763428441146892024, 00409 0.011823015253496341742232898853251, 00410 0.014369729507045804812451432443580, 00411 0.016920889189053272627572289420322, 00412 0.019414141193942381173408951050128, 00413 0.021828035821609192297167485738339, 00414 0.024191162078080601365686370725232, 00415 0.026509954882333101610601709335075, 00416 0.028754048765041292843978785354334, 00417 0.030907257562387762472884252943092, 00418 0.032981447057483726031814191016854, 00419 0.034979338028060024137499670731468, 00420 0.036882364651821229223911065617136, 00421 0.038678945624727592950348651532281, 00422 0.040374538951535959111995279752468, 00423 0.041969810215164246147147541285970, 00424 0.043452539701356069316831728117073, 00425 0.044814800133162663192355551616723, 00426 0.046059238271006988116271735559374, 00427 0.047185546569299153945261478181099, 00428 0.048185861757087129140779492298305, 00429 0.049055434555029778887528165367238, 00430 0.049795683427074206357811569379942, 00431 0.050405921402782346840893085653585, 00432 0.050881795898749606492297473049805, 00433 0.051221547849258772170656282604944, 00434 0.051426128537459025933862879215781, 00435 0.051494729429451567558340433647099 00436 }; 00437 00438 } 00439 00440 #ifndef DOXYGENP 00441 namespace o2scl { 00442 #endif 00443 00444 #ifdef O2SCL_NEVER_DEFINED 00445 // This is a proposed revision of the class structure 00446 00447 class gsl_inte_workspace : public gsl_integration_workspace { 00448 00449 public: 00450 00451 int set_size(int sz); 00452 00453 int size(); 00454 00455 int resize(int sz) 00456 00457 int initialise(double a, double b); 00458 00459 int set_initial_result(double result, double error); 00460 00461 int retrieve(double *a, double *b, double *r, double *e) const; 00462 00463 int qpsrt(); 00464 00465 int update(double a1, double b1, double area1, double error1, 00466 double a2, double b2, double area2, double error2); 00467 00468 double sum_results(); 00469 00470 int subinterval_too_small(double a1, double a2, double b2); 00471 00472 int append_interval(double a1, double b1, double area1, double error1); 00473 00474 }; 00475 #endif 00476 00477 /** 00478 \brief Base routines for the GSL adaptive integration routines 00479 00480 This class contains several functions for manipulating 00481 the GSL integration workspace. 00482 00483 \future Move gsl_integration_workspace to a separate class 00484 and remove this class, making all children direct descendants 00485 of gsl_inte instead. We'll have to figure out what to 00486 do with the data member \c wkspace though. Some work on this 00487 front is already in gsl_inte_qag_b.h. 00488 */ 00489 class gsl_inte_table : public gsl_inte { 00490 00491 public: 00492 00493 /// The integration workspace 00494 gsl_integration_workspace *w; 00495 00496 /// The size of the integration workspace 00497 int wkspace; 00498 00499 gsl_inte_table(); 00500 00501 ~gsl_inte_table(); 00502 00503 /// Set the integration workspace size 00504 int set_wkspace(size_t size); 00505 00506 /** 00507 \brief Initialize the workspace for an integration with limits 00508 \c a and \c b. 00509 */ 00510 void initialise(gsl_integration_workspace *workspace, 00511 double a, double b); 00512 00513 /// Set the result at position zero 00514 void set_initial_result(gsl_integration_workspace *workspace, 00515 double result, double error); 00516 00517 /** 00518 \brief Retrieve the ith result from the workspace 00519 00520 The workspace variable \c i is used to specify which 00521 interval is requested. 00522 */ 00523 void retrieve(const gsl_integration_workspace *workspace, 00524 double *a, double *b, double *r, double *e); 00525 00526 /// Sort the workspace 00527 void qpsrt(gsl_integration_workspace *workspace); 00528 00529 /// Update workspace with new results and resort 00530 void update(gsl_integration_workspace *workspace, 00531 double a1, double b1, double area1, double error1, 00532 double a2, double b2, double area2, double error2); 00533 00534 /// Add up all of the contributions to construct the final result 00535 double sum_results(const gsl_integration_workspace *workspace); 00536 00537 /// Find out if the present subinterval is too small 00538 int subinterval_too_small(double a1, double a2, double b2); 00539 00540 /// Append new results to workspace 00541 void append_interval(gsl_integration_workspace *workspace, 00542 double a1, double b1, double area1, double error1); 00543 00544 }; 00545 00546 /// Basic Gauss-Kronrod integration class (GSL) 00547 template<class param_t, class func_t> 00548 class gsl_inte_kronrod : public gsl_inte_table, 00549 public inte<param_t,func_t> { 00550 00551 public: 00552 00553 /** 00554 \brief The GSL Gauss-Kronrod integration function 00555 00556 Given abcissas and weights, this performs the integration of 00557 \c func between \c a and \c b, providing a result with 00558 uncertainties. 00559 00560 This function is designed for use with the values given in the 00561 o2scl_inte_qag_coeffs namespace. 00562 */ 00563 virtual void gsl_integration_qk_o2scl 00564 (func_t &func, const int n, const double xgk[], const double wg[], 00565 const double wgk[], double fv1[], double fv2[], double a, double b, 00566 double *result, double *abserr, double *resabs, double *resasc, 00567 param_t &pa) { 00568 00569 const double center = 0.5 * (a + b); 00570 const double half_length = 0.5 * (b - a); 00571 const double abs_half_length = fabs (half_length); 00572 00573 double f_center; 00574 func(center,f_center,pa); 00575 00576 double result_gauss = 0; 00577 double result_kronrod = f_center * wgk[n - 1]; 00578 00579 double result_abs = fabs (result_kronrod); 00580 double result_asc = 0; 00581 double mean = 0, err = 0; 00582 00583 int j; 00584 00585 if (n % 2 == 0) 00586 { 00587 result_gauss = f_center * wg[n / 2 - 1]; 00588 } 00589 00590 for (j = 0; j < (n - 1) / 2; j++) 00591 { 00592 const int jtw = j * 2 + 1; /* j=1,2,3 jtw=2,4,6 */ 00593 const double abscissa = half_length * xgk[jtw]; 00594 00595 double fval1, fval2; 00596 func(center-abscissa,fval1,pa); 00597 func(center+abscissa,fval2,pa); 00598 00599 const double fsum = fval1 + fval2; 00600 fv1[jtw] = fval1; 00601 fv2[jtw] = fval2; 00602 result_gauss += wg[j] * fsum; 00603 result_kronrod += wgk[jtw] * fsum; 00604 result_abs += wgk[jtw] * (fabs (fval1) + fabs (fval2)); 00605 } 00606 00607 for (j = 0; j < n / 2; j++) 00608 { 00609 int jtwm1 = j * 2; 00610 const double abscissa = half_length * xgk[jtwm1]; 00611 00612 double fval1, fval2; 00613 func(center-abscissa,fval1,pa); 00614 func(center+abscissa,fval2,pa); 00615 00616 fv1[jtwm1] = fval1; 00617 fv2[jtwm1] = fval2; 00618 result_kronrod += wgk[jtwm1] * (fval1 + fval2); 00619 result_abs += wgk[jtwm1] * (fabs (fval1) + fabs (fval2)); 00620 }; 00621 00622 mean = result_kronrod * 0.5; 00623 00624 result_asc = wgk[n - 1] * fabs (f_center - mean); 00625 00626 for (j = 0; j < n - 1; j++) 00627 { 00628 result_asc += wgk[j] * (fabs (fv1[j] - mean) + 00629 fabs (fv2[j] - mean)); 00630 } 00631 00632 /* scale by the width of the integration region */ 00633 00634 err = (result_kronrod - result_gauss) * half_length; 00635 00636 result_kronrod *= half_length; 00637 result_abs *= abs_half_length; 00638 result_asc *= abs_half_length; 00639 00640 *result = result_kronrod; 00641 *resabs = result_abs; 00642 *resasc = result_asc; 00643 *abserr = rescale_error (err, result_abs, result_asc); 00644 00645 return; 00646 } 00647 00648 }; 00649 00650 /** \brief Base class for integrating a function with a 00651 singularity (GSL) 00652 00653 This class contains the extrapolation table mechanics and the 00654 base integration function for singular integrals from GSL. The 00655 casual end-user should use \ref gsl_inte_qags, \ref 00656 gsl_inte_qagil, and \ref gsl_inte_qagiu for the actual 00657 integration. 00658 */ 00659 template<class param_t, class func_t> class gsl_inte_singular : 00660 public gsl_inte_kronrod<param_t,func_t> { 00661 00662 protected: 00663 00664 /** 00665 \brief A structure for extrapolation for \ref gsl_inte_qags 00666 00667 \todo Improve the documentation 00668 00669 \future Move this to a new class, with qelg() as a method 00670 */ 00671 struct extrapolation_table 00672 { 00673 /// Desc 00674 size_t n; 00675 /// Desc 00676 double rlist2[52]; 00677 /// Desc 00678 size_t nres; 00679 /// Desc 00680 double res3la[3]; 00681 }; 00682 00683 /// Desc 00684 void initialise_table(struct extrapolation_table *table) { 00685 table->n = 0; 00686 table->nres = 0; 00687 return; 00688 } 00689 00690 /// Desc 00691 void append_table(struct extrapolation_table *table, double y) { 00692 size_t n; 00693 n = table->n; 00694 table->rlist2[n] = y; 00695 table->n++; 00696 return; 00697 } 00698 00699 /// Desc 00700 inline int test_positivity(double result, double resabs) { 00701 int status = (fabs (result) >= (1 - 50 * GSL_DBL_EPSILON) * resabs); 00702 return status; 00703 } 00704 00705 /// Desc 00706 void qelg(struct extrapolation_table *table, double *result, 00707 double *abserr) { 00708 00709 double *epstab = table->rlist2; 00710 double *res3la = table->res3la; 00711 const size_t n = table->n - 1; 00712 00713 const double current = epstab[n]; 00714 00715 double absolute = GSL_DBL_MAX; 00716 double relative = 5 * GSL_DBL_EPSILON * fabs (current); 00717 00718 const size_t newelm = n / 2; 00719 const size_t n_orig = n; 00720 size_t n_final = n; 00721 size_t i; 00722 00723 const size_t nres_orig = table->nres; 00724 00725 *result = current; 00726 *abserr = GSL_DBL_MAX; 00727 00728 if (n < 2) { 00729 *result = current; 00730 *abserr = GSL_MAX_DBL (absolute, relative); 00731 return; 00732 } 00733 00734 epstab[n + 2] = epstab[n]; 00735 epstab[n] = GSL_DBL_MAX; 00736 00737 for (i = 0; i < newelm; i++) { 00738 double res = epstab[n - 2 * i + 2]; 00739 double e0 = epstab[n - 2 * i - 2]; 00740 double e1 = epstab[n - 2 * i - 1]; 00741 double e2 = res; 00742 00743 double e1abs = fabs (e1); 00744 double delta2 = e2 - e1; 00745 double err2 = fabs (delta2); 00746 double tol2 = GSL_MAX_DBL (fabs (e2), e1abs) * GSL_DBL_EPSILON; 00747 double delta3 = e1 - e0; 00748 double err3 = fabs (delta3); 00749 double tol3 = GSL_MAX_DBL (e1abs, fabs (e0)) * GSL_DBL_EPSILON; 00750 00751 double e3, delta1, err1, tol1, ss; 00752 00753 if (err2 <= tol2 && err3 <= tol3) 00754 { 00755 /* If e0, e1 and e2 are equal to within machine accuracy, 00756 convergence is assumed. */ 00757 00758 *result = res; 00759 absolute = err2 + err3; 00760 relative = 5 * GSL_DBL_EPSILON * fabs (res); 00761 *abserr = GSL_MAX_DBL (absolute, relative); 00762 return; 00763 } 00764 00765 e3 = epstab[n - 2 * i]; 00766 epstab[n - 2 * i] = e1; 00767 delta1 = e1 - e3; 00768 err1 = fabs (delta1); 00769 tol1 = GSL_MAX_DBL (e1abs, fabs (e3)) * GSL_DBL_EPSILON; 00770 00771 /* If two elements are very close to each other, omit a part of 00772 the table by adjusting the value of n */ 00773 00774 if (err1 <= tol1 || err2 <= tol2 || err3 <= tol3) { 00775 n_final = 2 * i; 00776 break; 00777 } 00778 00779 ss = (1 / delta1 + 1 / delta2) - 1 / delta3; 00780 00781 /* Test to detect irregular behaviour in the table, and 00782 eventually omit a part of the table by adjusting the value of 00783 n. */ 00784 if (fabs (ss * e1) <= 0.0001) { 00785 n_final = 2 * i; 00786 break; 00787 } 00788 /* Compute a new element and eventually adjust the value of 00789 result. */ 00790 00791 res = e1 + 1 / ss; 00792 epstab[n - 2 * i] = res; 00793 00794 { 00795 const double error = err2 + fabs (res - e2) + err3; 00796 00797 if (error <= *abserr) { 00798 *abserr = error; 00799 *result = res; 00800 } 00801 } 00802 } 00803 00804 /* Shift the table */ 00805 00806 { 00807 const size_t limexp = 50 - 1; 00808 00809 if (n_final == limexp) 00810 { 00811 n_final = 2 * (limexp / 2); 00812 } 00813 } 00814 00815 if (n_orig % 2 == 1) { 00816 for (i = 0; i <= newelm; i++) { 00817 epstab[1 + i * 2] = epstab[i * 2 + 3]; 00818 } 00819 } else { 00820 for (i = 0; i <= newelm; i++) { 00821 epstab[i * 2] = epstab[i * 2 + 2]; 00822 } 00823 } 00824 if (n_orig != n_final) { 00825 for (i = 0; i <= n_final; i++) { 00826 epstab[i] = epstab[n_orig - n_final + i]; 00827 } 00828 } 00829 00830 table->n = n_final + 1; 00831 00832 if (nres_orig < 3) { 00833 res3la[nres_orig] = *result; 00834 *abserr = GSL_DBL_MAX; 00835 } else { 00836 /* Compute error estimate */ 00837 *abserr = (fabs (*result - res3la[2]) + fabs (*result - res3la[1]) 00838 + fabs (*result - res3la[0])); 00839 00840 res3la[0] = res3la[1]; 00841 res3la[1] = res3la[2]; 00842 res3la[2] = *result; 00843 } 00844 00845 /* In QUADPACK the variable table->nres is incremented at the top of 00846 qelg, so it increases on every call. This leads to the array 00847 res3la being accessed when its elements are still undefined, so I 00848 have moved the update to this point so that its value more 00849 useful. */ 00850 00851 table->nres = nres_orig + 1; 00852 00853 *abserr = GSL_MAX_DBL (*abserr, 5 * GSL_DBL_EPSILON * fabs (*result)); 00854 00855 return; 00856 } 00857 00858 /// Desc 00859 int large_interval (gsl_integration_workspace * workspace) { 00860 size_t i = workspace->i ; 00861 const size_t * level = workspace->level; 00862 00863 if (level[i] < workspace->maximum_level) { 00864 return 1; 00865 } else { 00866 return 0; 00867 } 00868 } 00869 00870 /// Desc 00871 inline void reset_nrmax (gsl_integration_workspace * workspace) { 00872 workspace->nrmax = 0; 00873 workspace->i = workspace->order[0] ; 00874 } 00875 00876 /// Desc 00877 int increase_nrmax (gsl_integration_workspace * workspace) { 00878 int k; 00879 int id = workspace->nrmax; 00880 int jupbnd; 00881 00882 const size_t * level = workspace->level; 00883 const size_t * order = workspace->order; 00884 00885 size_t limit = workspace->limit ; 00886 size_t last = workspace->size - 1 ; 00887 00888 if (last > (1 + limit / 2)) { 00889 jupbnd = limit + 1 - last; 00890 } else { 00891 jupbnd = last; 00892 } 00893 00894 for (k = id; k <= jupbnd; k++) { 00895 size_t i_max = order[workspace->nrmax]; 00896 00897 workspace->i = i_max ; 00898 00899 if (level[i_max] < workspace->maximum_level) { 00900 return 1; 00901 } 00902 00903 workspace->nrmax++; 00904 00905 } 00906 return 0; 00907 } 00908 00909 /** 00910 \brief Integration function 00911 00912 \future Remove goto statements? 00913 */ 00914 int qags(func_t &func, const int qn, const double xgk[], 00915 const double wg[], const double wgk[], double fv1[], 00916 double fv2[], const double a, const double b, 00917 const double l_epsabs, const double l_epsrel, 00918 const size_t limit, double *result, double *abserr, param_t &pa) 00919 { 00920 00921 double area, errsum; 00922 double res_ext, err_ext; 00923 double result0, abserr0, resabs0, resasc0; 00924 double tolerance; 00925 00926 double ertest = 0; 00927 double error_over_large_intervals = 0; 00928 double reseps = 0, abseps = 0, correc = 0; 00929 size_t ktmin = 0; 00930 int roundoff_type1 = 0, roundoff_type2 = 0, roundoff_type3 = 0; 00931 int error_type = 0, error_type2 = 0; 00932 00933 size_t iteration = 0; 00934 00935 int positive_integrand = 0; 00936 int extrapolate = 0; 00937 int disallow_extrapolation = 0; 00938 00939 struct extrapolation_table table; 00940 00941 /* Initialize results */ 00942 00943 initialise(this->w, a, b); 00944 00945 *result = 0; 00946 *abserr = 0; 00947 00948 if (limit > this->w->limit) { 00949 this->last_iter=0; 00950 std::string estr="Iteration limit exceeds workspace "; 00951 estr+="in gsl_inte_kronrod::qags()."; 00952 set_err_ret(estr.c_str(),gsl_einval); 00953 } 00954 00955 /* Test on accuracy */ 00956 if (this->tolx <= 0 && (this->tolf < 50 * GSL_DBL_EPSILON || 00957 this->tolf < 0.5e-28)) { 00958 this->last_iter=0; 00959 00960 std::string estr="Tolerance cannot be achieved with given "; 00961 estr+="value of 'tolx' and 'tolf' in gsl_inte_kronrod::qags()."; 00962 set_err_ret(estr.c_str(),gsl_ebadtol); 00963 } 00964 00965 /* Perform the first integration */ 00966 00967 gsl_integration_qk_o2scl(func,qn,xgk,wg,wgk,fv1,fv2,a,b, 00968 &result0,&abserr0,&resabs0,&resasc0,pa); 00969 00970 set_initial_result (this->w, result0, abserr0); 00971 00972 tolerance = GSL_MAX_DBL (this->tolx, this->tolf * fabs (result0)); 00973 00974 if (abserr0 <= 100 * GSL_DBL_EPSILON * resabs0 && 00975 abserr0 > tolerance) { 00976 00977 *result = result0; 00978 *abserr = abserr0; 00979 00980 this->last_iter=1; 00981 std::string estr="Cannot reach tolerance because of roundoff error "; 00982 estr+="on first attempt in gsl_inte_kronrod::qags()."; 00983 set_err_ret(estr.c_str(),gsl_eround); 00984 00985 } else if ((abserr0 <= tolerance && 00986 abserr0 != resasc0) || abserr0 == 0.0) { 00987 00988 *result = result0; 00989 *abserr = abserr0; 00990 this->last_iter=1; 00991 return gsl_success; 00992 00993 } else if (limit == 1) { 00994 00995 *result = result0; 00996 *abserr = abserr0; 00997 00998 this->last_iter=1; 00999 std::string estr="A maximum of 1 iteration was insufficient "; 01000 estr+="in gsl_inte_kronrod::qags()."; 01001 set_err_ret(estr.c_str(),gsl_emaxiter); 01002 } 01003 01004 /* Initialization */ 01005 01006 initialise_table (&table); 01007 append_table (&table, result0); 01008 01009 area = result0; 01010 errsum = abserr0; 01011 01012 res_ext = result0; 01013 err_ext = GSL_DBL_MAX; 01014 01015 positive_integrand = this->test_positivity (result0, resabs0); 01016 01017 iteration = 1; 01018 01019 do { 01020 size_t current_level; 01021 double a1, b1, a2, b2; 01022 double a_i, b_i, r_i, e_i; 01023 double area1 = 0, area2 = 0, area12 = 0; 01024 double error1 = 0, error2 = 0, error12 = 0; 01025 double resasc1, resasc2; 01026 double resabs1, resabs2; 01027 double last_e_i; 01028 01029 /* Bisect the subinterval with the largest error estimate */ 01030 01031 retrieve (this->w, &a_i, &b_i, &r_i, &e_i); 01032 01033 current_level = this->w->level[this->w->i] + 1; 01034 01035 a1 = a_i; 01036 b1 = 0.5 * (a_i + b_i); 01037 a2 = b1; 01038 b2 = b_i; 01039 01040 iteration++; 01041 01042 gsl_integration_qk_o2scl(func,qn,xgk,wg,wgk,fv1,fv2,a1,b1, 01043 &area1,&error1,&resabs1,&resasc1,pa); 01044 gsl_integration_qk_o2scl(func,qn,xgk,wg,wgk,fv1,fv2,a2,b2, 01045 &area2,&error2,&resabs2,&resasc2,pa); 01046 01047 area12 = area1 + area2; 01048 error12 = error1 + error2; 01049 last_e_i = e_i; 01050 01051 /* Improve previous approximations to the integral and test for 01052 accuracy. 01053 01054 We write these expressions in the same way as the original 01055 QUADPACK code so that the rounding errors are the same, which 01056 makes testing easier. */ 01057 01058 errsum = errsum + error12 - e_i; 01059 area = area + area12 - r_i; 01060 01061 tolerance = GSL_MAX_DBL (this->tolx, this->tolf * fabs (area)); 01062 if (resasc1 != error1 && resasc2 != error2) { 01063 double delta = r_i - area12; 01064 01065 if (fabs (delta) <= 1.0e-5 * fabs (area12) && 01066 error12 >= 0.99 * e_i) { 01067 if (!extrapolate) { 01068 roundoff_type1++; 01069 } else { 01070 roundoff_type2++; 01071 } 01072 } 01073 if (iteration > 10 && error12 > e_i) { 01074 roundoff_type3++; 01075 } 01076 } 01077 01078 /* Test for roundoff and eventually set error flag */ 01079 01080 if (roundoff_type1 + roundoff_type2 >= 10 || 01081 roundoff_type3 >= 20) { 01082 error_type = 2; /* round off error */ 01083 } 01084 01085 if (roundoff_type2 >= 5) { 01086 error_type2 = 1; 01087 } 01088 01089 /* set error flag in the case of bad integrand behaviour at 01090 a point of the integration range */ 01091 01092 if (this->subinterval_too_small (a1, a2, b2)) { 01093 error_type = 4; 01094 } 01095 01096 /* append the newly-created intervals to the list */ 01097 01098 update (this->w, a1, b1, area1, error1, a2, b2, area2, error2); 01099 01100 if (errsum <= tolerance) { 01101 goto compute_result; 01102 } 01103 01104 if (error_type) { 01105 break; 01106 } 01107 01108 if (iteration >= limit - 1) { 01109 error_type = 1; 01110 break; 01111 } 01112 01113 if (iteration == 2) { 01114 error_over_large_intervals = errsum; 01115 ertest = tolerance; 01116 append_table (&table, area); 01117 continue; 01118 } 01119 01120 if (disallow_extrapolation) { 01121 continue; 01122 } 01123 01124 error_over_large_intervals += -last_e_i; 01125 01126 if (current_level < this->w->maximum_level) { 01127 error_over_large_intervals += error12; 01128 } 01129 01130 if (!extrapolate) { 01131 /* test whether the interval to be bisected next is the 01132 smallest interval. */ 01133 01134 if (large_interval (this->w)) 01135 continue; 01136 01137 extrapolate = 1; 01138 this->w->nrmax = 1; 01139 } 01140 01141 if (!error_type2 && error_over_large_intervals > ertest) { 01142 if (increase_nrmax (this->w)) 01143 continue; 01144 } 01145 01146 /* Perform extrapolation */ 01147 01148 append_table (&table, area); 01149 01150 qelg (&table, &reseps, &abseps); 01151 01152 ktmin++; 01153 01154 if (ktmin > 5 && err_ext < 0.001 * errsum) { 01155 error_type = 5; 01156 } 01157 01158 if (abseps < err_ext) { 01159 ktmin = 0; 01160 err_ext = abseps; 01161 res_ext = reseps; 01162 correc = error_over_large_intervals; 01163 ertest = GSL_MAX_DBL (this->tolx, 01164 this->tolf * fabs (reseps)); 01165 if (err_ext <= ertest) 01166 break; 01167 } 01168 01169 /* Prepare bisection of the smallest interval. */ 01170 01171 if (table.n == 1) { 01172 disallow_extrapolation = 1; 01173 } 01174 01175 if (error_type == 5) { 01176 break; 01177 } 01178 01179 /* work on interval with largest error */ 01180 01181 reset_nrmax (this->w); 01182 extrapolate = 0; 01183 error_over_large_intervals = errsum; 01184 01185 /// Output iteration information 01186 01187 if (this->verbose>0) { 01188 std::cout << this->type(); 01189 std::cout << " Iter: " << iteration; 01190 std::cout.setf(std::ios::showpos); 01191 std::cout << " Res: " << area; 01192 std::cout.unsetf(std::ios::showpos); 01193 std::cout << " Err: " << errsum 01194 << " Tol: " << tolerance << std::endl; 01195 if (this->verbose>1) { 01196 char ch; 01197 std::cout << "Press a key and type enter to continue. " ; 01198 std::cin >> ch; 01199 } 01200 } 01201 01202 } 01203 while (iteration < limit); 01204 01205 *result = res_ext; 01206 *abserr = err_ext; 01207 01208 if (err_ext == GSL_DBL_MAX) 01209 goto compute_result; 01210 01211 if (error_type || error_type2) { 01212 if (error_type2) { 01213 err_ext += correc; 01214 } 01215 01216 if (error_type == 0) 01217 error_type = 3; 01218 01219 if (res_ext != 0.0 && area != 0.0) { 01220 if (err_ext / fabs (res_ext) > errsum / fabs (area)) 01221 goto compute_result; 01222 } else if (err_ext > errsum) { 01223 goto compute_result; 01224 } else if (area == 0.0) { 01225 goto return_error; 01226 } 01227 } 01228 01229 /* Test on divergence. */ 01230 01231 { 01232 double max_area = GSL_MAX_DBL (fabs (res_ext), fabs (area)); 01233 01234 if (!positive_integrand && max_area < 0.01 * resabs0) 01235 goto return_error; 01236 } 01237 01238 { 01239 double ratio = res_ext / area; 01240 01241 if (ratio < 0.01 || ratio > 100.0 || errsum > fabs (area)) 01242 error_type = 6; 01243 } 01244 01245 goto return_error; 01246 01247 compute_result: 01248 01249 *result = sum_results (this->w); 01250 *abserr = errsum; 01251 01252 return_error: 01253 01254 if (error_type > 2) 01255 error_type--; 01256 01257 this->last_iter=iteration; 01258 01259 if (error_type == 0) { 01260 return gsl_success; 01261 } else if (error_type == 1) { 01262 std::string estr="Number of iterations was insufficient "; 01263 estr+=" in gsl_inte_kronrod::qags()."; 01264 set_err_ret(estr.c_str(),gsl_emaxiter); 01265 } else if (error_type == 2) { 01266 std::string estr="Roundoff error prevents tolerance "; 01267 estr+="from being achieved in gsl_inte_kronrod::qags()."; 01268 set_err_ret(estr.c_str(),gsl_eround); 01269 } else if (error_type == 3) { 01270 std::string estr="Bad integrand behavior "; 01271 estr+="in gsl_inte_kronrod::qags()."; 01272 set_err_ret(estr.c_str(),gsl_esing); 01273 } else if (error_type == 4) { 01274 std::string estr="Roundoff error detected in extrapolation table "; 01275 estr+="in gsl_inte_kronrod::qags()."; 01276 set_err_ret(estr.c_str(),gsl_eround); 01277 } else if (error_type == 5) { 01278 std::string estr="Integral is divergent or slowly convergent "; 01279 estr+="in gsl_inte_kronrod::qags()."; 01280 set_err_ret(estr.c_str(),gsl_ediverge); 01281 } else { 01282 std::string estr="Could not integrate function in gsl_inte_kronrod"; 01283 estr+="::qags() (it may have returned a non-finite result)."; 01284 set_err_ret(estr.c_str(),gsl_efailed); 01285 } 01286 01287 // No return statement needed since the above if statement 01288 // always forces a return 01289 } 01290 01291 }; 01292 01293 /** \brief Integrate a function with a singularity (GSL) 01294 */ 01295 template<class param_t, class func_t> class gsl_inte_transform : 01296 public gsl_inte_singular<param_t,func_t> { 01297 01298 public: 01299 01300 /// The transformation to apply to the user-supplied function 01301 virtual double transform(func_t &func, double t, param_t &pa) { 01302 return 0.0; 01303 } 01304 01305 /** 01306 \brief The basic Gauss-Kronrod integration function 01307 01308 This is basically just a copy of 01309 gsl_inte_qag::gsl_integration_qk_o2scl() which is rewritten to 01310 call the internal transformed function rather than directly 01311 calling the user-specified function. 01312 */ 01313 virtual void gsl_integration_qk_o2scl 01314 (func_t &func, const int n, const double xgk[], const double wg[], 01315 const double wgk[], double fv1[], double fv2[], double a, double b, 01316 double *result, double *abserr, double *resabs, double *resasc, 01317 param_t &pa) { 01318 01319 const double center = 0.5 * (a + b); 01320 const double half_length = 0.5 * (b - a); 01321 const double abs_half_length = fabs (half_length); 01322 01323 const double f_center=transform(func,center,pa); 01324 01325 double result_gauss = 0; 01326 double result_kronrod = f_center * wgk[n - 1]; 01327 01328 double result_abs = fabs (result_kronrod); 01329 double result_asc = 0; 01330 double mean = 0, err = 0; 01331 01332 int j; 01333 01334 if (n % 2 == 0) { 01335 result_gauss = f_center * wg[n / 2 - 1]; 01336 } 01337 01338 for (j = 0; j < (n - 1) / 2; j++) { 01339 const int jtw = j * 2 + 1; /* j=1,2,3 jtw=2,4,6 */ 01340 const double abscissa = half_length * xgk[jtw]; 01341 01342 const double fval1=transform(func,center-abscissa,pa); 01343 const double fval2=transform(func,center+abscissa,pa); 01344 const double fsum = fval1 + fval2; 01345 01346 fv1[jtw] = fval1; 01347 fv2[jtw] = fval2; 01348 result_gauss += wg[j] * fsum; 01349 result_kronrod += wgk[jtw] * fsum; 01350 result_abs += wgk[jtw] * (fabs (fval1) + fabs (fval2)); 01351 } 01352 01353 for (j = 0; j < n / 2; j++) { 01354 int jtwm1 = j * 2; 01355 const double abscissa = half_length * xgk[jtwm1]; 01356 01357 const double fval1=transform(func,center-abscissa,pa); 01358 const double fval2=transform(func,center+abscissa,pa); 01359 01360 fv1[jtwm1] = fval1; 01361 fv2[jtwm1] = fval2; 01362 result_kronrod += wgk[jtwm1] * (fval1 + fval2); 01363 result_abs += wgk[jtwm1] * (fabs (fval1) + fabs (fval2)); 01364 }; 01365 01366 mean = result_kronrod * 0.5; 01367 01368 result_asc = wgk[n - 1] * fabs (f_center - mean); 01369 01370 for (j = 0; j < n - 1; j++) { 01371 result_asc += wgk[j] * (fabs (fv1[j] - mean) + 01372 fabs (fv2[j] - mean)); 01373 } 01374 01375 /* scale by the width of the integration region */ 01376 01377 err = (result_kronrod - result_gauss) * half_length; 01378 01379 result_kronrod *= half_length; 01380 result_abs *= abs_half_length; 01381 result_asc *= abs_half_length; 01382 01383 *result = result_kronrod; 01384 *resabs = result_abs; 01385 *resasc = result_asc; 01386 *abserr = this->rescale_error (err, result_abs, result_asc); 01387 01388 } 01389 01390 }; 01391 01392 #ifndef DOXYGENP 01393 } 01394 #endif 01395 01396 #endif
Documentation generated with Doxygen and provided under the GNU Free Documentation License. See License Information for details.
Project hosting provided by
,
O2scl Sourceforge Project Page