spence.c 4.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165
  1. /* spence.c
  2. *
  3. * Dilogarithm
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * double x, y, spence();
  10. *
  11. * y = spence( x );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. * Computes the integral
  18. *
  19. * x
  20. * -
  21. * | | log t
  22. * spence(x) = - | ----- dt
  23. * | | t - 1
  24. * -
  25. * 1
  26. *
  27. * for x >= 0. A rational approximation gives the integral in
  28. * the interval (0.5, 1.5). Transformation formulas for 1/x
  29. * and 1-x are employed outside the basic expansion range.
  30. *
  31. *
  32. *
  33. * ACCURACY:
  34. *
  35. * Relative error:
  36. * arithmetic domain # trials peak rms
  37. * IEEE 0,4 30000 3.9e-15 5.4e-16
  38. * DEC 0,4 3000 2.5e-16 4.5e-17
  39. *
  40. *
  41. */
  42. /* spence.c */
  43. /*
  44. Cephes Math Library Release 2.8: June, 2000
  45. Copyright 1985, 1987, 1989, 2000 by Stephen L. Moshier
  46. */
  47. #include "mconf.h"
  48. #ifdef UNK
  49. static double A[8] = {
  50. 4.65128586073990045278E-5, 7.31589045238094711071E-3,
  51. 1.33847639578309018650E-1, 8.79691311754530315341E-1,
  52. 2.71149851196553469920E0, 4.25697156008121755724E0,
  53. 3.29771340985225106936E0, 1.00000000000000000126E0,
  54. };
  55. static double B[8] = {
  56. 6.90990488912553276999E-4, 2.54043763932544379113E-2,
  57. 2.82974860602568089943E-1, 1.41172597751831069617E0,
  58. 3.63800533345137075418E0, 5.03278880143316990390E0,
  59. 3.54771340985225096217E0, 9.99999999999999998740E-1,
  60. };
  61. #endif
  62. #ifdef DEC
  63. static unsigned short A[32] = {
  64. 0034503, 0013315, 0034120, 0157771, 0036357, 0135043, 0016766, 0150637,
  65. 0037411, 0007533, 0005212, 0161475, 0040141, 0031563, 0023217, 0120331,
  66. 0040455, 0104461, 0007002, 0155522, 0040610, 0034434, 0065721, 0120465,
  67. 0040523, 0006674, 0105671, 0054427, 0040200, 0000000, 0000000, 0000000,
  68. };
  69. static unsigned short B[32] = {
  70. 0035465, 0021626, 0032367, 0144157, 0036720, 0016326, 0134431, 0000406,
  71. 0037620, 0161024, 0133701, 0120766, 0040264, 0131557, 0152055, 0064512,
  72. 0040550, 0152424, 0051166, 0034272, 0040641, 0006233, 0014672, 0111572,
  73. 0040543, 0006674, 0105671, 0054425, 0040200, 0000000, 0000000, 0000000,
  74. };
  75. #endif
  76. #ifdef IBMPC
  77. static unsigned short A[32] = {
  78. 0x1bff, 0xa70a, 0x62d9, 0x3f08, 0xda34, 0x63be, 0xf744, 0x3f7d,
  79. 0x5c68, 0x6151, 0x21eb, 0x3fc1, 0xf41b, 0x64d1, 0x266e, 0x3fec,
  80. 0x5b6a, 0x21c0, 0xb126, 0x4005, 0x3427, 0x8d7a, 0x0723, 0x4011,
  81. 0x2b23, 0x9177, 0x61b7, 0x400a, 0x0000, 0x0000, 0x0000, 0x3ff0,
  82. };
  83. static unsigned short B[32] = {
  84. 0xf90e, 0xc69e, 0xa472, 0x3f46, 0x2021, 0xd723, 0x039a, 0x3f9a,
  85. 0x343f, 0x96f8, 0x1c42, 0x3fd2, 0xad29, 0xfa85, 0x966d, 0x3ff6,
  86. 0xc717, 0x8a4e, 0x1aa2, 0x400d, 0x526f, 0x6337, 0x2193, 0x4014,
  87. 0x2b23, 0x9177, 0x61b7, 0x400c, 0x0000, 0x0000, 0x0000, 0x3ff0,
  88. };
  89. #endif
  90. #ifdef MIEEE
  91. static unsigned short A[32] = {
  92. 0x3f08, 0x62d9, 0xa70a, 0x1bff, 0x3f7d, 0xf744, 0x63be, 0xda34,
  93. 0x3fc1, 0x21eb, 0x6151, 0x5c68, 0x3fec, 0x266e, 0x64d1, 0xf41b,
  94. 0x4005, 0xb126, 0x21c0, 0x5b6a, 0x4011, 0x0723, 0x8d7a, 0x3427,
  95. 0x400a, 0x61b7, 0x9177, 0x2b23, 0x3ff0, 0x0000, 0x0000, 0x0000,
  96. };
  97. static unsigned short B[32] = {
  98. 0x3f46, 0xa472, 0xc69e, 0xf90e, 0x3f9a, 0x039a, 0xd723, 0x2021,
  99. 0x3fd2, 0x1c42, 0x96f8, 0x343f, 0x3ff6, 0x966d, 0xfa85, 0xad29,
  100. 0x400d, 0x1aa2, 0x8a4e, 0xc717, 0x4014, 0x2193, 0x6337, 0x526f,
  101. 0x400c, 0x61b7, 0x9177, 0x2b23, 0x3ff0, 0x0000, 0x0000, 0x0000,
  102. };
  103. #endif
  104. #ifdef ANSIPROT
  105. extern double fabs(double);
  106. extern double log(double);
  107. extern double polevl(double, void *, int);
  108. #else
  109. double fabs(), log(), polevl();
  110. #endif
  111. extern double PI, MACHEP;
  112. double spence(x) double x;
  113. {
  114. double w, y, z;
  115. int flag;
  116. if (x < 0.0) {
  117. mtherr("spence", DOMAIN);
  118. return (0.0);
  119. }
  120. if (x == 1.0)
  121. return (0.0);
  122. if (x == 0.0)
  123. return (PI * PI / 6.0);
  124. flag = 0;
  125. if (x > 2.0) {
  126. x = 1.0 / x;
  127. flag |= 2;
  128. }
  129. if (x > 1.5) {
  130. w = (1.0 / x) - 1.0;
  131. flag |= 2;
  132. }
  133. else if (x < 0.5) {
  134. w = -x;
  135. flag |= 1;
  136. }
  137. else
  138. w = x - 1.0;
  139. y = -w * polevl(w, A, 7) / polevl(w, B, 7);
  140. if (flag & 1)
  141. y = (PI * PI) / 6.0 - log(x) * log(1.0 - x) - y;
  142. if (flag & 2) {
  143. z = log(x);
  144. y = -0.5 * z * z - y;
  145. }
  146. return (y);
  147. }