gsl_inte_qag_b.h

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 SourceForge.net Logo, O2scl Sourceforge Project Page