ESPResSo
Extensible Simulation Package for Research on Soft Matter Systems
Loading...
Searching...
No Matches
specfunc.cpp
Go to the documentation of this file.
1/*
2 * Copyright (C) 2010-2022 The ESPResSo project
3 * Copyright (C) 2002,2003,2004,2005,2006,2007,2008,2009,2010
4 * Max-Planck-Institute for Polymer Research, Theory Group
5 *
6 * This file is part of ESPResSo.
7 *
8 * ESPResSo is free software: you can redistribute it and/or modify
9 * it under the terms of the GNU General Public License as published by
10 * the Free Software Foundation, either version 3 of the License, or
11 * (at your option) any later version.
12 *
13 * ESPResSo is distributed in the hope that it will be useful,
14 * but WITHOUT ANY WARRANTY; without even the implied warranty of
15 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 * GNU General Public License for more details.
17 *
18 * You should have received a copy of the GNU General Public License
19 * along with this program. If not, see <http://www.gnu.org/licenses/>.
20 */
21
22/* Original gsl header
23 * specfunc/bessel_K0.cpp
24 *
25 * Copyright (C) 1996, 1997, 1998, 1999, 2000 Gerard Jungman
26 *
27 * This program is free software; you can redistribute it and/or modify
28 * it under the terms of the GNU General Public License as published by
29 * the Free Software Foundation; either version 2 of the License, or (at
30 * your option) any later version.
31 *
32 * This program is distributed in the hope that it will be useful, but
33 * WITHOUT ANY WARRANTY; without even the implied warranty of
34 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
35 * General Public License for more details.
36 *
37 * You should have received a copy of the GNU General Public License
38 * along with this program; if not, write to the Free Software
39 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
40 */
41
42/* Original Author: G. Jungman */
43
44/** @file
45 * Implementation of @ref specfunc.hpp.
46 */
47
48#include "specfunc.hpp"
49
50#include <utils/math/sqr.hpp>
51
52#include <cmath>
53#include <numbers>
54#include <tuple>
55#include <utility>
56
57/************************************************
58 * chebychev expansions
59 ************************************************/
60/* Note that the first coefficient already includes the constant offsets */
61
62/** @name Chebyshev expansions based on SLATEC bk0(), bk0e() */
63/**@{*/
64/** Series for @c bk0.
65 * On the interval 0. to 4.00000d+00
66 * | Label | Value |
67 * | ---------------------------: | :------- |
68 * | with weighted error | 3.57e-19 |
69 * | log weighted error | 18.45 |
70 * | significant figures required | 17.99 |
71 * | decimal places required | 18.97 |
72 */
73static double bk0_cs[11] = {
74 -.5 - 0.03532739323390276872, 0.3442898999246284869,
75 0.03597993651536150163, 0.00126461541144692592,
76 0.00002286212103119451, 0.00000025347910790261,
77 0.00000000190451637722, 0.00000000001034969525,
78 0.00000000000004259816, 0.00000000000000013744,
79 0.00000000000000000035};
80
81/** Series for @c ak0.
82 * On the interval 1.25000d-01 to 5.00000d-01
83 * | Label | Value |
84 * | ---------------------------: | :------- |
85 * | with weighted error | 5.34e-17 |
86 * | log weighted error | 16.27 |
87 * | significant figures required | 14.92 |
88 * | decimal places required | 16.89 |
89 */
90static double ak0_cs[17] = {
91 2.5 - 0.07643947903327941, -0.02235652605699819, 0.00077341811546938,
92 -0.00004281006688886, 0.00000308170017386, -0.00000026393672220,
93 0.00000002563713036, -0.00000000274270554, 0.00000000031694296,
94 -0.00000000003902353, 0.00000000000506804, -0.00000000000068895,
95 0.00000000000009744, -0.00000000000001427, 0.00000000000000215,
96 -0.00000000000000033, 0.00000000000000005};
97
98/** Series for @c ak02.
99 * On the interval 0. to 1.25000d-01
100 * | Label | Value |
101 * | ---------------------------: | :------- |
102 * | with weighted error | 2.34e-17 |
103 * | log weighted error | 16.63 |
104 * | significant figures required | 14.67 |
105 * | decimal places required | 17.20 |
106 */
107static double ak02_cs[14] = {
108 2.5 - 0.01201869826307592, -0.00917485269102569, 0.00014445509317750,
109 -0.00000401361417543, 0.00000015678318108, -0.00000000777011043,
110 0.00000000046111825, -0.00000000003158592, 0.00000000000243501,
111 -0.00000000000020743, 0.00000000000001925, -0.00000000000000192,
112 0.00000000000000020, -0.00000000000000002};
113/**@}*/
114
115/** @name Chebyshev expansions based on SLATEC besi0() */
116/**@{*/
117/** Series for @c bi0.
118 * On the interval 0. to 9.00000d+00
119 * | Label | Value |
120 * | ---------------------------: | :------- |
121 * | with weighted error | 2.46e-18 |
122 * | log weighted error | 17.61 |
123 * | significant figures required | 17.90 |
124 * | decimal places required | 18.15 |
125 */
126static double bi0_cs[12] = {
127 5.5 - .07660547252839144951, 1.92733795399380827000, .22826445869203013390,
128 .01304891466707290428, .00043442709008164874, .00000942265768600193,
129 .00000014340062895106, .00000000161384906966, .00000000001396650044,
130 .00000000000009579451, .00000000000000053339, .00000000000000000245};
131/**@}*/
132
133/** @name Chebyshev expansions based on SLATEC besk1(), besk1e() */
134/**@{*/
135/** Series for @c bk1.
136 * On the interval 0. to 4.00000d+00
137 * | Label | Value |
138 * | ---------------------------: | :------- |
139 * | with weighted error | 7.02e-18 |
140 * | log weighted error | 17.15 |
141 * | significant figures required | 16.73 |
142 * | decimal places required | 17.67 |
143 */
144static double bk1_cs[11] = {
145 1.5 + 0.0253002273389477705, -0.3531559607765448760, -0.1226111808226571480,
146 -0.0069757238596398643, -0.0001730288957513052, -0.0000024334061415659,
147 -0.0000000221338763073, -0.0000000001411488392, -0.0000000000006666901,
148 -0.0000000000000024274, -0.0000000000000000070};
149
150/** Series for @c ak1.
151 * On the interval 1.25000d-01 to 5.00000d-01
152 * | Label | Value |
153 * | ---------------------------: | :------- |
154 * | with weighted error | 6.06e-17 |
155 * | log weighted error | 16.22 |
156 * | significant figures required | 15.41 |
157 * | decimal places required | 16.83 |
158 */
159static double ak1_cs[17] = {
160 2.5 + 0.27443134069738830, 0.07571989953199368, -0.00144105155647540,
161 0.00006650116955125, -0.00000436998470952, 0.00000035402774997,
162 -0.00000003311163779, 0.00000000344597758, -0.00000000038989323,
163 0.00000000004720819, -0.00000000000604783, 0.00000000000081284,
164 -0.00000000000011386, 0.00000000000001654, -0.00000000000000248,
165 0.00000000000000038, -0.00000000000000006};
166
167/** Series for @c ak12.
168 * On the interval 0. to 1.25000d-01
169 * | Label | Value |
170 * | ---------------------------: | :------- |
171 * | with weighted error | 2.58e-17 |
172 * | log weighted error | 16.59 |
173 * | significant figures required | 15.22 |
174 * | decimal places required | 17.16 |
175 */
176static double ak12_cs[14] = {
177 2.5 + 0.06379308343739001, 0.02832887813049721, -0.00024753706739052,
178 0.00000577197245160, -0.00000020689392195, 0.00000000973998344,
179 -0.00000000055853361, 0.00000000003732996, -0.00000000000282505,
180 0.00000000000023720, -0.00000000000002176, 0.00000000000000215,
181 -0.00000000000000022, 0.00000000000000002};
182/**@}*/
183
184/** @name Chebyshev expansions based on SLATEC besi1(), besi1e() */
185/**@{*/
186/** Series for @c bi1.
187 * On the interval 0. to 9.00000d+00
188 * | Label | Value |
189 * | ---------------------------: | :------- |
190 * | with weighted error | 2.40e-17 |
191 * | log weighted error | 16.62 |
192 * | significant figures required | 16.23 |
193 * | decimal places required | 17.14 |
194 */
195static double bi1_cs[11] = {
196 1.75 - 0.001971713261099859, 0.407348876675464810, 0.034838994299959456,
197 0.001545394556300123, 0.000041888521098377, 0.000000764902676483,
198 0.000000010042493924, 0.000000000099322077, 0.000000000000766380,
199 0.000000000000004741, 0.000000000000000024};
200/**@}*/
201
202/** Coefficients for Maclaurin summation in hzeta(). Evaluated as inverse
203 * numbers, i.e. @f$ \displaystyle\frac{B_{2j}}{(2j)!} @f$.
204 */
205static double const hzeta_c[15] = {
206 1.00000000000000000000000000000, 0.083333333333333333333333333333,
207 -0.00138888888888888888888888888889, 0.000033068783068783068783068783069,
208 -8.2671957671957671957671957672e-07, 2.0876756987868098979210090321e-08,
209 -5.2841901386874931848476822022e-10, 1.3382536530684678832826980975e-11,
210 -3.3896802963225828668301953912e-13, 8.5860620562778445641359054504e-15,
211 -2.1748686985580618730415164239e-16, 5.5090028283602295152026526089e-18,
212 -1.3954464685812523340707686264e-19, 3.5347070396294674716932299778e-21,
213 -8.9535174270375468504026113181e-23};
214
215double hzeta(double s, double q) {
216 constexpr auto max_bits = 54.0;
217 constexpr auto jmax = 12;
218 constexpr auto kmax = 10;
219
220 if ((s > max_bits and q < 1.0) or (s > 0.5 * max_bits and q < 0.25))
221 return std::pow(q, -s);
222 if (s > 0.5 * max_bits and q < 1.0) {
223 auto const p1 = std::pow(q, -s);
224 auto const p2 = std::pow(q / (1.0 + q), s);
225 auto const p3 = std::pow(q / (2.0 + q), s);
226 return p1 * (1.0 + p2 + p3);
227 }
228 /** Euler-Maclaurin summation formula from @cite moshier89a p. 400, with
229 * several typo corrections.
230 */
231 auto const kmax_q = static_cast<double>(kmax) + q;
232 auto const pmax = std::pow(kmax_q, -s);
233 auto scp = s;
234 auto pcp = pmax / kmax_q;
235 auto ans = pmax * (kmax_q / (s - 1.0) + 0.5);
236
237 for (int k = 0; k < kmax; k++)
238 ans += std::pow(static_cast<double>(k) + q, -s);
239
240 for (int j = 0; j <= jmax; j++) {
241 auto const delta = hzeta_c[j + 1] * scp * pcp;
242 ans += delta;
243 scp *= (s + 2. * j + 1.) * (s + 2. * j + 2.);
244 pcp /= Utils::sqr(static_cast<double>(kmax) + q);
245 }
246
247 return ans;
248}
249
250double K0(double x) {
251 if (x <= 2.0) {
252 auto const c = evaluateAsChebychevSeriesAt(bk0_cs, 0.5 * x * x - 1.0);
253 auto const i0 = evaluateAsChebychevSeriesAt(bi0_cs, x * x / 4.5 - 1.0);
254 return (-std::log(x) + std::numbers::ln2) * i0 + c;
255 }
256 auto const c =
257 (x <= 8.0) ? evaluateAsChebychevSeriesAt(ak0_cs, (16.0 / x - 5.0) / 3.0)
258 : evaluateAsChebychevSeriesAt(ak02_cs, 16.0 / x - 1.0);
259 return std::exp(-x) * c / std::sqrt(x);
260}
261
262double K1(double x) {
263 if (x <= 2.0) {
264 auto const c = evaluateAsChebychevSeriesAt(bk1_cs, 0.5 * x * x - 1.0);
265 auto const i1 = x * evaluateAsChebychevSeriesAt(bi1_cs, x * x / 4.5 - 1.0);
266 return (std::log(x) - std::numbers::ln2) * i1 + c / x;
267 }
268 auto const c =
269 (x <= 8.0) ? evaluateAsChebychevSeriesAt(ak1_cs, (16.0 / x - 5.0) / 3.0)
270 : evaluateAsChebychevSeriesAt(ak12_cs, 16.0 / x - 1.0);
271 return std::exp(-x) * c / std::sqrt(x);
272}
273
274/***********************************************************
275 * optimized K0/1 implementations for 10^(-14) precision
276 ***********************************************************/
277
278/** necessary orders for K0/1 from 2 up to 22 for 10^-14 precision. Note that
279 * at 8 the expansion changes. From 23 to 26 order 2 is used, above order 1.
280 * For the latter cases, separate implementations are necessary.
281 */
282static int ak01_orders[] = {
283 /* 2 - 8 */
284 11, 11, 10, 10, 9, 9,
285 /* 8 - 26 */
286 6, 6, 5, 5, 5, 4, 4, 4, 3, 3, 2, 2, 2, 2, 2};
287
288double LPK0(double x) {
289 if (x >= 27.) {
290 auto const tmp = .5 * std::exp(-x) / std::sqrt(x);
291 return tmp * ak0_cs[0];
292 }
293 if (x >= 23.) {
294 auto const tmp = std::exp(-x) / std::sqrt(x);
295 auto const xx = (16. / 3.) / x - 5. / 3.;
296 return tmp * (xx * ak0_cs[1] + 0.5 * ak0_cs[0]);
297 }
298 if (x > 2.) {
299 int j = ak01_orders[static_cast<int>(x) - 2];
300 double x2;
301 double *s0;
302 if (x <= 8.) {
303 s0 = ak0_cs;
304 x2 = (2. * 16. / 3.) / x - 2. * 5. / 3.;
305 } else {
306 s0 = ak02_cs;
307 x2 = (2. * 16.) / x - 2.;
308 }
309 auto dd0 = s0[j];
310 auto d0 = x2 * dd0 + s0[j - 1];
311 for (j -= 2; j >= 1; j--) {
312 auto const tmp0 = d0;
313 d0 = x2 * d0 - dd0 + s0[j];
314 dd0 = tmp0;
315 }
316 auto const tmp = std::exp(-x) / std::sqrt(x);
317 return tmp * (0.5 * (s0[0] + x2 * d0) - dd0);
318 }
319 /* x <= 2 */
320 {
321 /* I0/I1 series */
322 int j = 10;
323 auto x2 = (2. / 4.5) * x * x - 2.;
324 auto dd0 = bi0_cs[j];
325 auto d0 = x2 * dd0 + bi0_cs[j - 1];
326 for (j -= 2; j >= 1; j--) {
327 auto const tmp0 = d0;
328 d0 = x2 * d0 - dd0 + bi0_cs[j];
329 dd0 = tmp0;
330 }
331 auto const tmp = std::log(x) - std::numbers::ln2;
332 auto const ret = -tmp * (0.5 * (bi0_cs[0] + x2 * d0) - dd0);
333
334 /* K0/K1 correction */
335 j = 9;
336 x2 = x * x - 2.;
337 dd0 = bk0_cs[j];
338 d0 = x2 * dd0 + bk0_cs[j - 1];
339 for (j -= 2; j >= 1; j--) {
340 auto const tmp0 = d0;
341 d0 = x2 * d0 - dd0 + bk0_cs[j];
342 dd0 = tmp0;
343 }
344 return ret + (0.5 * (x2 * d0 + bk0_cs[0]) - dd0);
345 }
346}
347
348double LPK1(double x) {
349 if (x >= 27.) {
350 auto const tmp = .5 * std::exp(-x) / std::sqrt(x);
351 return tmp * ak1_cs[0];
352 }
353 if (x >= 23.) {
354 auto const tmp = std::exp(-x) / std::sqrt(x);
355 auto const xx = (16. / 3.) / x - 5. / 3.;
356 return tmp * (xx * ak1_cs[1] + 0.5 * ak1_cs[0]);
357 }
358 if (x > 2.) {
359 int j = ak01_orders[static_cast<int>(x) - 2];
360 double x2;
361 double *s1;
362 if (x <= 8.) {
363 s1 = ak1_cs;
364 x2 = (2. * 16. / 3.) / x - 2. * 5. / 3.;
365 } else {
366 s1 = ak12_cs;
367 x2 = (2. * 16.) / x - 2.;
368 }
369 auto dd1 = s1[j];
370 auto d1 = x2 * dd1 + s1[j - 1];
371 for (j -= 2; j >= 1; j--) {
372 auto const tmp1 = d1;
373 d1 = x2 * d1 - dd1 + s1[j];
374 dd1 = tmp1;
375 }
376 auto const tmp = std::exp(-x) / std::sqrt(x);
377 return tmp * (0.5 * (s1[0] + x2 * d1) - dd1);
378 }
379 /* x <= 2 */
380 {
381 /* I0/I1 series */
382 int j = 10;
383 auto x2 = (2. / 4.5) * x * x - 2.;
384 auto dd1 = bi1_cs[j];
385 auto d1 = x2 * dd1 + bi1_cs[j - 1];
386 for (j -= 2; j >= 1; j--) {
387 auto const tmp1 = d1;
388 d1 = x2 * d1 - dd1 + bi1_cs[j];
389 dd1 = tmp1;
390 }
391 auto const tmp = std::log(x) - std::numbers::ln2;
392 auto const ret = x * tmp * (0.5 * (bi1_cs[0] + x2 * d1) - dd1);
393
394 /* K0/K1 correction */
395 j = 9;
396 x2 = x * x - 2.;
397 dd1 = bk1_cs[j];
398 d1 = x2 * dd1 + bk1_cs[j - 1];
399 for (j -= 2; j >= 1; j--) {
400 auto const tmp1 = d1;
401 d1 = x2 * d1 - dd1 + bk1_cs[j];
402 dd1 = tmp1;
403 }
404 return ret + (0.5 * (x2 * d1 + bk1_cs[0]) - dd1) / x;
405 }
406}
407
408std::pair<double, double> LPK01(double x) {
409 if (x >= 27.) {
410 auto const tmp = .5 * std::exp(-x) / std::sqrt(x);
411 auto const k0 = tmp * ak0_cs[0];
412 auto const k1 = tmp * ak1_cs[0];
413 return {k0, k1};
414 }
415 if (x >= 23.) {
416 auto const tmp = std::exp(-x) / std::sqrt(x);
417 auto const xx = (16. / 3.) / x - 5. / 3.;
418 auto const k0 = tmp * (xx * ak0_cs[1] + 0.5 * ak0_cs[0]);
419 auto const k1 = tmp * (xx * ak1_cs[1] + 0.5 * ak1_cs[0]);
420 return {k0, k1};
421 }
422 if (x > 2.) {
423 int j = ak01_orders[static_cast<int>(x) - 2];
424 double x2;
425 double *s0, *s1;
426 if (x <= 8.) {
427 s0 = ak0_cs;
428 s1 = ak1_cs;
429 x2 = (2. * 16. / 3.) / x - 2. * 5. / 3.;
430 } else {
431 s0 = ak02_cs;
432 s1 = ak12_cs;
433 x2 = (2. * 16.) / x - 2.;
434 }
435 auto dd0 = s0[j];
436 auto dd1 = s1[j];
437 auto d0 = x2 * dd0 + s0[j - 1];
438 auto d1 = x2 * dd1 + s1[j - 1];
439 for (j -= 2; j >= 1; j--) {
440 auto const tmp0 = d0, tmp1 = d1;
441 d0 = x2 * d0 - dd0 + s0[j];
442 d1 = x2 * d1 - dd1 + s1[j];
443 dd0 = tmp0;
444 dd1 = tmp1;
445 }
446 auto const tmp = std::exp(-x) / std::sqrt(x);
447 auto const k0 = tmp * (0.5 * (s0[0] + x2 * d0) - dd0);
448 auto const k1 = tmp * (0.5 * (s1[0] + x2 * d1) - dd1);
449 return {k0, k1};
450 }
451 /* x <= 2 */
452 {
453 /* I0/I1 series */
454 int j = 10;
455 auto x2 = (2. / 4.5) * x * x - 2.;
456 auto dd0 = bi0_cs[j];
457 auto dd1 = bi1_cs[j];
458 auto d0 = x2 * dd0 + bi0_cs[j - 1];
459 auto d1 = x2 * dd1 + bi1_cs[j - 1];
460 for (j -= 2; j >= 1; j--) {
461 auto const tmp0 = d0, tmp1 = d1;
462 d0 = x2 * d0 - dd0 + bi0_cs[j];
463 d1 = x2 * d1 - dd1 + bi1_cs[j];
464 dd0 = tmp0;
465 dd1 = tmp1;
466 }
467 auto const tmp = std::log(x) - std::numbers::ln2;
468 auto k0 = -tmp * (0.5 * (bi0_cs[0] + x2 * d0) - dd0);
469 auto k1 = x * tmp * (0.5 * (bi1_cs[0] + x2 * d1) - dd1);
470
471 /* K0/K1 correction */
472 j = 9;
473 x2 = x * x - 2.;
474 dd0 = bk0_cs[j];
475 dd1 = bk1_cs[j];
476 d0 = x2 * dd0 + bk0_cs[j - 1];
477 d1 = x2 * dd1 + bk1_cs[j - 1];
478 for (j -= 2; j >= 1; j--) {
479 auto const tmp0 = d0, tmp1 = d1;
480 d0 = x2 * d0 - dd0 + bk0_cs[j];
481 d1 = x2 * d1 - dd1 + bk1_cs[j];
482 dd0 = tmp0;
483 dd1 = tmp1;
484 }
485 k0 += (0.5 * (x2 * d0 + bk0_cs[0]) - dd0);
486 k1 += (0.5 * (x2 * d1 + bk1_cs[0]) - dd1) / x;
487 return {k0, k1};
488 }
489}
DEVICE_QUALIFIER constexpr T sqr(T x)
Calculates the SQuaRe of x.
Definition sqr.hpp:28
double hzeta(double s, double q)
Hurwitz zeta function.
Definition specfunc.cpp:215
static int ak01_orders[]
necessary orders for K0/1 from 2 up to 22 for 10^-14 precision.
Definition specfunc.cpp:282
static double ak02_cs[14]
Series for ak02.
Definition specfunc.cpp:107
double LPK1(double x)
Modified Bessel function of second kind, order 1, low precision.
Definition specfunc.cpp:348
static double bi0_cs[12]
Series for bi0.
Definition specfunc.cpp:126
static double bk1_cs[11]
Series for bk1.
Definition specfunc.cpp:144
std::pair< double, double > LPK01(double x)
Modified Bessel functions of second kind, order 0 and 1, low precision.
Definition specfunc.cpp:408
double K1(double x)
Modified Bessel function of second kind, order 1.
Definition specfunc.cpp:262
static double ak12_cs[14]
Series for ak12.
Definition specfunc.cpp:176
static double ak0_cs[17]
Series for ak0.
Definition specfunc.cpp:90
static double ak1_cs[17]
Series for ak1.
Definition specfunc.cpp:159
static double bk0_cs[11]
Series for bk0.
Definition specfunc.cpp:73
static double bi1_cs[11]
Series for bi1.
Definition specfunc.cpp:195
double K0(double x)
Modified Bessel function of second kind, order 0.
Definition specfunc.cpp:250
static double const hzeta_c[15]
Coefficients for Maclaurin summation in hzeta().
Definition specfunc.cpp:205
double LPK0(double x)
Modified Bessel function of second kind, order 0, low precision.
Definition specfunc.cpp:288
This file contains implementations for some special functions which are needed by the MMM family of a...
double evaluateAsChebychevSeriesAt(std::span< const double > series, double x)
Evaluate the polynomial interpreted as a Chebychev series.
Definition specfunc.hpp:103