Lemma is an Electromagnetics API
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

hankeltransformgaussianquadrature.cpp 41KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134
  1. /* This file is part of Lemma, a geophysical modelling and inversion API */
  2. /* This Source Code Form is subject to the terms of the Mozilla Public
  3. * License, v. 2.0. If a copy of the MPL was not distributed with this
  4. * file, You can obtain one at http://mozilla.org/MPL/2.0/. */
  5. /**
  6. @file
  7. @author Trevor Irons
  8. @date 01/02/2010
  9. @version $Id: hankeltransformgaussianquadrature.cpp 200 2014-12-29 21:11:55Z tirons $
  10. **/
  11. // Description: Port of Alan Chave's gaussian quadrature algorithm, which
  12. // is public domain, code listed in published article:
  13. // Chave, A. D., 1983, Numerical integration of related Hankel transforms by
  14. // quadrature and continued fraction expansion: Geophysics, 48
  15. // 1671--1686 doi: 10.1190/1.1441448
  16. #include "hankeltransformgaussianquadrature.h"
  17. namespace Lemma{
  18. std::ostream &operator<<(std::ostream &stream,
  19. const HankelTransformGaussianQuadrature &ob) {
  20. stream << *(HankelTransform*)(&ob);
  21. return stream;
  22. }
  23. // Initialise static members
  24. const VectorXr HankelTransformGaussianQuadrature::WT =
  25. (VectorXr(254) << // (WT(I),I=1,20)
  26. 0.55555555555555555556e+00,0.88888888888888888889e+00,
  27. 0.26848808986833344073e+00,0.10465622602646726519e+00,
  28. 0.40139741477596222291e+00,0.45091653865847414235e+00,
  29. 0.13441525524378422036e+00,0.51603282997079739697e-01,
  30. 0.20062852937698902103e+00,0.17001719629940260339e-01,
  31. 0.92927195315124537686e-01,0.17151190913639138079e+00,
  32. 0.21915685840158749640e+00,0.22551049979820668739e+00,
  33. 0.67207754295990703540e-01,0.25807598096176653565e-01,
  34. 0.10031427861179557877e+00,0.84345657393211062463e-02,
  35. 0.46462893261757986541e-01,0.85755920049990351154e-01,
  36. // (WT(I),I=21,40)
  37. 0.10957842105592463824e+00,0.25447807915618744154e-02,
  38. 0.16446049854387810934e-01,0.35957103307129322097e-01,
  39. 0.56979509494123357412e-01,0.76879620499003531043e-01,
  40. 0.93627109981264473617e-01,0.10566989358023480974e+00,
  41. 0.11195687302095345688e+00,0.11275525672076869161e+00,
  42. 0.33603877148207730542e-01,0.12903800100351265626e-01,
  43. 0.50157139305899537414e-01,0.42176304415588548391e-02,
  44. 0.23231446639910269443e-01,0.42877960025007734493e-01,
  45. 0.54789210527962865032e-01,0.12651565562300680114e-02,
  46. 0.82230079572359296693e-02,0.17978551568128270333e-01,
  47. // (WT(I),I=41,60)
  48. 0.28489754745833548613e-01,0.38439810249455532039e-01,
  49. 0.46813554990628012403e-01,0.52834946790116519862e-01,
  50. 0.55978436510476319408e-01,0.36322148184553065969e-03,
  51. 0.25790497946856882724e-02,0.61155068221172463397e-02,
  52. 0.10498246909621321898e-01,0.15406750466559497802e-01,
  53. 0.20594233915912711149e-01,0.25869679327214746911e-01,
  54. 0.31073551111687964880e-01,0.36064432780782572640e-01,
  55. 0.40715510116944318934e-01,0.44914531653632197414e-01,
  56. 0.48564330406673198716e-01,0.51583253952048458777e-01,
  57. 0.53905499335266063927e-01,0.55481404356559363988e-01,
  58. // (WT(I),I=61,80)
  59. 0.56277699831254301273e-01,0.56377628360384717388e-01,
  60. 0.16801938574103865271e-01,0.64519000501757369228e-02,
  61. 0.25078569652949768707e-01,0.21088152457266328793e-02,
  62. 0.11615723319955134727e-01,0.21438980012503867246e-01,
  63. 0.27394605263981432516e-01,0.63260731936263354422e-03,
  64. 0.41115039786546930472e-02,0.89892757840641357233e-02,
  65. 0.14244877372916774306e-01,0.19219905124727766019e-01,
  66. 0.23406777495314006201e-01,0.26417473395058259931e-01,
  67. 0.27989218255238159704e-01,0.18073956444538835782e-03,
  68. 0.12895240826104173921e-02,0.30577534101755311361e-02,
  69. // (WT(I),I=81,100)
  70. 0.52491234548088591251e-02,0.77033752332797418482e-02,
  71. 0.10297116957956355524e-01,0.12934839663607373455e-01,
  72. 0.15536775555843982440e-01,0.18032216390391286320e-01,
  73. 0.20357755058472159467e-01,0.22457265826816098707e-01,
  74. 0.24282165203336599358e-01,0.25791626976024229388e-01,
  75. 0.26952749667633031963e-01,0.27740702178279681994e-01,
  76. 0.28138849915627150636e-01,0.50536095207862517625e-04,
  77. 0.37774664632698466027e-03,0.93836984854238150079e-03,
  78. 0.16811428654214699063e-02,0.25687649437940203731e-02,
  79. 0.35728927835172996494e-02,0.46710503721143217474e-02,
  80. // (WT(I),I=101,120)
  81. 0.58434498758356395076e-02,0.70724899954335554680e-02,
  82. 0.83428387539681577056e-02,0.96411777297025366953e-02,
  83. 0.10955733387837901648e-01,0.12275830560082770087e-01,
  84. 0.13591571009765546790e-01,0.14893641664815182035e-01,
  85. 0.16173218729577719942e-01,0.17421930159464173747e-01,
  86. 0.18631848256138790186e-01,0.19795495048097499488e-01,
  87. 0.20905851445812023852e-01,0.21956366305317824939e-01,
  88. 0.22940964229387748761e-01,0.23854052106038540080e-01,
  89. 0.24690524744487676909e-01,0.25445769965464765813e-01,
  90. 0.26115673376706097680e-01,0.26696622927450359906e-01,
  91. // (WT(I),I=121,140)
  92. 0.27185513229624791819e-01,0.27579749566481873035e-01,
  93. 0.27877251476613701609e-01,0.28076455793817246607e-01,
  94. 0.28176319033016602131e-01,0.28188814180192358694e-01,
  95. 0.84009692870519326354e-02,0.32259500250878684614e-02,
  96. 0.12539284826474884353e-01,0.10544076228633167722e-02,
  97. 0.58078616599775673635e-02,0.10719490006251933623e-01,
  98. 0.13697302631990716258e-01,0.31630366082226447689e-03,
  99. 0.20557519893273465236e-02,0.44946378920320678616e-02,
  100. 0.71224386864583871532e-02,0.96099525623638830097e-02,
  101. 0.11703388747657003101e-01,0.13208736697529129966e-01,
  102. // (WT(I),I=141,160)
  103. 0.13994609127619079852e-01,0.90372734658751149261e-04,
  104. 0.64476204130572477933e-03,0.15288767050877655684e-02,
  105. 0.26245617274044295626e-02,0.38516876166398709241e-02,
  106. 0.51485584789781777618e-02,0.64674198318036867274e-02,
  107. 0.77683877779219912200e-02,0.90161081951956431600e-02,
  108. 0.10178877529236079733e-01,0.11228632913408049354e-01,
  109. 0.12141082601668299679e-01,0.12895813488012114694e-01,
  110. 0.13476374833816515982e-01,0.13870351089139840997e-01,
  111. 0.14069424957813575318e-01,0.25157870384280661489e-04,
  112. 0.18887326450650491366e-03,0.46918492424785040975e-03,
  113. // (WT(I),I=161,180)
  114. 0.84057143271072246365e-03,0.12843824718970101768e-02,
  115. 0.17864463917586498247e-02,0.23355251860571608737e-02,
  116. 0.29217249379178197538e-02,0.35362449977167777340e-02,
  117. 0.41714193769840788528e-02,0.48205888648512683476e-02,
  118. 0.54778666939189508240e-02,0.61379152800413850435e-02,
  119. 0.67957855048827733948e-02,0.74468208324075910174e-02,
  120. 0.80866093647888599710e-02,0.87109650797320868736e-02,
  121. 0.93159241280693950932e-02,0.98977475240487497440e-02,
  122. 0.10452925722906011926e-01,0.10978183152658912470e-01,
  123. 0.11470482114693874380e-01,0.11927026053019270040e-01,
  124. // (WT(I),I=181,200)
  125. 0.12345262372243838455e-01,0.12722884982732382906e-01,
  126. 0.13057836688353048840e-01,0.13348311463725179953e-01,
  127. 0.13592756614812395910e-01,0.13789874783240936517e-01,
  128. 0.13938625738306850804e-01,0.14038227896908623303e-01,
  129. 0.14088159516508301065e-01,0.69379364324108267170e-05,
  130. 0.53275293669780613125e-04,0.13575491094922871973e-03,
  131. 0.24921240048299729402e-03,0.38974528447328229322e-03,
  132. 0.55429531493037471492e-03,0.74028280424450333046e-03,
  133. 0.94536151685852538246e-03,0.11674841174299594077e-02,
  134. 0.14049079956551446427e-02,0.16561127281544526052e-02,
  135. // (WT(I),I=201,220)
  136. 0.19197129710138724125e-02,0.21944069253638388388e-02,
  137. 0.24789582266575679307e-02,0.27721957645934509940e-02,
  138. 0.30730184347025783234e-02,0.33803979910869203823e-02,
  139. 0.36933779170256508183e-02,0.40110687240750233989e-02,
  140. 0.43326409680929828545e-02,0.46573172997568547773e-02,
  141. 0.49843645647655386012e-02,0.53130866051870565663e-02,
  142. 0.56428181013844441585e-02,0.59729195655081658049e-02,
  143. 0.63027734490857587172e-02,0.66317812429018878941e-02,
  144. 0.69593614093904229394e-02,0.72849479805538070639e-02,
  145. 0.76079896657190565832e-02,0.79279493342948491103e-02,
  146. // (WT(I),I=221,240)
  147. 0.82443037630328680306e-02,0.85565435613076896192e-02,
  148. 0.88641732094824942641e-02,0.91667111635607884067e-02,
  149. 0.94636899938300652943e-02,0.97546565363174114611e-02,
  150. 0.10039172044056840798e-01,0.10316812330947621682e-01,
  151. 0.10587167904885197931e-01,0.10849844089337314099e-01,
  152. 0.11104461134006926537e-01,0.11350654315980596602e-01,
  153. 0.11588074033043952568e-01,0.11816385890830235763e-01,
  154. 0.12035270785279562630e-01,0.12244424981611985899e-01,
  155. 0.12443560190714035263e-01,0.12632403643542078765e-01,
  156. 0.12810698163877361967e-01,0.12978202239537399286e-01,
  157. // (WT(I),I=241,254)
  158. 0.13134690091960152836e-01,0.13279951743930530650e-01,
  159. 0.13413793085110098513e-01,0.13536035934956213614e-01,
  160. 0.13646518102571291428e-01,0.13745093443001896632e-01,
  161. 0.13831631909506428676e-01,0.13906019601325461264e-01,
  162. 0.13968158806516938516e-01,0.14017968039456608810e-01,
  163. 0.14055382072649964277e-01,0.14080351962553661325e-01,
  164. 0.14092845069160408355e-01,0.14094407090096179347e-01).finished();
  165. const VectorXr HankelTransformGaussianQuadrature::WA =
  166. (VectorXr(127) << // (WT(I),I=1,20)
  167. // (WA(I),I=1,20)
  168. 0.77459666924148337704e+00,0.96049126870802028342e+00,
  169. 0.43424374934680255800e+00,0.99383196321275502221e+00,
  170. 0.88845923287225699889e+00,0.62110294673722640294e+00,
  171. 0.22338668642896688163e+00,0.99909812496766759766e+00,
  172. 0.98153114955374010687e+00,0.92965485742974005667e+00,
  173. 0.83672593816886873550e+00,0.70249620649152707861e+00,
  174. 0.53131974364437562397e+00,0.33113539325797683309e+00,
  175. 0.11248894313318662575e+00,0.99987288812035761194e+00,
  176. 0.99720625937222195908e+00,0.98868475754742947994e+00,
  177. 0.97218287474858179658e+00,0.94634285837340290515e+00,
  178. // (WA(I),I=21,40)
  179. 0.91037115695700429250e+00,0.86390793819369047715e+00,
  180. 0.80694053195021761186e+00,0.73975604435269475868e+00,
  181. 0.66290966002478059546e+00,0.57719571005204581484e+00,
  182. 0.48361802694584102756e+00,0.38335932419873034692e+00,
  183. 0.27774982202182431507e+00,0.16823525155220746498e+00,
  184. 0.56344313046592789972e-01,0.99998243035489159858e+00,
  185. 0.99959879967191068325e+00,0.99831663531840739253e+00,
  186. 0.99572410469840718851e+00,0.99149572117810613240e+00,
  187. 0.98537149959852037111e+00,0.97714151463970571416e+00,
  188. 0.96663785155841656709e+00,0.95373000642576113641e+00,
  189. // (WA(I),I=41,60)
  190. 0.93832039777959288365e+00,0.92034002547001242073e+00,
  191. 0.89974489977694003664e+00,0.87651341448470526974e+00,
  192. 0.85064449476835027976e+00,0.82215625436498040737e+00,
  193. 0.79108493379984836143e+00,0.75748396638051363793e+00,
  194. 0.72142308537009891548e+00,0.68298743109107922809e+00,
  195. 0.64227664250975951377e+00,0.59940393024224289297e+00,
  196. 0.55449513263193254887e+00,0.50768775753371660215e+00,
  197. 0.45913001198983233287e+00,0.40897982122988867241e+00,
  198. 0.35740383783153215238e+00,0.30457644155671404334e+00,
  199. 0.25067873030348317661e+00,0.19589750271110015392e+00,
  200. // (WA(I),I=61,80)
  201. 0.14042423315256017459e+00,0.84454040083710883710e-01,
  202. 0.28184648949745694339e-01,0.99999759637974846462e+00,
  203. 0.99994399620705437576e+00,0.99976049092443204733e+00,
  204. 0.99938033802502358193e+00,0.99874561446809511470e+00,
  205. 0.99780535449595727456e+00,0.99651414591489027385e+00,
  206. 0.99483150280062100052e+00,0.99272134428278861533e+00,
  207. 0.99015137040077015918e+00,0.98709252795403406719e+00,
  208. 0.98351865757863272876e+00,0.97940628167086268381e+00,
  209. 0.97473445975240266776e+00,0.96948465950245923177e+00,
  210. 0.96364062156981213252e+00,0.95718821610986096274e+00,
  211. // (WA(I),I=81,100)
  212. 0.95011529752129487656e+00,0.94241156519108305981e+00,
  213. 0.93406843615772578800e+00,0.92507893290707565236e+00,
  214. 0.91543758715576504064e+00,0.90514035881326159519e+00,
  215. 0.89418456833555902286e+00,0.88256884024734190684e+00,
  216. 0.87029305554811390585e+00,0.85735831088623215653e+00,
  217. 0.84376688267270860104e+00,0.82952219463740140018e+00,
  218. 0.81462878765513741344e+00,0.79909229096084140180e+00,
  219. 0.78291939411828301639e+00,0.76611781930376009072e+00,
  220. 0.74869629361693660282e+00,0.73066452124218126133e+00,
  221. 0.71203315536225203459e+00,0.69281376977911470289e+00,
  222. // (WA(I),I=101,120)
  223. 0.67301883023041847920e+00,0.65266166541001749610e+00,
  224. 0.63175643771119423041e+00,0.61031811371518640016e+00,
  225. 0.58836243444766254143e+00,0.56590588542365442262e+00,
  226. 0.54296566649831149049e+00,0.51955966153745702199e+00,
  227. 0.49570640791876146017e+00,0.47142506587165887693e+00,
  228. 0.44673538766202847374e+00,0.42165768662616330006e+00,
  229. 0.39621280605761593918e+00,0.37042208795007823014e+00,
  230. 0.34430734159943802278e+00,0.31789081206847668318e+00,
  231. 0.29119514851824668196e+00,0.26424337241092676194e+00,
  232. 0.23705884558982972721e+00,0.20966523824318119477e+00,
  233. // (WA(I),I=121,127)
  234. 0.18208649675925219825e+00,0.15434681148137810869e+00,
  235. 0.12647058437230196685e+00,0.98482396598119202090e-01,
  236. 0.70406976042855179063e-01,0.42269164765363603212e-01,
  237. 0.14093886410782462614e-01).finished();
  238. /*
  239. const Real PI2 = 0.6366197723675813;
  240. const Real X01P = 0.4809651115391545e01;
  241. const Real XMAX = std::numeric_limits<Real>::max();
  242. const Real XSMALL = 0.9094947017729281e-12;
  243. const Real J0_X01 = 0.2404825557695772e01;
  244. const Real J0_X02 = 0.1043754397719454e-15;
  245. const Real J0_X11 = 0.5520078110286310e01;
  246. const Real J0_X12 = 0.8088597146146419e-16;
  247. const Real FUDGE = 6.071532166000000e-18;
  248. const Real FUDGEX = 1.734723476000000e-18;
  249. const Real TWOPI1 = 0.6283185005187988e01;
  250. const Real TWOPI2 = 0.3019915981956752e-06;
  251. const Real RTPI2 = 0.7978845608028652e0;
  252. const Real XMIN = std::numeric_limits<Real>::min();
  253. const Real J1_X01 = 0.3831705970207512e1;
  254. const Real J1_X02 = -0.5967810507509414e-15;
  255. const Real J1_X11 = 0.7015586669815619e1;
  256. const Real J1_X12 = -0.5382308663841630e-15;
  257. */
  258. // TODO don't hard code precision like this
  259. HankelTransformGaussianQuadrature::HankelTransformGaussianQuadrature(
  260. const std::string &name) : HankelTransform(name) {
  261. karg.resize(255, 100);
  262. kern.resize(510, 100);
  263. }
  264. /////////////////////////////////////////////////////////////
  265. HankelTransformGaussianQuadrature::~HankelTransformGaussianQuadrature() {
  266. if (this->NumberOfReferences != 0)
  267. throw DeleteObjectWithReferences( this );
  268. }
  269. /////////////////////////////////////////////////////////////
  270. HankelTransformGaussianQuadrature*
  271. HankelTransformGaussianQuadrature::New() {
  272. HankelTransformGaussianQuadrature* Obj = new
  273. HankelTransformGaussianQuadrature("HankelTransformGaussianQuadrature");
  274. Obj->AttachTo(Obj);
  275. return Obj;
  276. }
  277. /////////////////////////////////////////////////////////////
  278. void HankelTransformGaussianQuadrature::Delete() {
  279. this->DetachFrom(this);
  280. }
  281. void HankelTransformGaussianQuadrature::Release() {
  282. delete this;
  283. }
  284. /////////////////////////////////////////////////////////////
  285. Complex HankelTransformGaussianQuadrature::
  286. Zgauss(const int &ikk, const EMMODE &mode,
  287. const int &itype, const Real &rho, const Real &wavef,
  288. KernelEm1DBase *Kernel){
  289. // TI, TODO, change calls to Zgauss to reflect this, go and fix so we
  290. // dont subract 1 from this everywhere
  291. //Kernel->SetIk(ikk+1);
  292. //Kernel->SetMode(mode);
  293. //ik = ikk+1;
  294. //mode = imode;
  295. Real Besr(0);
  296. Real Besi(0);
  297. // Parameters
  298. int nl(1); // Lower limit for gauss order to start comp
  299. int nu(7); // upper limit for gauss order
  300. #ifdef LEMMA_SINGLE_PRECISION
  301. Real rerr = 1e-5; // Error, for double Kihand set to .1e-10, .1e-11
  302. Real aerr = 1e-6;
  303. #else // ----- not LEMMA_SINGLE_PRECISION -----
  304. Real rerr = 1e-11; // Error, for double Kihand set to .1e-10, .1e-11
  305. Real aerr = 1e-12;
  306. #endif // ----- not LEMMA_SINGLE_PRECISION -----
  307. int npcs(1);
  308. int inew(0);
  309. //const int NTERM = 100;
  310. //BESINT.karg.resize(255, NTERM);
  311. //BESINT.kern.resize(510, NTERM);
  312. //this->karg.setZero();
  313. //this->kern.setZero();
  314. Besautn(Besr, Besi, itype, nl, nu, rho, rerr, aerr, npcs, inew,
  315. wavef, Kernel);
  316. return Complex(Besr, Besi);
  317. }
  318. //////////////////////////////////////////////////////////////////
  319. void HankelTransformGaussianQuadrature::
  320. Besautn(Real &besr, Real &besi,
  321. const int &besselOrder,
  322. const int &lowerGaussLimit,
  323. const int &upperGaussLimit,
  324. const Real &rho,
  325. const Real &relativeError,
  326. const Real &absError,
  327. const int& numPieces,
  328. int &inew,
  329. const Real &aorb,
  330. KernelEm1DBase *Kernel) {
  331. HighestGaussOrder = 0;
  332. NumberPartialIntegrals = 0;
  333. NumberFunctionEvals = 0;
  334. inew = 0;
  335. if (lowerGaussLimit > upperGaussLimit) {
  336. besr = 0;
  337. besi = 0;
  338. throw LowerGaussLimitGreaterThanUpperGaussLimit();
  339. }
  340. int ncntrl = 0;
  341. int nw = std::max(inew, 1);
  342. // temps
  343. Real besr_1(0);
  344. Real besi_1(0);
  345. int ierr(0);
  346. int ierr1(0);
  347. int ierr2(0);
  348. VectorXi xsum(1);
  349. //xsum.setZero(); // TODO xsum doesn't do a god damn thing
  350. int nsum(0);
  351. // Check for Rtud
  352. Bestrn(besr_1, besi_1, besselOrder, lowerGaussLimit, rho,
  353. .1*relativeError, .1*absError,
  354. numPieces, xsum, nsum, nw, ierr, ncntrl, aorb, Kernel);
  355. if (ierr != 0 && lowerGaussLimit == 7) {
  356. HighestGaussOrder = lowerGaussLimit;
  357. return;
  358. } else {
  359. Real oldr = besr_1;
  360. Real oldi = besi_1;
  361. for (int n=lowerGaussLimit+1; n<=upperGaussLimit; ++n) {
  362. int nw2 = 2;
  363. Bestrn(besr_1, besi_1, besselOrder, n, rho, .1*relativeError,
  364. .1*absError, numPieces, xsum, nsum, nw2, ierr,
  365. ncntrl, aorb, Kernel);
  366. if (ierr != 0 && n==7) {
  367. besr_1 = oldr;
  368. besi_1 = oldi;
  369. HighestGaussOrder = n;
  370. std::cerr << "CONVERGENCE FAILED AT SMALL ARGUMNENT!\n";
  371. ierr1 = ierr + 10;
  372. break;
  373. } else if (std::abs(besr_1-oldr) <=
  374. relativeError*std::abs(besr_1)+absError &&
  375. std::abs(besi_1-oldi) <=
  376. relativeError*std::abs(besi_1)+absError) {
  377. HighestGaussOrder = n;
  378. break;
  379. } else {
  380. oldr = besr_1;
  381. oldi = besi_1;
  382. }
  383. }
  384. }
  385. inew = 0;
  386. ncntrl = 1;
  387. nw=std::max(inew, 1);
  388. Real besr_2, besi_2;
  389. //karg.setZero();
  390. //kern.setZero();
  391. HighestGaussOrder = 0;
  392. NumberPartialIntegrals = 0;
  393. NumberFunctionEvals = 0;
  394. Bestrn(besr_2, besi_2, besselOrder, lowerGaussLimit, rho,
  395. .1*relativeError, .1*absError,
  396. numPieces, xsum, nsum, nw, ierr, ncntrl, aorb, Kernel);
  397. if (ierr != 0 && lowerGaussLimit == 7) {
  398. HighestGaussOrder = lowerGaussLimit;
  399. return;
  400. } else {
  401. Real oldr = besr_2;
  402. Real oldi = besi_2;
  403. for (int n=lowerGaussLimit+1; n<=upperGaussLimit; ++n) {
  404. int nw2 = 2;
  405. Bestrn(besr_2, besi_2, besselOrder, n, rho, .1*relativeError,
  406. .1*absError, numPieces, xsum, nsum, nw2, ierr,
  407. ncntrl, aorb, Kernel);
  408. if (ierr != 0 && n==7) {
  409. besr_2 = oldr;
  410. besi_2 = oldi;
  411. HighestGaussOrder = n;
  412. std::cerr << "CONVERGENCE FAILED AT SMALL ARGUMNENT!\n";
  413. ierr2 = ierr + 20;
  414. break;
  415. } else if (std::abs(besr_2-oldr) <=
  416. relativeError*std::abs(besr_2)+absError &&
  417. std::abs(besi_2-oldi) <=
  418. relativeError*std::abs(besi_2)+absError) {
  419. HighestGaussOrder = n;
  420. break;
  421. } else {
  422. oldr = besr_2;
  423. oldi = besi_2;
  424. }
  425. }
  426. }
  427. besr = besr_1 + besr_2;
  428. besi = besi_1 + besi_2;
  429. ierr = ierr1 + ierr2;
  430. return;
  431. }
  432. /////////////////////////////////////////////////////////////
  433. void HankelTransformGaussianQuadrature::
  434. Bestrn(Real &BESR, Real &BESI, const int &IORDER,
  435. const int &NG, const Real &rho,
  436. const Real &RERR, const Real &AERR, const int &NPCS,
  437. VectorXi &XSUM, int &NSUM, int &NEW,
  438. int &IERR, int &NCNTRL, const Real &AORB, KernelEm1DBase *Kernel) {
  439. Xr.setZero();
  440. Xi.setZero();
  441. Dr.setZero();
  442. Di.setZero();
  443. Sr.setZero();
  444. Si.setZero();
  445. Cfcor.setZero();
  446. Cfcoi.setZero();
  447. Dr.setZero();
  448. Di.setZero();
  449. Dr(0) = (Real)(-1);
  450. const int NTERM = 100;
  451. const int NSTOP = 100;
  452. int NPO;
  453. //std::cout << "Bestrn NEW " << NEW << std::endl;
  454. if (NEW == 2) {
  455. NPO = nps;
  456. } else {
  457. Nk.setZero();
  458. nps = 0;
  459. NPO=NTERM;
  460. }
  461. // Trivial?
  462. if (IORDER != 0 && rho == 0) {
  463. BESR = 0;
  464. BESI = 0;
  465. IERR = 0;
  466. return;
  467. }
  468. NumberPartialIntegrals=0;
  469. int NW = NEW;
  470. np = 0; // TI, zero based indexing
  471. int NPB = 1; // 0?
  472. int L = 0; // TODO, should be 0?
  473. Real B = 0.;
  474. Real A = 0.;
  475. Real SUMR = 0.;
  476. Real SUMI = 0.;
  477. Real XSUMR = 0.;
  478. Real XSUMI = 0.;
  479. Real TERMR(0), TERMI(0);
  480. // COMPUTE BESSEL TRANSFORM EXPLICITLY ON (0,XSUM(NSUM))
  481. if (NSUM > 0) {
  482. std::cerr << "NSUM GREATER THAN ZERO UNTESTED" << std::endl;
  483. Real LASTR=0.0;
  484. Real LASTI=0.0;
  485. for (int N=1; N<=NSUM; ++N) {
  486. if (NW == 2 && np > NPO) NW=1;
  487. if (np > NTERM) NW=0;
  488. A=B;
  489. B=XSUM(N);
  490. Besqud(A, B, TERMR, TERMI, NG, NW, IORDER, rho, Kernel);
  491. XSUMR += TERMR;
  492. XSUMI += TERMI;
  493. if ( (std::abs(XSUMR-LASTR) <= RERR*std::abs(XSUMR)+AERR) &&
  494. (std::abs(XSUMI-LASTI) <= RERR*std::abs(XSUMI)+AERR)) {
  495. BESR=XSUMR;
  496. BESI=XSUMI;
  497. IERR=0;
  498. nps = std::max(np, nps);
  499. return;
  500. } else {
  501. ++np;
  502. LASTR=XSUMR;
  503. LASTI=XSUMI;
  504. }
  505. }
  506. while (ZeroJ(NPB,IORDER) > XSUM(NSUM*rho)) {
  507. ++NPB;
  508. }
  509. }
  510. // ENTRY POINT FOR PADE SUMMATION OF PARTIAL INTEGRANDS
  511. Real LASTR=0.e0;
  512. Real LASTI=0.e0;
  513. if (NCNTRL == 0) {
  514. A = 0.;
  515. B = ZeroJ(NPB,IORDER) / rho;
  516. if (B > AORB) {
  517. B = AORB;
  518. }
  519. } else {
  520. A = AORB;
  521. B = ZeroJ(NPB,IORDER)/rho;
  522. while (B <= A) {
  523. ++NPB;
  524. B = ZeroJ(NPB,IORDER)/rho;
  525. }
  526. }
  527. // CALCULATE TERMS AND SUM WITH PADECF, QUITTING WHEN CONVERGENCE IS
  528. // OBTAINED
  529. if (NCNTRL != 0) {
  530. for (int N=1; N<=NSTOP; ++N) {
  531. if (NPCS == 1) {
  532. if ((NW==2) && (np > NPO)) {
  533. NW=1;
  534. }
  535. if (np > NTERM) {
  536. NW=0;
  537. }
  538. Besqud(A,B,TERMR,TERMI,NG,NW,IORDER,rho,Kernel);
  539. ++np;
  540. } else {
  541. std::cout << "In the else conditional\n";
  542. TERMR=0.;
  543. TERMI=0.;
  544. Real XINC=(B-A)/NPCS;
  545. Real AA=A;
  546. Real BB=A+XINC;
  547. for (int I=1; I<=NPCS; ++I) {
  548. if ((NW == 2) && (np > NPO)) NW=1;
  549. if (np > NTERM) NW=0;
  550. Real TR, TI;
  551. Besqud(AA, BB, TR, TI, NG, NW, IORDER, rho, Kernel);
  552. TERMR+=TR;
  553. TERMI+=TI;
  554. AA=BB;
  555. BB=BB+XINC;
  556. ++np;
  557. }
  558. }
  559. ++NumberPartialIntegrals;
  560. Sr(L) = TERMR;
  561. Si(L) = TERMI;
  562. Padecf(SUMR,SUMI,L);
  563. if ((std::abs(SUMR-LASTR) <= RERR*std::abs(SUMR)+AERR) &&
  564. (std::abs(SUMI-LASTI) <= RERR*std::abs(SUMI)+AERR)) {
  565. BESR=XSUMR+SUMR;
  566. BESI=XSUMI+SUMI;
  567. IERR=0;
  568. nps = std::max(np-1, nps);
  569. return;
  570. } else {
  571. LASTR=SUMR;
  572. LASTI=SUMI;
  573. ++NPB;
  574. A=B;
  575. B=ZeroJ(NPB,IORDER)/rho;
  576. ++L;
  577. }
  578. }
  579. BESR=XSUMR+SUMR;
  580. BESI=XSUMI+SUMI;
  581. IERR=1;
  582. nps = std::max(np, nps);
  583. return;
  584. }
  585. // GUSSIAN QUADRATURE ONLY IN THE INTERVAL IN WHICH K_0 IS LESS THAN
  586. // LAMBDA
  587. //std::cout << "NCNTRL " << NCNTRL << " NPCS " << NPCS << std::endl;
  588. for (int N=1; N<=NSTOP; ++N) {
  589. //std::cout << "NSTOP" << NSTOP << std::endl;
  590. if (NPCS == 1) {
  591. if ((NW==2) && (np > NPO)) {
  592. NW=1;
  593. }
  594. if (np > NTERM) {
  595. NW=0;
  596. }
  597. // Problem here, A not getting initialised
  598. //std::cout << "A " << A << " B " << B << std::endl;
  599. Besqud(A, B, TERMR, TERMI, NG, NW, IORDER, rho, Kernel);
  600. ++np;
  601. } else {
  602. TERMR=0.;
  603. TERMI=0.;
  604. Real XINC=(B-A)/NPCS;
  605. Real AA=A;
  606. Real BB=A+XINC;
  607. Real TR(0), TI(0);
  608. for (int I=1; I<NPCS; ++I) {
  609. if ((NW == 2) && (np > NPO)) {
  610. NW=1;
  611. }
  612. if (np > NTERM) {
  613. NW=0;
  614. }
  615. //std::cout << "AA " << AA << " BB " << BB << std::endl;
  616. Besqud(AA, BB, TR, TI, NG, NW, IORDER, rho, Kernel);
  617. TERMR+=TR;
  618. TERMI+=TI;
  619. AA=BB;
  620. BB=BB+XINC;
  621. ++np;
  622. }
  623. }
  624. if (B >= AORB) {
  625. BESR=XSUMR+TERMR;
  626. BESI=XSUMI+TERMI;
  627. IERR=0;
  628. nps = std::max(np, nps); // TI np is zero based
  629. return;
  630. } else {
  631. XSUMR = XSUMR + TERMR;
  632. XSUMI = XSUMI + TERMI;
  633. ++NPB;
  634. A = B;
  635. B = ZeroJ(NPB,IORDER)/rho;
  636. if (B >= AORB) B = AORB;
  637. }
  638. }
  639. return;
  640. }
  641. /////////////////////////////////////////////////////////////
  642. void HankelTransformGaussianQuadrature::
  643. Besqud(const Real &LowerLimit, const Real &UpperLimit,
  644. Real &Besr, Real &Besi, const int &npoints,
  645. const int &NEW,
  646. const int &besselOrder, const Real &rho,
  647. KernelEm1DBase* Kernel) {
  648. const int NTERM = 100;
  649. // Filter Weights
  650. Eigen::Matrix<int , 7, 1> NWA;
  651. Eigen::Matrix<int , 7, 1> NWT;
  652. Eigen::Matrix<Real, 254, 1> FUNCT;
  653. Eigen::Matrix<Real, 64, 1> FR1;
  654. Eigen::Matrix<Real, 64, 1> FI1;
  655. Eigen::Matrix<Real, 64, 1> FR2;
  656. Eigen::Matrix<Real, 64, 1> FI2;
  657. Eigen::Matrix<Real, 64, 1> BES1;
  658. Eigen::Matrix<Real, 64, 1> BES2;
  659. // Init Vals
  660. NWT << 1, 3, 7, 15, 31, 63, 127;
  661. NWA << 1, 2, 4, 8, 16, 32, 64;
  662. // CHECK FOR TRIVIAL CASE
  663. if (LowerLimit >= UpperLimit) {
  664. Besr = 0.;
  665. Besi = 0.;
  666. //std::cout << "Lower limit > Upper limit " << NEW << std::endl;
  667. //std::cout << "Lower limit " << LowerLimit << "Upper Limit " << UpperLimit <<std::endl;
  668. return;
  669. }
  670. // Temp vars for function generation
  671. Real diff(0);
  672. Real FZEROR(0);
  673. Real FZEROI(0);
  674. Real SUM(0);
  675. int KN(0);
  676. int LA(0);
  677. int LK(0);
  678. int N(0);
  679. int K;
  680. int NW;
  681. Real ACUMR;
  682. Real ACUMI;
  683. Real BESF;
  684. switch (NEW) {
  685. // CONSTRUCT FUNCT FROM SAVED KERNELS
  686. case (2):
  687. diff = (UpperLimit-LowerLimit)/2.;
  688. FZEROR = kern(0, np);
  689. FZEROI = kern(1, np);
  690. K = std::min(Nk(np)-1, npoints-1);
  691. NW=NWT(K);
  692. LK=2;
  693. for (N=0; N<2*NW; N+=2) {
  694. FUNCT(N) = kern(LK , np) +
  695. kern(LK+2, np) ;
  696. FUNCT(N+1) = kern(LK+1, np) +
  697. kern(LK+3, np) ;
  698. LK=LK+4;
  699. }
  700. if (Nk(np) >= npoints) {
  701. ACUMR = _dot(NW, WT.tail(255-NW), 1, FUNCT, 2);
  702. ACUMI = _dot(NW, WT.tail(255-NW), 1, FUNCT.tail<253>(), 2);
  703. Besr = (ACUMR+WT(2*NW)*FZEROR)*diff;
  704. Besi = (ACUMI+WT(2*NW)*FZEROI)*diff;
  705. return;
  706. } else {
  707. // COMPUTE ADDITIONAL ORDERS BEFORE TAKING DOT PRODUCT
  708. SUM= (UpperLimit+LowerLimit)/2.;
  709. KN = K +1;
  710. LA = LK/2;
  711. }
  712. break;
  713. default:
  714. // SCALE FACTORS
  715. SUM = (UpperLimit+LowerLimit) / 2.;
  716. diff = (UpperLimit-LowerLimit) / 2.;
  717. // ONE POINT GAUSS
  718. //Kernel(SUM,FZEROR,FZEROI,TEM,GEOM,PARA);
  719. Complex tba = Kernel->BesselArg(SUM);
  720. //cout.precision(16);
  721. //std::cout << "SUM " << "\t" << SUM << "\t" << tba << "\n";
  722. ++NumberFunctionEvals;
  723. BESF = Jbess(SUM*rho,besselOrder);
  724. FZEROR = BESF*std::real(tba);//FZEROR;
  725. FZEROI = BESF*std::imag(tba);//FZEROI;
  726. if (NEW == 1) {
  727. karg(0, np) = SUM;
  728. kern(0, np) = FZEROR;
  729. kern(1, np) = FZEROI;
  730. LA=1;
  731. LK=2;
  732. }
  733. N = 0; // TI was 1, 0 based index
  734. KN = 0;
  735. } // End of new switch
  736. // STEP THROUGH GAUSS ORDERS (NG = Number Gauss)
  737. for (int K=KN; K<npoints; ++K) {
  738. // COMPUTE NEW FUNCTION VALUES
  739. int NA = NWA(K) - 1; // NWA assumes 1 based indexing
  740. //std::cout << "Besqud NA=" << NA << std::endl;
  741. for (int J=0; J<NWA(K); ++J) {
  742. Real X = WA(NA)*diff;
  743. Real SUMP = SUM+X;
  744. Real SUMM = SUM-X;
  745. ++NA;
  746. //std::cout << "Calling from here\n";
  747. //Kernel(SUMP, FR1(J), FI1(J), TEM, GEOM, PARA);
  748. //Kernel(SUMM, FR2(J), FI2(J), TEM, GEOM, PARA);
  749. Complex bes1 = Kernel->BesselArg(SUMP);
  750. //std::cout << "SUMP" << "\t" << SUMP << "\t" << bes1 << "\n";
  751. Complex bes2 = Kernel->BesselArg(SUMM);
  752. //std::cout << "SUMM" << "\t" << SUMM << "\t" << bes1 << "\n";
  753. FR1(J) = std::real(bes1);
  754. FI1(J) = std::imag(bes1);
  755. FR2(J) = std::real(bes2);
  756. FI2(J) = std::imag(bes2);
  757. NumberFunctionEvals +=2;
  758. BES1(J)=Jbess(SUMP*rho, besselOrder);
  759. BES2(J)=Jbess(SUMM*rho, besselOrder);
  760. if (NEW >= 1) {
  761. karg(LA , np) = SUMP;
  762. karg(LA+1, np) = SUMM;
  763. LA += 2;
  764. }
  765. }
  766. // COMPUTE PRODUCTS OF KERNELS AND BESSEL FUNCTIONS
  767. // TODO vectorize
  768. for (int J=0; J<NWA(K); ++J) {
  769. FR1(J ) = BES1(J)*FR1(J);
  770. FI1(J ) = BES1(J)*FI1(J);
  771. FR2(J ) = BES2(J)*FR2(J);
  772. FI2(J ) = BES2(J)*FI2(J);
  773. FUNCT(N ) = FR1(J)+FR2(J);
  774. FUNCT(N+1) = FI1(J)+FI2(J);
  775. N+=2;
  776. }
  777. if (NEW >= 1) {
  778. for (int J=0; J<NWA(K); ++J) {
  779. kern(LK , np) = FR1(J);
  780. kern(LK+1, np) = FI1(J);
  781. kern(LK+2, np) = FR2(J);
  782. kern(LK+3, np) = FI2(J);
  783. LK=LK+4;
  784. }
  785. }
  786. }
  787. // COMPUTE DOT PRODUCT OF WEIGHTS WITH INTEGRAND VALUES
  788. NW=NWT(npoints-1);
  789. ACUMR = _dot(NW, WT.tail(255-NW), 1, FUNCT , 2);
  790. ACUMI = _dot(NW, WT.tail(255-NW), 1, FUNCT.tail<253>(), 2);
  791. Besr = (ACUMR+WT(2*NW-1)*FZEROR)*diff;
  792. Besi = (ACUMI+WT(2*NW-1)*FZEROI)*diff;
  793. if (np <= NTERM) Nk(np) = npoints;
  794. return;
  795. }
  796. /////////////////////////////////////////////////////////////
  797. void HankelTransformGaussianQuadrature::
  798. Padecf(Real &SUMR, Real &SUMI, const int &N) {
  799. if (N < 2) {
  800. // INITIALIZE FOR RECURSIVE CALCULATIONS
  801. //if (N == 0) {
  802. // Xr.setZero();
  803. // Xi.setZero();
  804. //Xr = Eigen::Matrix<Real, Eigen::Dynamic, 1>::Zero(100);
  805. //Xi = Eigen::Matrix<Real, Eigen::Dynamic, 1>::Zero(100);
  806. //}
  807. Dr(N) = Sr(N);
  808. Di(N) = Si(N);
  809. Real DENOM;
  810. switch (N) {
  811. case 0:
  812. DENOM = 1;
  813. Cfcor(N) = -(-1.*Dr(N)) / DENOM;
  814. Cfcoi(N) = -(-1.*Di(N)) / DENOM;
  815. break;
  816. default:
  817. DENOM = Dr(N-1)*Dr(N-1) +
  818. Di(N-1)*Di(N-1);
  819. Cfcor(N) = -(Dr(N-1)*Dr(N) +
  820. Di(N-1)*Di(N) ) / DENOM;
  821. Cfcoi(N) = -(Dr(N-1)*Di(N ) -
  822. Dr(N )*Di(N-1) ) / DENOM;
  823. }
  824. CF(SUMR, SUMI, Cfcor, Cfcoi, N);
  825. return;
  826. } else {
  827. int L = 2*(int)((N)/2) - 1;//+1;// - 1; // - 1; // - 1;
  828. // UPDATE X VECTORS FOR RECURSIVE CALCULATION OF CF COEFFICIENTS
  829. for (int K = L; K >= 3; K-= 2) {
  830. Xr(K) = Xr(K-1)+Cfcor(N-1)*Xr(K-2) -
  831. Cfcoi(N-1)*Xi(K-2);
  832. Xi(K) = Xi(K-1)+Cfcor(N-1)*Xi(K-2) +
  833. Cfcoi(N-1)*Xr(K-2);
  834. }
  835. Xr(1) = Xr(0)+Cfcor(N-1);
  836. Xi(1) = Xi(0)+Cfcoi(N-1);
  837. // INTERCHANGE ODD AND EVEN PARTS
  838. for (int K=0; K<L; K+=2) {
  839. Real T1 = Xr(K);
  840. Real T2 = Xi(K);
  841. Xr(K) = Xr(K+1);
  842. Xi(K) = Xi(K+1);
  843. Xr(K+1) = T1;
  844. Xi(K+1) = T2;
  845. }
  846. // COMPUTE FIRST COEFFICIENTS
  847. Dr(N) = Sr(N);
  848. Di(N) = Si(N);
  849. // Dr getting fucked up here
  850. for (int K=0; K<std::max(1, L/2+1); ++K) {
  851. Dr(N) += Sr(N-K-1)*Xr(2*K) -
  852. Si(N-K-1)*Xi(2*K);
  853. Di(N) += Si(N-K-1)*Xr(2*K) +
  854. Sr(N-K-1)*Xi(2*K);
  855. }
  856. // COMPUTE NEW CF COEFFICIENT
  857. Real DENOM = Dr(N-1)*Dr(N-1) +
  858. Di(N-1)*Di(N-1);
  859. //std::cout << "DENOM " << DENOM << std::endl;
  860. Cfcor(N)=-(Dr(N )*Dr(N-1) +
  861. Di(N)*Di(N-1))/DENOM;
  862. Cfcoi(N)=-(Dr(N-1)*Di(N ) -
  863. Dr(N)*Di(N-1))/DENOM;
  864. // EVALUATE CONTINUED FRACTION
  865. CF(SUMR,SUMI,Cfcor,Cfcoi,N);
  866. return;
  867. }
  868. }
  869. /////////////////////////////////////////////////////////////
  870. void HankelTransformGaussianQuadrature::CF(Real& RESR, Real &RESI,
  871. Eigen::Matrix<Real, 100, 1> &CFCOR,
  872. Eigen::Matrix<Real, 100, 1> &CFCOI,
  873. const int &N) {
  874. ////////////////////////////////////////////////
  875. // ONE Seems sort of stupid, maybe use ? instead
  876. // TODO benchmark difference
  877. //RESR = ONE(N)+CFCOR(N);
  878. RESR = (!N ? 0:1) + CFCOR(N);
  879. RESI = CFCOI(N);
  880. for (int K=N-1; K>=0; --K) {
  881. Real DENOM=RESR*RESR + RESI*RESI;
  882. Real RESRO=RESR;
  883. //RESR=ONE(K)+(RESR*CFCOR(K)+RESI*CFCOI(K))/DENOM;
  884. RESR = (!K ? 0:1) + (RESR*CFCOR(K)+RESI*CFCOI(K))/DENOM;
  885. RESI=(RESRO*CFCOI(K)-RESI*CFCOR(K))/DENOM;
  886. }
  887. return;
  888. }
  889. /////////////////////////////////////////////////////////////
  890. Real HankelTransformGaussianQuadrature::
  891. ZeroJ(const int &nzero, const int &besselOrder) {
  892. Real ZT1 = -1.e0/8.e0;
  893. Real ZT2 = 124.e0/1536.e0;
  894. Real ZT3 = -120928.e0/491520.e0;
  895. Real ZT4 = 401743168.e0/220200960.e0;
  896. Real OT1 = 3.e0/8.e0;
  897. Real OT2 = -36.e0/1536.e0;
  898. Real OT3 = 113184.e0/491520.e0;
  899. Real OT4 = -1951209.e0/220200960.e0;
  900. Real BETA(0);
  901. switch (besselOrder) {
  902. case 0:
  903. BETA=(nzero-.25e0)*PI;
  904. return BETA-ZT1/BETA-ZT2/std::pow(BETA,3) -
  905. ZT3/std::pow(BETA,5)-ZT4/std::pow(BETA,7);
  906. case 1:
  907. BETA=(nzero+.25e0)*PI;
  908. return BETA-OT1/BETA-OT2/std::pow(BETA,3) -
  909. OT3/std::pow(BETA,5)-OT4/std::pow(BETA,7);
  910. default:
  911. throw 77;
  912. }
  913. return 0.;
  914. }
  915. /////////////////////////////////////////////////////////////
  916. // Dot product allowing non 1 based incrementing
  917. Real HankelTransformGaussianQuadrature::_dot(const int&n,
  918. const Eigen::Matrix<Real, Eigen::Dynamic, Eigen::Dynamic> &X1,
  919. const int &inc1,
  920. const Eigen::Matrix<Real, Eigen::Dynamic, Eigen::Dynamic> &X2,
  921. const int &inc2) {
  922. int k;
  923. if (inc2 > 0) {
  924. k=0;
  925. } else {
  926. k = n*std::abs(inc2);
  927. }
  928. Real dot=0.0;
  929. if (inc1 > 0) {
  930. for (int i=0; i<n; i += inc1) {
  931. dot += X1(i)*X2(k);
  932. k += inc2;
  933. }
  934. } else {
  935. for (int i=n-1; i>=0; i += inc1) {
  936. dot += X1(i)*X2(k);
  937. k += inc2;
  938. }
  939. }
  940. return dot;
  941. }
  942. /////////////////////////////////////////////////////////////
  943. //
  944. Real HankelTransformGaussianQuadrature::Jbess(const Real &x, const int &IORDER) {
  945. #ifdef HAVEBOOSTCYLBESSEL
  946. switch (IORDER) {
  947. case 0:
  948. //return boost::math::detail::bessel_j0(X);
  949. return boost::math::cyl_bessel_j(0, x);
  950. break;
  951. case 1:
  952. //return boost::math::detail::bessel_j1(x);
  953. return boost::math::cyl_bessel_j(1, x);
  954. break;
  955. default:
  956. throw 77;
  957. }
  958. #else
  959. std::cerr << "Chave Hankel transform requires boost, which Lemma was bot built with\n";
  960. return 0.;
  961. #endif
  962. }
  963. //////////////////////////////////////////////////////
  964. // Exception classes
  965. LowerGaussLimitGreaterThanUpperGaussLimit::
  966. LowerGaussLimitGreaterThanUpperGaussLimit() :
  967. runtime_error("LOWER GAUSS LIMIT > UPPER GAUSS LIMIT") {}
  968. } // ----- end of Lemma name -----