log.c 7.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296
  1. /* log.c
  2. *
  3. * Natural logarithm
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * double x, y, log();
  10. *
  11. * y = log( x );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. * Returns the base e (2.718...) logarithm of x.
  18. *
  19. * The argument is separated into its exponent and fractional
  20. * parts. If the exponent is between -1 and +1, the logarithm
  21. * of the fraction is approximated by
  22. *
  23. * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x).
  24. *
  25. * Otherwise, setting z = 2(x-1)/x+1),
  26. *
  27. * log(x) = z + z**3 P(z)/Q(z).
  28. *
  29. *
  30. *
  31. * ACCURACY:
  32. *
  33. * Relative error:
  34. * arithmetic domain # trials peak rms
  35. * IEEE 0.5, 2.0 150000 1.44e-16 5.06e-17
  36. * IEEE +-MAXNUM 30000 1.20e-16 4.78e-17
  37. * DEC 0, 10 170000 1.8e-17 6.3e-18
  38. *
  39. * In the tests over the interval [+-MAXNUM], the logarithms
  40. * of the random arguments were uniformly distributed over
  41. * [0, MAXLOG].
  42. *
  43. * ERROR MESSAGES:
  44. *
  45. * log singularity: x = 0; returns -INFINITY
  46. * log domain: x < 0; returns NAN
  47. */
  48. /*
  49. Cephes Math Library Release 2.8: June, 2000
  50. Copyright 1984, 1995, 2000 by Stephen L. Moshier
  51. */
  52. #include "mconf.h"
  53. static char fname[] = {"log"};
  54. /* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x)
  55. * 1/sqrt(2) <= x < sqrt(2)
  56. */
  57. #ifdef UNK
  58. static double P[] = {
  59. 1.01875663804580931796E-4, 4.97494994976747001425E-1,
  60. 4.70579119878881725854E0, 1.44989225341610930846E1,
  61. 1.79368678507819816313E1, 7.70838733755885391666E0,
  62. };
  63. static double Q[] = {
  64. /* 1.00000000000000000000E0, */
  65. 1.12873587189167450590E1, 4.52279145837532221105E1,
  66. 8.29875266912776603211E1, 7.11544750618563894466E1,
  67. 2.31251620126765340583E1,
  68. };
  69. #endif
  70. #ifdef DEC
  71. static unsigned short P[] = {
  72. 0037777, 0127270, 0162547, 0057274, 0041001, 0054665, 0164317, 0005341,
  73. 0041451, 0034104, 0031640, 0105773, 0041677, 0011276, 0123617, 0160135,
  74. 0041701, 0126603, 0053215, 0117250, 0041420, 0115777, 0135206, 0030232,
  75. };
  76. static unsigned short Q[] = {
  77. /*0040200,0000000,0000000,0000000,*/
  78. 0041220, 0144332, 0045272, 0174241, 0041742, 0164566, 0035720, 0130431,
  79. 0042246, 0126327, 0166065, 0116357, 0042372, 0033420, 0157525, 0124560,
  80. 0042271, 0167002, 0066537, 0172303, 0041730, 0164777, 0113711, 0044407,
  81. };
  82. #endif
  83. #ifdef IBMPC
  84. static unsigned short P[] = {
  85. 0x1bb0, 0x93c3, 0xb4c2, 0x3f1a, 0x52f2, 0x3f56, 0xd6f5, 0x3fdf,
  86. 0x6911, 0xed92, 0xd2ba, 0x4012, 0xeb2e, 0xc63e, 0xff72, 0x402c,
  87. 0xc84d, 0x924b, 0xefd6, 0x4031, 0xdcf8, 0x7d7e, 0xd563, 0x401e,
  88. };
  89. static unsigned short Q[] = {
  90. /*0x0000,0x0000,0x0000,0x3ff0,*/
  91. 0xef8e, 0xae97, 0x9320, 0x4026, 0xc033, 0x4e19, 0x9d2c,
  92. 0x4046, 0xbdbd, 0xa326, 0xbf33, 0x4054, 0xae21, 0xeb5e,
  93. 0xc9e2, 0x4051, 0x25b2, 0x9e1f, 0x200a, 0x4037,
  94. };
  95. #endif
  96. #ifdef MIEEE
  97. static unsigned short P[] = {
  98. 0x3f1a, 0xb4c2, 0x93c3, 0x1bb0, 0x3fdf, 0xd6f5, 0x3f56, 0x52f2,
  99. 0x4012, 0xd2ba, 0xed92, 0x6911, 0x402c, 0xff72, 0xc63e, 0xeb2e,
  100. 0x4031, 0xefd6, 0x924b, 0xc84d, 0x401e, 0xd563, 0x7d7e, 0xdcf8,
  101. };
  102. static unsigned short Q[] = {
  103. /*0x3ff0,0x0000,0x0000,0x0000,*/
  104. 0x4026, 0x9320, 0xae97, 0xef8e, 0x4046, 0x9d2c, 0x4e19,
  105. 0xc033, 0x4054, 0xbf33, 0xa326, 0xbdbd, 0x4051, 0xc9e2,
  106. 0xeb5e, 0xae21, 0x4037, 0x200a, 0x9e1f, 0x25b2,
  107. };
  108. #endif
  109. /* Coefficients for log(x) = z + z**3 P(z)/Q(z),
  110. * where z = 2(x-1)/(x+1)
  111. * 1/sqrt(2) <= x < sqrt(2)
  112. */
  113. #ifdef UNK
  114. static double R[3] = {
  115. -7.89580278884799154124E-1,
  116. 1.63866645699558079767E1,
  117. -6.41409952958715622951E1,
  118. };
  119. static double S[3] = {
  120. /* 1.00000000000000000000E0,*/
  121. -3.56722798256324312549E1,
  122. 3.12093766372244180303E2,
  123. -7.69691943550460008604E2,
  124. };
  125. #endif
  126. #ifdef DEC
  127. static unsigned short R[12] = {
  128. 0140112, 0020756, 0161540, 0072035, 0041203, 0013743,
  129. 0114023, 0155527, 0141600, 0044060, 0104421, 0050400,
  130. };
  131. static unsigned short S[12] = {
  132. /*0040200,0000000,0000000,0000000,*/
  133. 0141416, 0130152, 0017543, 0064122, 0042234, 0006000,
  134. 0104527, 0020155, 0142500, 0066110, 0146631, 0174731,
  135. };
  136. #endif
  137. #ifdef IBMPC
  138. static unsigned short R[12] = {
  139. 0x0e84, 0xdc6c, 0x443d, 0xbfe9, 0x7b6b, 0x7302,
  140. 0x62fc, 0x4030, 0x2a20, 0x1122, 0x0906, 0xc050,
  141. };
  142. static unsigned short S[12] = {
  143. /*0x0000,0x0000,0x0000,0x3ff0,*/
  144. 0x6d0a, 0x43ec, 0xd60d, 0xc041, 0xe40e, 0x112a,
  145. 0x8180, 0x4073, 0x3f3b, 0x19b3, 0x0d89, 0xc088,
  146. };
  147. #endif
  148. #ifdef MIEEE
  149. static unsigned short R[12] = {
  150. 0xbfe9, 0x443d, 0xdc6c, 0x0e84, 0x4030, 0x62fc,
  151. 0x7302, 0x7b6b, 0xc050, 0x0906, 0x1122, 0x2a20,
  152. };
  153. static unsigned short S[12] = {
  154. /*0x3ff0,0x0000,0x0000,0x0000,*/
  155. 0xc041, 0xd60d, 0x43ec, 0x6d0a, 0x4073, 0x8180,
  156. 0x112a, 0xe40e, 0xc088, 0x0d89, 0x19b3, 0x3f3b,
  157. };
  158. #endif
  159. #ifdef ANSIPROT
  160. extern double frexp(double, int *);
  161. extern double ldexp(double, int);
  162. extern double polevl(double, void *, int);
  163. extern double p1evl(double, void *, int);
  164. extern int isnan(double);
  165. extern int isfinite(double);
  166. #else
  167. double frexp(), ldexp(), polevl(), p1evl();
  168. int isnan(), isfinite();
  169. #endif
  170. #define SQRTH 0.70710678118654752440
  171. extern double INFINITY, NAN;
  172. double log(x) double x;
  173. {
  174. int e;
  175. #ifdef DEC
  176. short *q;
  177. #endif
  178. double y, z;
  179. #ifdef NANS
  180. if (isnan(x))
  181. return (x);
  182. #endif
  183. #ifdef INFINITIES
  184. if (x == INFINITY)
  185. return (x);
  186. #endif
  187. /* Test for domain */
  188. if (x <= 0.0) {
  189. if (x == 0.0) {
  190. mtherr(fname, SING);
  191. return (-INFINITY);
  192. } else {
  193. mtherr(fname, DOMAIN);
  194. return (NAN);
  195. }
  196. }
  197. /* separate mantissa from exponent */
  198. #ifdef DEC
  199. q = (short *)&x;
  200. e = *q; /* short containing exponent */
  201. e = ((e >> 7) & 0377) - 0200; /* the exponent */
  202. *q &= 0177; /* strip exponent from x */
  203. *q |= 040000; /* x now between 0.5 and 1 */
  204. #endif
  205. /* Note, frexp is used so that denormal numbers
  206. * will be handled properly.
  207. */
  208. #ifdef IBMPC
  209. x = frexp(x, &e);
  210. /*
  211. q = (short *)&x;
  212. q += 3;
  213. e = *q;
  214. e = ((e >> 4) & 0x0fff) - 0x3fe;
  215. *q &= 0x0f;
  216. *q |= 0x3fe0;
  217. */
  218. #endif
  219. /* Equivalent C language standard library function: */
  220. #ifdef UNK
  221. x = frexp(x, &e);
  222. #endif
  223. #ifdef MIEEE
  224. x = frexp(x, &e);
  225. #endif
  226. /* logarithm using log(x) = z + z**3 P(z)/Q(z),
  227. * where z = 2(x-1)/x+1)
  228. */
  229. if ((e > 2) || (e < -2)) {
  230. if (x < SQRTH) { /* 2( 2x-1 )/( 2x+1 ) */
  231. e -= 1;
  232. z = x - 0.5;
  233. y = 0.5 * z + 0.5;
  234. } else { /* 2 (x-1)/(x+1) */
  235. z = x - 0.5;
  236. z -= 0.5;
  237. y = 0.5 * x + 0.5;
  238. }
  239. x = z / y;
  240. /* rational form */
  241. z = x * x;
  242. z = x * (z * polevl(z, R, 2) / p1evl(z, S, 3));
  243. y = e;
  244. z = z - y * 2.121944400546905827679e-4;
  245. z = z + x;
  246. z = z + e * 0.693359375;
  247. goto ldone;
  248. }
  249. /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */
  250. if (x < SQRTH) {
  251. e -= 1;
  252. x = ldexp(x, 1) - 1.0; /* 2x - 1 */
  253. } else {
  254. x = x - 1.0;
  255. }
  256. /* rational form */
  257. z = x * x;
  258. #if DEC
  259. y = x * (z * polevl(x, P, 5) / p1evl(x, Q, 6));
  260. #else
  261. y = x * (z * polevl(x, P, 5) / p1evl(x, Q, 5));
  262. #endif
  263. if (e)
  264. y = y - e * 2.121944400546905827679e-4;
  265. y = y - ldexp(z, -1); /* y - 0.5 * z */
  266. z = x + y;
  267. if (e)
  268. z = z + e * 0.693359375;
  269. ldone:
  270. return (z);
  271. }