Main Lemma Repository
Você não pode selecionar mais de 25 tópicos Os tópicos devem começar com uma letra ou um número, podem incluir traços ('-') e podem ter até 35 caracteres.

GQChave.h 14KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351
  1. /* This Source Code Form is subject to the terms of the Mozilla Public
  2. * License, v. 2.0. If a copy of the MPL was not distributed with this
  3. * file, You can obtain one at http://mozilla.org/MPL/2.0/. */
  4. /**
  5. @file
  6. @author Trevor Irons
  7. @date 01/02/2010
  8. @version $Id: hankeltransformgaussianquadrature.h 199 2014-12-29 19:25:20Z tirons $
  9. **/
  10. #ifndef _HANKELTRANSFORMGAUSSIANQUADRATURE_h_INC
  11. #define _HANKELTRANSFORMGAUSSIANQUADRATURE_h_INC
  12. #include "HankelTransform.h"
  13. #include "KernelEM1DBase.h"
  14. #ifdef HAVE_BOOST_SPECIAL_FUNCTIONS
  15. #include "boost/math/special_functions.hpp"
  16. #endif
  17. namespace Lemma {
  18. // =======================================================================
  19. // Class: GQChave
  20. /// \brief Calculates hankel transform using gaussian quadrature.
  21. /// \details Accurate but slow, this is a port of Alan Chave's public domain
  22. /// fortran code
  23. // =======================================================================
  24. class GQChave : public HankelTransform {
  25. friend std::ostream &operator<<(std::ostream &stream, const GQChave &ob);
  26. public:
  27. // ==================== LIFECYCLE ===========================
  28. /// Default locked constructor.
  29. GQChave ( const ctor_key& );
  30. /** DeSerializing locked constructor, use DeSerialize */
  31. GQChave ( const YAML::Node& node, const ctor_key& );
  32. /// Default destructor
  33. ~GQChave ();
  34. /**
  35. * Returns shared_ptr to new GQChave.
  36. * Location is
  37. * initialized to (0,0,0) type and polarization are
  38. * initialized to nonworking values that will throw
  39. * exceptions if used.
  40. */
  41. static std::shared_ptr<GQChave> NewSP();
  42. /** YAML Serializing method
  43. */
  44. YAML::Node Serialize() const;
  45. /**
  46. * Constructs an object from a YAML::Node.
  47. */
  48. static std::shared_ptr< GQChave > DeSerialize(const YAML::Node& node);
  49. // ==================== OPERATORS ===========================
  50. // ==================== OPERATIONS ===========================
  51. /// Performs numerical integration using Gaussian quadrature
  52. /// ikk: type of kernel depending on source and receiver couple
  53. /// imode: a switch for TE(0) and TM(1) mode
  54. /// itype: order of Bessel function
  55. /// rho is argument to integral
  56. /// wavef is the propogation constant of free space
  57. /// = omega * sqrt( EP*AMU ) amu = 4 pi e-7 ep = 8.85e-12
  58. //template <EMMODE T>
  59. Complex Zgauss(const int &ikk, const EMMODE &imode,
  60. const int &itype, const Real &rho,
  61. const Real &wavef, KernelEM1DBase* Kernel);
  62. // ==================== ACCESS ============================
  63. // ==================== INQUIRY ============================
  64. /** Returns the name of the underlying class, similiar to Python's type */
  65. virtual inline std::string GetName() const ;
  66. // ==================== DATA MEMBERS ============================
  67. protected:
  68. // ==================== OPERATIONS ============================
  69. /// Modified by Yoonho Song to branch cut, June, 1996
  70. /// Separate Gaussian quarature integral by two interval
  71. /// first: integal from 0 to wavenumber of free space
  72. /// second: integral from wavenunmber of free space to infinity
  73. /// for large arguments, it uses continued fraction also
  74. /// It is recommended to use nl = 1 to 6, nu =7
  75. /// PERFORMS AUTOMATIC CALCULATION OF BESSEL TRANSFORM TO SPECIFIED
  76. /// RELATIVE AND ABSOLUTE ERROR
  77. ///
  78. /// ARGUMENT LIST:
  79. ///
  80. /// BESR,BESI-REAL AND IMAGINARY PARTS RETURNED BY BESAUX
  81. /// iorder-ORDER OF THE BESSEL FUNCTION
  82. /// NL-LOWER LIMIT FOR GAUSS ORDER TO START COMPUTATION
  83. /// NU-UPPER LIMIT FOR GAUSS ORDER
  84. /// NU,NL=1,...7 SELECTS 3,7,15,31,63,127,AND 255 POINT GAUSS
  85. /// QUADRATURE BETWEEN THE ZERO CROSSINGS OF THE BESSEL FUNCTION
  86. /// R-ARGUMENT OF THE BESSEL FUNCTION
  87. /// RERR,AERR-RELATIVE AND ABSOLUTE ERROR FOR TERMINATION
  88. /// BESAUX TERMINATES WHEN INCREASING THE GAUSS ORDER DOES NOT
  89. /// CHANGE THE RESULT BY MORE THAN RERR OR WHEN THE ABSOLUTE ERROR
  90. /// IS LESS THAN AERR OR WHEN A GAUSS ORDER OF NU IS REACHED.
  91. /// NPCS-NUMBER OF PIECES INTO WHICH EACH PARTIAL INTEGRAND
  92. /// IS DIVIDED,
  93. /// ORDINARILY SET TO ONE. FOR VERY SMALL VALUES OF R WHERE
  94. /// THE KERNEL FUNCTION IS APPRECIABLE ONLY OVER THE FIRST FEW
  95. /// LOOPS OF THE BESSEL FUNCTION, NPCS MAY BE INCREASED TO ACHIEVE
  96. /// REASONABLE ACCURACY.
  97. /// NEW IF NEW=1, THE INTEGRANDS ARE COMPUTED AND SAVED AT EACH
  98. /// GAUSS
  99. /// ORDER. IF NEW=2, PREVIOUSLY COMPUTED INTEGRANDS ARE USED. NOTE
  100. /// THAT ORDER,R, AND NPCS MUST NOT BE CHANGED WHEN SETTING NEW=2.
  101. /// IERR-ERROR PARAMETER
  102. /// IERR=0--NORMAL RETURN
  103. /// IERR=1--RESULT NOT ACCURATE TO RERR DUE TO TOO LOW A GAUSS
  104. /// ORDER OR CONVERGENCE NOT ACHIEVED IN BESTRX
  105. //template <EMMODE T>
  106. void Besautn(Real &besr, Real &besi, const int &iorder,
  107. const int &nl, const int &nu, const Real &rho,
  108. const Real &rerr, const Real &aerr,
  109. const int &npcs, int &inew, const Real &aorb,
  110. KernelEM1DBase* Kernel);
  111. /// COMPUTES BESSEL TRANSFORM OF SPECIFIED ORDER DEFINED AS
  112. /// INTEGRAL(FUNCT(X)*J-SUB-ORDER(X*R)*DX) FROM X=0 TO INFINITY
  113. /// COMPUTATION IS ACHIEVED BY INTEGRATION BETWEEN THE ASYMPTOTIC
  114. /// ZERO CROSSINGS OF THE BESSEL FUNCTION USING GAUSS QUADRATURE.
  115. /// THE RESULTING SERIES OF PARTIAL INTEGRANDS IS SUMMED BY
  116. /// CALCULATING THE PADE APPROXIMANTS TO SPEED UP CONVERGENCE.
  117. /// ARGUMENT LIST:
  118. /// BESR,BESI REAL AND IMAGINARY PARTS RETURNED BY BESTRN
  119. /// iorder ORDER OF THE BESSEL FUNCTIONC NG NUMBER OF GAUSS
  120. /// POINTS TO USE IN THE QUADRATURE ROUTINE.
  121. /// NG=1 THROUGH 7 SELECTS 3,7,15,31,63,126,AND 255 TERMS.
  122. /// R ARGUMENT OF THE BESSEL FUNCTION
  123. /// RERR,AERR SPECIFIED RELATIVE AND ABSOLUTE ERROR FOR THE
  124. /// CALCULATION. THE INTEGRATION
  125. /// TERMINATES WHEN AN ADDITIONAL TERM DOES NOT CHANGE THE
  126. /// RESULT BY MORE THAN RERR*RESULT+AERR
  127. /// NPCS NUMBER OF PIECES INTO WHICH EACH PARTIAL I
  128. /// NTEGRAND IS DIVIDED,
  129. /// ORDINARILY SET TO ONE. FOR VERY SMALL VALUES OF RANGE
  130. /// WHERE THE KERNEL FUNCTION IS APPRECIABLE ONLY OVER THE
  131. /// FIRST FEW LOOPS OF THE BESSEL FUNCTION, NPCS MAY BE
  132. /// INCREASED TO ACHIEVE REASONABLE ACCURACY. NOTE THAT
  133. /// NPCS AFFECTS ONLY THE PADE
  134. /// SUM PORTION OF THE INTEGRATION, OVER X(NSUM) TO INFINITY.
  135. /// XSUM VECTOR OF VALUES OF THE KERNEL ARGUMENT OF FUNCT FOR WHICH
  136. /// EXPLICIT CALCULATION OF THE INTEGRAL IS DESIRED, SO THAT THE
  137. /// INTEGRAL OVER 0 TO XSUM(NSUM) IS ADDED TO THE INTEGRAL OVER
  138. /// XSUM(NSUM) TO INFINITY WITH THE PADE METHOD INVOKED ONLY FOR
  139. /// THE LATTER. THIS ALLOWS THE PADE SUMMATION METHOD TO BE
  140. /// OVERRIDDEN AND SOME TYPES OF SINGULARITIES TO BE HANDLED.
  141. /// NSUM NUMBER OF VALUES IN XSUM, MAY BE ZERO.
  142. /// NEW DETERMINES METHOD OF KERNEL CALCULATION
  143. /// NEW=0 MEANS CALCULATE BUT DO NOT SAVE INTEGRANDS
  144. /// NEW=1 MEANS CALCULATE KERNEL BY CALLING FUNCT-SAVE KERNEL
  145. /// TIMES BESSEL FUNCTION
  146. /// NEW=2 MEANS USE SAVED KERNELS TIMES BESSEL FUNCTIONS IN
  147. /// COMMON /BESINT/. NOTE THAT ORDER,R,NPCS,XSUM, AND
  148. /// NSUM MAY NOT BE CHANGED WHEN SETTING NEW=2.
  149. /// IERR ERROR PARAMETER
  150. /// 0 NORMAL RETURN-INTEGRAL CONVERGED
  151. /// 1 MEANS NO CONVERGENCE AFTER NSTOP TERMS IN THE PADE SUM
  152. ///
  153. /// SUBROUTINES REQUIRED:
  154. /// BESQUD,PADECF,CF,ZEROJ,DOT,JBESS
  155. /// A.CHAVE IGPP/UCSD
  156. /// NTERM IS MAXIMUM NUMBER OF BESSEL FUNCTION LOOPS STORED IF
  157. /// NEW.NE.0
  158. /// NSTOP IS MAXIMUM Number of Pade terms
  159. //template <EMMODE T>
  160. void Bestrn( Real &BESR, Real &BESI, const int &iorder,
  161. const int &NG, const Real &R,
  162. const Real &RERR, const Real &AERR, const int &npcs,
  163. VectorXi &XSUM, int &NSUM, int &NEW,
  164. int &IERR, int &NCNTRL, const Real &AORB,
  165. KernelEM1DBase* Kernel);
  166. /// CALCULATES THE INTEGRAL OF F(X)*J-SUB-N(X*R) OVER THE
  167. /// INTERVAL A TO B AT A SPECIFIED GAUSS ORDER THE RESULT IS
  168. /// OBTAINED USING A SEQUENCE OF 1, 3, 7, 15, 31, 63, 127, AND 255
  169. /// POINT INTERLACING GAUSS FORMULAE SO THAT NO INTEGRAND
  170. /// EVALUATIONS ARE WASTED. THE KERNEL FUNCTIONS MAY BE
  171. /// SAVED SO THAT BESSEL TRANSFORMS OF SIMILAR KERNELS ARE COMPUTED
  172. /// WITHOUT NEW EVALUATION OF THE KERNEL. DETAILS ON THE FORMULAE
  173. /// ARE GIVEN IN 'THE OPTIMUM ADDITION OF POINTS TO QUADRATURE
  174. /// FORMULAE' BY T.N.L. PATTERSON, MATHS.COMP. 22,847-856 (1968).
  175. /// GAUSS WEIGHTS TAKEN FROM COMM. A.C.M. 16,694-699 (1973)
  176. /// ARGUMENT LIST:
  177. /// A LOWER LIMIT OF INTEGRATION
  178. /// B UPPER LIMIT OF INTEGRATION
  179. /// BESR,BESI RETURNED INTEGRAL VALUE REAL AND IMAGINARY PARTS
  180. /// NG NUMBER OF POINTS IN THE GAUSS FORMULA. NG=1,...7
  181. /// SELECTS 3,7,15,31,63,127,AND 255 POINT QUADRATURE.
  182. /// NEW SELECTS METHOD OF KERNEL EVALUATION
  183. /// NEW=0 CALCULATES KERNELS BY CALLING F - NOTHING SAVED
  184. /// NEW=1 CALCULATES KERNELS BY CALLING F AND SAVES KERNEL TIMES
  185. /// BESSEL FUNCTION IN COMMON /BESINT/
  186. /// NEW=2 USES SAVED KERNEL TIMES BESSEL FUNCTIONS IN
  187. /// COMMON /BESINT/
  188. /// iorder ORDER OF THE BESSEL FUNCTION
  189. /// R ARGUMENT OF THE BESSEL FUNCTION
  190. /// F F(X) IS THE EXTERNAL INTEGRAND SUBROUTINE
  191. /// A.CHAVE IGPP/UCSDC
  192. /// MAXIMUM NUMBER OF BESSEL FUNCTION LOOPS THAT CAN BE SAVED
  193. //template <EMMODE T>
  194. void Besqud(const Real &A, const Real &B, Real &BESR, Real &BESI,
  195. const int &NG, const int &NEW, const int &iorder,
  196. const Real &R, KernelEM1DBase* Kernel);
  197. /// COMPUTES SUM(S(I)),I=1,...N BY COMPUTATION OF PADE APPROXIMANT
  198. /// USING CONTINUED FRACTION EXPANSION. FUNCTION IS DESIGNED TO BE
  199. /// CALLED SEQUENTIALLY AS N IS INCREMENTED FROM 1 TO ITS FINAL
  200. /// VALUE. THE NTH CONTINUED FRACTION COEFFICIENT IS CALCULATED AND
  201. /// STORED AND THE NTH CONVERGENT RETURNED. IT IS UP TO THE USER TO
  202. /// STOP THE CALCULATION WHEN THE DESIRED ACCURACY IS ACHIEVED.
  203. /// ALGORITHM FROM HANGGI ET AL., Z.NATURFORSCH. 33A,402-417 (1977)
  204. /// IN THEIR NOTATION, VECTORS CFCOR,CFCOI ARE LOWER CASE D,
  205. /// VECTORS DR, DI ARE UPPER CASE D, VECTORS XR,XI ARE X, AND
  206. /// VECTORS SR,SI ARE S
  207. /// A.CHAVE IGPP/UCSD
  208. void Padecf(Real &SUMR, Real &SUMI, const int &N);
  209. /// EVALUATES A COMPLEX CONTINUED FRACTION BY RECURSIVE DIVISION
  210. /// STARTING AT THE BOTTOM, AS USED BY PADECF
  211. /// RESR,RESI ARE REAL AND IMAGINARY PARTS RETURNED
  212. /// CFCOR,CFCOI ARE REAL AND IMAGINARY VECTORS OF CONTINUED FRACTION
  213. /// COEFFICIENTS
  214. void CF( Real& RESR, Real &RESI,
  215. Eigen::Matrix<Real, 100, 1> &CFCOR,
  216. Eigen::Matrix<Real, 100, 1> &CFCOI,
  217. const int &N);
  218. /// COMPUTES ZERO OF BESSEL FUNCTION OF THE FIRST KIND FROM
  219. /// MCMAHON'S ASYMPTOTIC EXPANSION
  220. /// NZERO-NUMBER OF THE ZERO
  221. /// iorder-ORDER OF THE BESSEL FUNCTION (0 OR 1)
  222. Real ZeroJ(const int &ZERO, const int &IORDER);
  223. /// COMPUTES BESSEL FUNCTION OF ORDER "ORDER" AND ARGUMENT X BY
  224. /// CALLING NBS ROUTINES J0X AND J1X (REAL*8 BUT APPROXIMATELY
  225. /// REAL*4 ACCURACY).
  226. /// FOR MORE ACCURACY JBESS COULD BE CHANGED TO CALL, FOR EXAMPLE,
  227. /// THE IMSL ROUTINES MMBSJ0,MMBSJ1 << SEE C// BELOW >>
  228. Real Jbess(const Real &X, const int &IORDER);
  229. /// COMPUTES DOT PRODUCT OF TWO D.P. VECTORS WITH NONUNIT
  230. /// INCREMENTING ALLOWED. REPLACEMENT FOR BLAS SUBROUTINE SDOT.
  231. /// Currently does no checking, kind of stupid.
  232. /// The fortran version will wrap around if (inc*N) > X1.size()
  233. /// but not in a nice way.
  234. Real _dot(const int&N,
  235. const Eigen::Matrix<Real, Eigen::Dynamic, Eigen::Dynamic> &X1,
  236. const int &INC1,
  237. const Eigen::Matrix<Real, Eigen::Dynamic, Eigen::Dynamic> &X2,
  238. const int &INC2);
  239. // ==================== DATA MEMBERS ============================
  240. static const Real PI2;
  241. static const Real X01P;
  242. static const Real XMAX;
  243. static const Real XSMALL;
  244. static const Real J0_X01;
  245. static const Real J0_X02;
  246. static const Real J0_X11;
  247. static const Real J0_X12;
  248. static const Real FUDGE;
  249. static const Real FUDGEX;
  250. static const Real TWOPI1;
  251. static const Real TWOPI2;
  252. static const Real RTPI2;
  253. static const Real XMIN;
  254. static const Real J1_X01;
  255. static const Real J1_X02;
  256. static const Real J1_X11;
  257. static const Real J1_X12;
  258. /// Highest gauss order used, Was NG
  259. int HighestGaussOrder;
  260. /// Total number of partial integrals on last call, was NI
  261. int NumberPartialIntegrals;
  262. /// Total number of function calls, was NF
  263. int NumberFunctionEvals;
  264. int np;
  265. int nps;
  266. /////////////////////////////////////////////////////////////
  267. // Eigen members
  268. // Shared constant values
  269. static const VectorXr WT;
  270. static const VectorXr WA;
  271. Eigen::Matrix<int, 100, 1> Nk;
  272. //Eigen::Matrix<Real, 255, 100> karg;
  273. //Eigen::Matrix<Real, 510, 100> kern;
  274. Eigen::Matrix<Real, Eigen::Dynamic, Eigen::Dynamic> karg;
  275. Eigen::Matrix<Real, Eigen::Dynamic, Eigen::Dynamic> kern;
  276. // Was Besval COMMON block
  277. Eigen::Matrix<Real, 100, 1> Xr;
  278. Eigen::Matrix<Real, 100, 1> Xi;
  279. Eigen::Matrix<Real, 100, 1> Dr;
  280. Eigen::Matrix<Real, 100, 1> Di;
  281. Eigen::Matrix<Real, 100, 1> Sr;
  282. Eigen::Matrix<Real, 100, 1> Si;
  283. Eigen::Matrix<Real, 100, 1> Cfcor;
  284. Eigen::Matrix<Real, 100, 1> Cfcoi;
  285. private:
  286. /** ASCII string representation of the class name */
  287. static constexpr auto CName = "FHTKey51";
  288. }; // ----- end of class GQChave -----
  289. //////////////////////////////////////////////////////////////
  290. // Exception Classes
  291. /** If the lower integration limit is greater than the upper limit, throw this
  292. * error.
  293. */
  294. class LowerGaussLimitGreaterThanUpperGaussLimit :
  295. public std::runtime_error {
  296. /** Thrown when the LowerGaussLimit is greater than the upper limit.
  297. */
  298. public: LowerGaussLimitGreaterThanUpperGaussLimit();
  299. };
  300. } // ----- end of Lemma name -----
  301. #endif // ----- #ifndef _HANKELTRANSFORMGAUSSIANQUADRATURE_h_INC -----