log10.c 5.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250
  1. /* log10.c
  2. *
  3. * Common logarithm
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * double x, y, log10();
  10. *
  11. * y = log10( x );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. * Returns logarithm to the base 10 of x.
  18. *
  19. * The argument is separated into its exponent and fractional
  20. * parts. The logarithm of the fraction is approximated by
  21. *
  22. * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x).
  23. *
  24. *
  25. *
  26. * ACCURACY:
  27. *
  28. * Relative error:
  29. * arithmetic domain # trials peak rms
  30. * IEEE 0.5, 2.0 30000 1.5e-16 5.0e-17
  31. * IEEE 0, MAXNUM 30000 1.4e-16 4.8e-17
  32. * DEC 1, MAXNUM 50000 2.5e-17 6.0e-18
  33. *
  34. * In the tests over the interval [1, MAXNUM], the logarithms
  35. * of the random arguments were uniformly distributed over
  36. * [0, MAXLOG].
  37. *
  38. * ERROR MESSAGES:
  39. *
  40. * log10 singularity: x = 0; returns -INFINITY
  41. * log10 domain: x < 0; returns NAN
  42. */
  43. /*
  44. Cephes Math Library Release 2.8: June, 2000
  45. Copyright 1984, 1995, 2000 by Stephen L. Moshier
  46. */
  47. #include <math.h>
  48. static char fname[] = {"log10"};
  49. /* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x)
  50. * 1/sqrt(2) <= x < sqrt(2)
  51. */
  52. #ifdef UNK
  53. static double P[] = {
  54. 4.58482948458143443514E-5,
  55. 4.98531067254050724270E-1,
  56. 6.56312093769992875930E0,
  57. 2.97877425097986925891E1,
  58. 6.06127134467767258030E1,
  59. 5.67349287391754285487E1,
  60. 1.98892446572874072159E1
  61. };
  62. static double Q[] = {
  63. /* 1.00000000000000000000E0, */
  64. 1.50314182634250003249E1,
  65. 8.27410449222435217021E1,
  66. 2.20664384982121929218E2,
  67. 3.07254189979530058263E2,
  68. 2.14955586696422947765E2,
  69. 5.96677339718622216300E1
  70. };
  71. #endif
  72. #ifdef DEC
  73. static unsigned short P[] = {
  74. 0034500,0046473,0051374,0135174,
  75. 0037777,0037566,0145712,0150321,
  76. 0040722,0002426,0031543,0123107,
  77. 0041356,0046513,0170752,0004346,
  78. 0041562,0071553,0023536,0163343,
  79. 0041542,0170221,0024316,0114216,
  80. 0041237,0016454,0046611,0104602
  81. };
  82. static unsigned short Q[] = {
  83. /*0040200,0000000,0000000,0000000,*/
  84. 0041160,0100260,0067736,0102424,
  85. 0041645,0075552,0036563,0147072,
  86. 0042134,0125025,0021132,0025320,
  87. 0042231,0120211,0046030,0103271,
  88. 0042126,0172241,0052151,0120426,
  89. 0041556,0125702,0072116,0047103
  90. };
  91. #endif
  92. #ifdef IBMPC
  93. static unsigned short P[] = {
  94. 0x974f,0x6a5f,0x09a7,0x3f08,
  95. 0x5a1a,0xd979,0xe7ee,0x3fdf,
  96. 0x74c9,0xc66c,0x40a2,0x401a,
  97. 0x411d,0x7e3d,0xc9a9,0x403d,
  98. 0xdcdc,0x64eb,0x4e6d,0x404e,
  99. 0xd312,0x2519,0x5e12,0x404c,
  100. 0x3130,0x89b1,0xe3a5,0x4033
  101. };
  102. static unsigned short Q[] = {
  103. /*0x0000,0x0000,0x0000,0x3ff0,*/
  104. 0xd0a2,0x0dfb,0x1016,0x402e,
  105. 0x79c7,0x47ae,0xaf6d,0x4054,
  106. 0x455a,0xa44b,0x9542,0x406b,
  107. 0x10d7,0x2983,0x3411,0x4073,
  108. 0x3423,0x2a8d,0xde94,0x406a,
  109. 0xc9c8,0x4e89,0xd578,0x404d
  110. };
  111. #endif
  112. #ifdef MIEEE
  113. static unsigned short P[] = {
  114. 0x3f08,0x09a7,0x6a5f,0x974f,
  115. 0x3fdf,0xe7ee,0xd979,0x5a1a,
  116. 0x401a,0x40a2,0xc66c,0x74c9,
  117. 0x403d,0xc9a9,0x7e3d,0x411d,
  118. 0x404e,0x4e6d,0x64eb,0xdcdc,
  119. 0x404c,0x5e12,0x2519,0xd312,
  120. 0x4033,0xe3a5,0x89b1,0x3130
  121. };
  122. static unsigned short Q[] = {
  123. 0x402e,0x1016,0x0dfb,0xd0a2,
  124. 0x4054,0xaf6d,0x47ae,0x79c7,
  125. 0x406b,0x9542,0xa44b,0x455a,
  126. 0x4073,0x3411,0x2983,0x10d7,
  127. 0x406a,0xde94,0x2a8d,0x3423,
  128. 0x404d,0xd578,0x4e89,0xc9c8
  129. };
  130. #endif
  131. #define SQRTH 0.70710678118654752440
  132. #define L102A 3.0078125E-1
  133. #define L102B 2.48745663981195213739E-4
  134. #define L10EA 4.3359375E-1
  135. #define L10EB 7.00731903251827651129E-4
  136. #ifdef ANSIPROT
  137. extern double frexp ( double, int * );
  138. extern double ldexp ( double, int );
  139. extern double polevl ( double, void *, int );
  140. extern double p1evl ( double, void *, int );
  141. extern int isnan ( double );
  142. extern int isfinite ( double );
  143. #else
  144. double frexp(), ldexp(), polevl(), p1evl();
  145. int isnan(), isfinite();
  146. #endif
  147. extern double LOGE2, SQRT2, INFINITY, NAN;
  148. double log10(x)
  149. double x;
  150. {
  151. VOLATILE double z;
  152. double y;
  153. #ifdef DEC
  154. short *q;
  155. #endif
  156. int e;
  157. #ifdef NANS
  158. if( isnan(x) )
  159. return(x);
  160. #endif
  161. #ifdef INFINITIES
  162. if( x == INFINITY )
  163. return(x);
  164. #endif
  165. /* Test for domain */
  166. if( x <= 0.0 )
  167. {
  168. if( x == 0.0 )
  169. {
  170. mtherr( fname, SING );
  171. return( -INFINITY );
  172. }
  173. else
  174. {
  175. mtherr( fname, DOMAIN );
  176. return( NAN );
  177. }
  178. }
  179. /* separate mantissa from exponent */
  180. #ifdef DEC
  181. q = (short *)&x;
  182. e = *q; /* short containing exponent */
  183. e = ((e >> 7) & 0377) - 0200; /* the exponent */
  184. *q &= 0177; /* strip exponent from x */
  185. *q |= 040000; /* x now between 0.5 and 1 */
  186. #endif
  187. #ifdef IBMPC
  188. x = frexp( x, &e );
  189. /*
  190. q = (short *)&x;
  191. q += 3;
  192. e = *q;
  193. e = ((e >> 4) & 0x0fff) - 0x3fe;
  194. *q &= 0x0f;
  195. *q |= 0x3fe0;
  196. */
  197. #endif
  198. /* Equivalent C language standard library function: */
  199. #ifdef UNK
  200. x = frexp( x, &e );
  201. #endif
  202. #ifdef MIEEE
  203. x = frexp( x, &e );
  204. #endif
  205. /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */
  206. if( x < SQRTH )
  207. {
  208. e -= 1;
  209. x = ldexp( x, 1 ) - 1.0; /* 2x - 1 */
  210. }
  211. else
  212. {
  213. x = x - 1.0;
  214. }
  215. /* rational form */
  216. z = x*x;
  217. y = x * ( z * polevl( x, P, 6 ) / p1evl( x, Q, 6 ) );
  218. y = y - ldexp( z, -1 ); /* y - 0.5 * x**2 */
  219. /* multiply log of fraction by log10(e)
  220. * and base 2 exponent by log10(2)
  221. */
  222. z = (x + y) * L10EB; /* accumulate terms in order of size */
  223. z += y * L10EA;
  224. z += x * L10EA;
  225. z += e * L102B;
  226. z += e * L102A;
  227. return( z );
  228. }