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 /** \brief 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 /** \brief 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 /** \brief 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 /** \brief 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 /** \brief 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 /** \brief 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 /** \brief 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 /** \brief 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 /** \brief 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 /** \brief 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 /** \brief 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 /** \brief 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 /** \brief 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 /** \brief 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 /** \brief 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 /** \brief 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 /** \brief 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 /** \brief 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 classes 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 (default 1000) 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 \future This function, in principle, could be replaced with 00564 a generic integration pointer. 00565 */ 00566 virtual void gsl_integration_qk_o2scl 00567 (func_t &func, const int n, const double xgk[], const double wg[], 00568 const double wgk[], double fv1[], double fv2[], double a, double b, 00569 double *result, double *abserr, double *resabs, double *resasc, 00570 param_t &pa) { 00571 00572 const double center = 0.5 * (a + b); 00573 const double half_length = 0.5 * (b - a); 00574 const double abs_half_length = fabs (half_length); 00575 00576 double f_center; 00577 func(center,f_center,pa); 00578 00579 double result_gauss = 0; 00580 double result_kronrod = f_center * wgk[n - 1]; 00581 00582 double result_abs = fabs (result_kronrod); 00583 double result_asc = 0; 00584 double mean = 0, err = 0; 00585 00586 int j; 00587 00588 if (n % 2 == 0) 00589 { 00590 result_gauss = f_center * wg[n / 2 - 1]; 00591 } 00592 00593 for (j = 0; j < (n - 1) / 2; j++) { 00594 /* j=1,2,3,... jtw=2,4,6,... */ 00595 const int jtw = j * 2 + 1; 00596 const double abscissa = half_length * xgk[jtw]; 00597 00598 double fval1, fval2; 00599 func(center-abscissa,fval1,pa); 00600 func(center+abscissa,fval2,pa); 00601 00602 const double fsum = fval1 + fval2; 00603 fv1[jtw] = fval1; 00604 fv2[jtw] = fval2; 00605 result_gauss += wg[j] * fsum; 00606 result_kronrod += wgk[jtw] * fsum; 00607 result_abs += wgk[jtw] * (fabs (fval1) + fabs (fval2)); 00608 } 00609 00610 for (j = 0; j < n / 2; j++) { 00611 int jtwm1 = j * 2; 00612 const double abscissa = half_length * xgk[jtwm1]; 00613 00614 double fval1, fval2; 00615 func(center-abscissa,fval1,pa); 00616 func(center+abscissa,fval2,pa); 00617 00618 fv1[jtwm1] = fval1; 00619 fv2[jtwm1] = fval2; 00620 result_kronrod += wgk[jtwm1] * (fval1 + fval2); 00621 result_abs += wgk[jtwm1] * (fabs (fval1) + fabs (fval2)); 00622 }; 00623 00624 mean = result_kronrod * 0.5; 00625 00626 result_asc = wgk[n - 1] * fabs (f_center - mean); 00627 00628 for (j = 0; j < n - 1; j++) { 00629 result_asc += wgk[j] * (fabs (fv1[j] - mean) + 00630 fabs (fv2[j] - mean)); 00631 } 00632 00633 /* scale by the width of the integration region */ 00634 00635 err = (result_kronrod - result_gauss) * half_length; 00636 00637 result_kronrod *= half_length; 00638 result_abs *= abs_half_length; 00639 result_asc *= abs_half_length; 00640 00641 *result = result_kronrod; 00642 *resabs = result_abs; 00643 *resasc = result_asc; 00644 *abserr = rescale_error (err, result_abs, result_asc); 00645 00646 return; 00647 } 00648 00649 }; 00650 00651 /** \brief Base class for integrating a function with a 00652 singularity (GSL) 00653 00654 This class contains the extrapolation table mechanics and the 00655 base integration function for singular integrals from GSL. The 00656 casual end-user should use \ref gsl_inte_qags, \ref 00657 gsl_inte_qagil, and \ref gsl_inte_qagiu for the actual 00658 integration. 00659 */ 00660 template<class param_t, class func_t> class gsl_inte_singular : 00661 public gsl_inte_kronrod<param_t,func_t> { 00662 00663 protected: 00664 00665 /** 00666 \brief A structure for extrapolation for \ref gsl_inte_qags 00667 00668 \todo Improve the documentation 00669 00670 \future Move this to a new class, with qelg() as a method 00671 */ 00672 struct extrapolation_table 00673 { 00674 /// Desc 00675 size_t n; 00676 /// Desc 00677 double rlist2[52]; 00678 /// Desc 00679 size_t nres; 00680 /// Desc 00681 double res3la[3]; 00682 }; 00683 00684 /// Desc 00685 void initialise_table(struct extrapolation_table *table) { 00686 table->n = 0; 00687 table->nres = 0; 00688 return; 00689 } 00690 00691 /// Desc 00692 void append_table(struct extrapolation_table *table, double y) { 00693 size_t n; 00694 n = table->n; 00695 table->rlist2[n] = y; 00696 table->n++; 00697 return; 00698 } 00699 00700 /// Desc 00701 inline int test_positivity(double result, double resabs) { 00702 int status = (fabs (result) >= (1 - 50 * GSL_DBL_EPSILON) * resabs); 00703 return status; 00704 } 00705 00706 /// Desc 00707 void qelg(struct extrapolation_table *table, double *result, 00708 double *abserr) { 00709 00710 double *epstab = table->rlist2; 00711 double *res3la = table->res3la; 00712 const size_t n = table->n - 1; 00713 00714 const double current = epstab[n]; 00715 00716 double absolute = GSL_DBL_MAX; 00717 double relative = 5 * GSL_DBL_EPSILON * fabs (current); 00718 00719 const size_t newelm = n / 2; 00720 const size_t n_orig = n; 00721 size_t n_final = n; 00722 size_t i; 00723 00724 const size_t nres_orig = table->nres; 00725 00726 *result = current; 00727 *abserr = GSL_DBL_MAX; 00728 00729 if (n < 2) { 00730 *result = current; 00731 *abserr = GSL_MAX_DBL (absolute, relative); 00732 return; 00733 } 00734 00735 epstab[n + 2] = epstab[n]; 00736 epstab[n] = GSL_DBL_MAX; 00737 00738 for (i = 0; i < newelm; i++) { 00739 double res = epstab[n - 2 * i + 2]; 00740 double e0 = epstab[n - 2 * i - 2]; 00741 double e1 = epstab[n - 2 * i - 1]; 00742 double e2 = res; 00743 00744 double e1abs = fabs (e1); 00745 double delta2 = e2 - e1; 00746 double err2 = fabs (delta2); 00747 double tol2 = GSL_MAX_DBL (fabs (e2), e1abs) * GSL_DBL_EPSILON; 00748 double delta3 = e1 - e0; 00749 double err3 = fabs (delta3); 00750 double tol3 = GSL_MAX_DBL (e1abs, fabs (e0)) * GSL_DBL_EPSILON; 00751 00752 double e3, delta1, err1, tol1, ss; 00753 00754 if (err2 <= tol2 && err3 <= tol3) 00755 { 00756 /* If e0, e1 and e2 are equal to within machine accuracy, 00757 convergence is assumed. */ 00758 00759 *result = res; 00760 absolute = err2 + err3; 00761 relative = 5 * GSL_DBL_EPSILON * fabs (res); 00762 *abserr = GSL_MAX_DBL (absolute, relative); 00763 return; 00764 } 00765 00766 e3 = epstab[n - 2 * i]; 00767 epstab[n - 2 * i] = e1; 00768 delta1 = e1 - e3; 00769 err1 = fabs (delta1); 00770 tol1 = GSL_MAX_DBL (e1abs, fabs (e3)) * GSL_DBL_EPSILON; 00771 00772 /* If two elements are very close to each other, omit a part of 00773 the table by adjusting the value of n */ 00774 00775 if (err1 <= tol1 || err2 <= tol2 || err3 <= tol3) { 00776 n_final = 2 * i; 00777 break; 00778 } 00779 00780 ss = (1 / delta1 + 1 / delta2) - 1 / delta3; 00781 00782 /* Test to detect irregular behaviour in the table, and 00783 eventually omit a part of the table by adjusting the value of 00784 n. */ 00785 if (fabs (ss * e1) <= 0.0001) { 00786 n_final = 2 * i; 00787 break; 00788 } 00789 /* Compute a new element and eventually adjust the value of 00790 result. */ 00791 00792 res = e1 + 1 / ss; 00793 epstab[n - 2 * i] = res; 00794 00795 { 00796 const double error = err2 + fabs (res - e2) + err3; 00797 00798 if (error <= *abserr) { 00799 *abserr = error; 00800 *result = res; 00801 } 00802 } 00803 } 00804 00805 /* Shift the table */ 00806 00807 { 00808 const size_t limexp = 50 - 1; 00809 00810 if (n_final == limexp) 00811 { 00812 n_final = 2 * (limexp / 2); 00813 } 00814 } 00815 00816 if (n_orig % 2 == 1) { 00817 for (i = 0; i <= newelm; i++) { 00818 epstab[1 + i * 2] = epstab[i * 2 + 3]; 00819 } 00820 } else { 00821 for (i = 0; i <= newelm; i++) { 00822 epstab[i * 2] = epstab[i * 2 + 2]; 00823 } 00824 } 00825 if (n_orig != n_final) { 00826 for (i = 0; i <= n_final; i++) { 00827 epstab[i] = epstab[n_orig - n_final + i]; 00828 } 00829 } 00830 00831 table->n = n_final + 1; 00832 00833 if (nres_orig < 3) { 00834 res3la[nres_orig] = *result; 00835 *abserr = GSL_DBL_MAX; 00836 } else { 00837 /* Compute error estimate */ 00838 *abserr = (fabs (*result - res3la[2]) + fabs (*result - res3la[1]) 00839 + fabs (*result - res3la[0])); 00840 00841 res3la[0] = res3la[1]; 00842 res3la[1] = res3la[2]; 00843 res3la[2] = *result; 00844 } 00845 00846 /* In QUADPACK the variable table->nres is incremented at the top of 00847 qelg, so it increases on every call. This leads to the array 00848 res3la being accessed when its elements are still undefined, so I 00849 have moved the update to this point so that its value more 00850 useful. */ 00851 00852 table->nres = nres_orig + 1; 00853 00854 *abserr = GSL_MAX_DBL (*abserr, 5 * GSL_DBL_EPSILON * fabs (*result)); 00855 00856 return; 00857 } 00858 00859 /// Desc 00860 int large_interval (gsl_integration_workspace * workspace) { 00861 size_t i = workspace->i ; 00862 const size_t * level = workspace->level; 00863 00864 if (level[i] < workspace->maximum_level) { 00865 return 1; 00866 } else { 00867 return 0; 00868 } 00869 } 00870 00871 /// Desc 00872 inline void reset_nrmax (gsl_integration_workspace * workspace) { 00873 workspace->nrmax = 0; 00874 workspace->i = workspace->order[0] ; 00875 } 00876 00877 /// Desc 00878 int increase_nrmax (gsl_integration_workspace * workspace) { 00879 int k; 00880 int id = workspace->nrmax; 00881 int jupbnd; 00882 00883 const size_t * level = workspace->level; 00884 const size_t * order = workspace->order; 00885 00886 size_t limit = workspace->limit ; 00887 size_t last = workspace->size - 1 ; 00888 00889 if (last > (1 + limit / 2)) { 00890 jupbnd = limit + 1 - last; 00891 } else { 00892 jupbnd = last; 00893 } 00894 00895 for (k = id; k <= jupbnd; k++) { 00896 size_t i_max = order[workspace->nrmax]; 00897 00898 workspace->i = i_max ; 00899 00900 if (level[i_max] < workspace->maximum_level) { 00901 return 1; 00902 } 00903 00904 workspace->nrmax++; 00905 00906 } 00907 return 0; 00908 } 00909 00910 /** 00911 \brief Integration function 00912 00913 \future Remove goto statements? 00914 */ 00915 int qags(func_t &func, const int qn, const double xgk[], 00916 const double wg[], const double wgk[], double fv1[], 00917 double fv2[], const double a, const double b, 00918 const double l_epsabs, const double l_epsrel, 00919 const size_t limit, double *result, double *abserr, param_t &pa) 00920 { 00921 00922 double area, errsum; 00923 double res_ext, err_ext; 00924 double result0, abserr0, resabs0, resasc0; 00925 double tolerance; 00926 00927 double ertest = 0; 00928 double error_over_large_intervals = 0; 00929 double reseps = 0, abseps = 0, correc = 0; 00930 size_t ktmin = 0; 00931 int roundoff_type1 = 0, roundoff_type2 = 0, roundoff_type3 = 0; 00932 int error_type = 0, error_type2 = 0; 00933 00934 size_t iteration = 0; 00935 00936 int positive_integrand = 0; 00937 int extrapolate = 0; 00938 int disallow_extrapolation = 0; 00939 00940 struct extrapolation_table table; 00941 00942 /* Initialize results */ 00943 00944 initialise(this->w, a, b); 00945 00946 *result = 0; 00947 *abserr = 0; 00948 00949 if (limit > this->w->limit) { 00950 this->last_iter=0; 00951 std::string estr="Iteration limit exceeds workspace "; 00952 estr+="in gsl_inte_kronrod::qags()."; 00953 set_err_ret(estr.c_str(),gsl_einval); 00954 } 00955 00956 /* Test on accuracy */ 00957 if (this->tolx <= 0 && (this->tolf < 50 * GSL_DBL_EPSILON || 00958 this->tolf < 0.5e-28)) { 00959 this->last_iter=0; 00960 00961 std::string estr="Tolerance cannot be achieved with given "; 00962 estr+="value of 'tolx' and 'tolf' in gsl_inte_kronrod::qags()."; 00963 set_err_ret(estr.c_str(),gsl_ebadtol); 00964 } 00965 00966 /* Perform the first integration */ 00967 00968 gsl_integration_qk_o2scl(func,qn,xgk,wg,wgk,fv1,fv2,a,b, 00969 &result0,&abserr0,&resabs0,&resasc0,pa); 00970 00971 set_initial_result (this->w, result0, abserr0); 00972 00973 tolerance = GSL_MAX_DBL (this->tolx, this->tolf * fabs (result0)); 00974 00975 if (abserr0 <= 100 * GSL_DBL_EPSILON * resabs0 && 00976 abserr0 > tolerance) { 00977 00978 *result = result0; 00979 *abserr = abserr0; 00980 00981 this->last_iter=1; 00982 std::string estr="Cannot reach tolerance because of roundoff error "; 00983 estr+="on first attempt in gsl_inte_kronrod::qags()."; 00984 set_err_ret(estr.c_str(),gsl_eround); 00985 00986 } else if ((abserr0 <= tolerance && 00987 abserr0 != resasc0) || abserr0 == 0.0) { 00988 00989 *result = result0; 00990 *abserr = abserr0; 00991 this->last_iter=1; 00992 return gsl_success; 00993 00994 } else if (limit == 1) { 00995 00996 *result = result0; 00997 *abserr = abserr0; 00998 00999 this->last_iter=1; 01000 std::string estr="A maximum of 1 iteration was insufficient "; 01001 estr+="in gsl_inte_kronrod::qags()."; 01002 set_err_ret(estr.c_str(),gsl_emaxiter); 01003 } 01004 01005 /* Initialization */ 01006 01007 initialise_table (&table); 01008 append_table (&table, result0); 01009 01010 area = result0; 01011 errsum = abserr0; 01012 01013 res_ext = result0; 01014 err_ext = GSL_DBL_MAX; 01015 01016 positive_integrand = this->test_positivity (result0, resabs0); 01017 01018 iteration = 1; 01019 01020 do { 01021 size_t current_level; 01022 double a1, b1, a2, b2; 01023 double a_i, b_i, r_i, e_i; 01024 double area1 = 0, area2 = 0, area12 = 0; 01025 double error1 = 0, error2 = 0, error12 = 0; 01026 double resasc1, resasc2; 01027 double resabs1, resabs2; 01028 double last_e_i; 01029 01030 /* Bisect the subinterval with the largest error estimate */ 01031 01032 retrieve (this->w, &a_i, &b_i, &r_i, &e_i); 01033 01034 current_level = this->w->level[this->w->i] + 1; 01035 01036 a1 = a_i; 01037 b1 = 0.5 * (a_i + b_i); 01038 a2 = b1; 01039 b2 = b_i; 01040 01041 iteration++; 01042 01043 gsl_integration_qk_o2scl(func,qn,xgk,wg,wgk,fv1,fv2,a1,b1, 01044 &area1,&error1,&resabs1,&resasc1,pa); 01045 gsl_integration_qk_o2scl(func,qn,xgk,wg,wgk,fv1,fv2,a2,b2, 01046 &area2,&error2,&resabs2,&resasc2,pa); 01047 01048 area12 = area1 + area2; 01049 error12 = error1 + error2; 01050 last_e_i = e_i; 01051 01052 /* Improve previous approximations to the integral and test for 01053 accuracy. 01054 01055 We write these expressions in the same way as the original 01056 QUADPACK code so that the rounding errors are the same, which 01057 makes testing easier. */ 01058 01059 errsum = errsum + error12 - e_i; 01060 area = area + area12 - r_i; 01061 01062 tolerance = GSL_MAX_DBL (this->tolx, this->tolf * fabs (area)); 01063 if (resasc1 != error1 && resasc2 != error2) { 01064 double delta = r_i - area12; 01065 01066 if (fabs (delta) <= 1.0e-5 * fabs (area12) && 01067 error12 >= 0.99 * e_i) { 01068 if (!extrapolate) { 01069 roundoff_type1++; 01070 } else { 01071 roundoff_type2++; 01072 } 01073 } 01074 if (iteration > 10 && error12 > e_i) { 01075 roundoff_type3++; 01076 } 01077 } 01078 01079 /* Test for roundoff and eventually set error flag */ 01080 01081 if (roundoff_type1 + roundoff_type2 >= 10 || 01082 roundoff_type3 >= 20) { 01083 error_type = 2; /* round off error */ 01084 } 01085 01086 if (roundoff_type2 >= 5) { 01087 error_type2 = 1; 01088 } 01089 01090 /* set error flag in the case of bad integrand behaviour at 01091 a point of the integration range */ 01092 01093 if (this->subinterval_too_small (a1, a2, b2)) { 01094 error_type = 4; 01095 } 01096 01097 /* append the newly-created intervals to the list */ 01098 01099 update (this->w, a1, b1, area1, error1, a2, b2, area2, error2); 01100 01101 if (errsum <= tolerance) { 01102 goto compute_result; 01103 } 01104 01105 if (error_type) { 01106 break; 01107 } 01108 01109 if (iteration >= limit - 1) { 01110 error_type = 1; 01111 break; 01112 } 01113 01114 if (iteration == 2) { 01115 error_over_large_intervals = errsum; 01116 ertest = tolerance; 01117 append_table (&table, area); 01118 continue; 01119 } 01120 01121 if (disallow_extrapolation) { 01122 continue; 01123 } 01124 01125 error_over_large_intervals += -last_e_i; 01126 01127 if (current_level < this->w->maximum_level) { 01128 error_over_large_intervals += error12; 01129 } 01130 01131 if (!extrapolate) { 01132 /* test whether the interval to be bisected next is the 01133 smallest interval. */ 01134 01135 if (large_interval (this->w)) 01136 continue; 01137 01138 extrapolate = 1; 01139 this->w->nrmax = 1; 01140 } 01141 01142 if (!error_type2 && error_over_large_intervals > ertest) { 01143 if (increase_nrmax (this->w)) 01144 continue; 01145 } 01146 01147 /* Perform extrapolation */ 01148 01149 append_table (&table, area); 01150 01151 qelg (&table, &reseps, &abseps); 01152 01153 ktmin++; 01154 01155 if (ktmin > 5 && err_ext < 0.001 * errsum) { 01156 error_type = 5; 01157 } 01158 01159 if (abseps < err_ext) { 01160 ktmin = 0; 01161 err_ext = abseps; 01162 res_ext = reseps; 01163 correc = error_over_large_intervals; 01164 ertest = GSL_MAX_DBL (this->tolx, 01165 this->tolf * fabs (reseps)); 01166 if (err_ext <= ertest) 01167 break; 01168 } 01169 01170 /* Prepare bisection of the smallest interval. */ 01171 01172 if (table.n == 1) { 01173 disallow_extrapolation = 1; 01174 } 01175 01176 if (error_type == 5) { 01177 break; 01178 } 01179 01180 /* work on interval with largest error */ 01181 01182 reset_nrmax (this->w); 01183 extrapolate = 0; 01184 error_over_large_intervals = errsum; 01185 01186 /// Output iteration information 01187 01188 if (this->verbose>0) { 01189 std::cout << this->type(); 01190 std::cout << " Iter: " << iteration; 01191 std::cout.setf(std::ios::showpos); 01192 std::cout << " Res: " << area; 01193 std::cout.unsetf(std::ios::showpos); 01194 std::cout << " Err: " << errsum 01195 << " Tol: " << tolerance << std::endl; 01196 if (this->verbose>1) { 01197 char ch; 01198 std::cout << "Press a key and type enter to continue. " ; 01199 std::cin >> ch; 01200 } 01201 } 01202 01203 } 01204 while (iteration < limit); 01205 01206 *result = res_ext; 01207 *abserr = err_ext; 01208 01209 if (err_ext == GSL_DBL_MAX) 01210 goto compute_result; 01211 01212 if (error_type || error_type2) { 01213 if (error_type2) { 01214 err_ext += correc; 01215 } 01216 01217 if (error_type == 0) 01218 error_type = 3; 01219 01220 if (res_ext != 0.0 && area != 0.0) { 01221 if (err_ext / fabs (res_ext) > errsum / fabs (area)) 01222 goto compute_result; 01223 } else if (err_ext > errsum) { 01224 goto compute_result; 01225 } else if (area == 0.0) { 01226 goto return_error; 01227 } 01228 } 01229 01230 /* Test on divergence. */ 01231 01232 { 01233 double max_area = GSL_MAX_DBL (fabs (res_ext), fabs (area)); 01234 01235 if (!positive_integrand && max_area < 0.01 * resabs0) 01236 goto return_error; 01237 } 01238 01239 { 01240 double ratio = res_ext / area; 01241 01242 if (ratio < 0.01 || ratio > 100.0 || errsum > fabs (area)) 01243 error_type = 6; 01244 } 01245 01246 goto return_error; 01247 01248 compute_result: 01249 01250 *result = sum_results (this->w); 01251 *abserr = errsum; 01252 01253 return_error: 01254 01255 if (error_type > 2) 01256 error_type--; 01257 01258 this->last_iter=iteration; 01259 01260 if (error_type == 0) { 01261 return gsl_success; 01262 } else if (error_type == 1) { 01263 std::string estr="Number of iterations was insufficient "; 01264 estr+=" in gsl_inte_kronrod::qags()."; 01265 set_err_ret(estr.c_str(),gsl_emaxiter); 01266 } else if (error_type == 2) { 01267 std::string estr="Roundoff error prevents tolerance "; 01268 estr+="from being achieved in gsl_inte_kronrod::qags()."; 01269 set_err_ret(estr.c_str(),gsl_eround); 01270 } else if (error_type == 3) { 01271 std::string estr="Bad integrand behavior "; 01272 estr+="in gsl_inte_kronrod::qags()."; 01273 set_err_ret(estr.c_str(),gsl_esing); 01274 } else if (error_type == 4) { 01275 std::string estr="Roundoff error detected in extrapolation table "; 01276 estr+="in gsl_inte_kronrod::qags()."; 01277 set_err_ret(estr.c_str(),gsl_eround); 01278 } else if (error_type == 5) { 01279 std::string estr="Integral is divergent or slowly convergent "; 01280 estr+="in gsl_inte_kronrod::qags()."; 01281 set_err_ret(estr.c_str(),gsl_ediverge); 01282 } else { 01283 std::string estr="Could not integrate function in gsl_inte_kronrod"; 01284 estr+="::qags() (it may have returned a non-finite result)."; 01285 set_err_ret(estr.c_str(),gsl_efailed); 01286 } 01287 01288 // No return statement needed since the above if statement 01289 // always forces a return 01290 } 01291 01292 }; 01293 01294 /** \brief Integrate a function with a singularity (GSL) [abstract base] 01295 */ 01296 template<class param_t, class func_t> class gsl_inte_transform : 01297 public gsl_inte_singular<param_t,func_t> { 01298 01299 public: 01300 01301 /// The transformation to apply to the user-supplied function 01302 virtual double transform(func_t &func, double t, param_t &pa)=0; 01303 01304 /** 01305 \brief The basic Gauss-Kronrod integration function 01306 01307 This is basically just a copy of 01308 gsl_inte_qag::gsl_integration_qk_o2scl() which is rewritten to 01309 call the internal transformed function rather than directly 01310 calling the user-specified function. 01311 */ 01312 virtual void gsl_integration_qk_o2scl 01313 (func_t &func, const int n, const double xgk[], const double wg[], 01314 const double wgk[], double fv1[], double fv2[], double a, double b, 01315 double *result, double *abserr, double *resabs, double *resasc, 01316 param_t &pa) { 01317 01318 const double center = 0.5 * (a + b); 01319 const double half_length = 0.5 * (b - a); 01320 const double abs_half_length = fabs (half_length); 01321 01322 const double f_center=transform(func,center,pa); 01323 01324 double result_gauss = 0; 01325 double result_kronrod = f_center * wgk[n - 1]; 01326 01327 double result_abs = fabs (result_kronrod); 01328 double result_asc = 0; 01329 double mean = 0, err = 0; 01330 01331 int j; 01332 01333 if (n % 2 == 0) { 01334 result_gauss = f_center * wg[n / 2 - 1]; 01335 } 01336 01337 for (j = 0; j < (n - 1) / 2; j++) { 01338 01339 /* j=1,2,3,.. jtw=2,4,6,.. */ 01340 const int jtw = j * 2 + 1; 01341 const double abscissa = half_length * xgk[jtw]; 01342 01343 const double fval1=transform(func,center-abscissa,pa); 01344 const double fval2=transform(func,center+abscissa,pa); 01345 const double fsum = fval1 + fval2; 01346 01347 fv1[jtw] = fval1; 01348 fv2[jtw] = fval2; 01349 result_gauss += wg[j] * fsum; 01350 result_kronrod += wgk[jtw] * fsum; 01351 result_abs += wgk[jtw] * (fabs (fval1) + fabs (fval2)); 01352 } 01353 01354 for (j = 0; j < n / 2; j++) { 01355 int jtwm1 = j * 2; 01356 const double abscissa = half_length * xgk[jtwm1]; 01357 01358 const double fval1=transform(func,center-abscissa,pa); 01359 const double fval2=transform(func,center+abscissa,pa); 01360 01361 fv1[jtwm1] = fval1; 01362 fv2[jtwm1] = fval2; 01363 result_kronrod += wgk[jtwm1] * (fval1 + fval2); 01364 result_abs += wgk[jtwm1] * (fabs (fval1) + fabs (fval2)); 01365 }; 01366 01367 mean = result_kronrod * 0.5; 01368 01369 result_asc = wgk[n - 1] * fabs (f_center - mean); 01370 01371 for (j = 0; j < n - 1; j++) { 01372 result_asc += wgk[j] * (fabs (fv1[j] - mean) + 01373 fabs (fv2[j] - mean)); 01374 } 01375 01376 /* scale by the width of the integration region */ 01377 01378 err = (result_kronrod - result_gauss) * half_length; 01379 01380 result_kronrod *= half_length; 01381 result_abs *= abs_half_length; 01382 result_asc *= abs_half_length; 01383 01384 *result = result_kronrod; 01385 *resabs = result_abs; 01386 *resasc = result_asc; 01387 *abserr = this->rescale_error (err, result_abs, result_asc); 01388 01389 } 01390 01391 }; 01392 01393 #ifndef DOXYGENP 01394 } 01395 #endif 01396 01397 #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