log.c 6.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341
  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 <math.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,
  60. 4.97494994976747001425E-1,
  61. 4.70579119878881725854E0,
  62. 1.44989225341610930846E1,
  63. 1.79368678507819816313E1,
  64. 7.70838733755885391666E0,
  65. };
  66. static double Q[] = {
  67. /* 1.00000000000000000000E0, */
  68. 1.12873587189167450590E1,
  69. 4.52279145837532221105E1,
  70. 8.29875266912776603211E1,
  71. 7.11544750618563894466E1,
  72. 2.31251620126765340583E1,
  73. };
  74. #endif
  75. #ifdef DEC
  76. static unsigned short P[] = {
  77. 0037777,0127270,0162547,0057274,
  78. 0041001,0054665,0164317,0005341,
  79. 0041451,0034104,0031640,0105773,
  80. 0041677,0011276,0123617,0160135,
  81. 0041701,0126603,0053215,0117250,
  82. 0041420,0115777,0135206,0030232,
  83. };
  84. static unsigned short Q[] = {
  85. /*0040200,0000000,0000000,0000000,*/
  86. 0041220,0144332,0045272,0174241,
  87. 0041742,0164566,0035720,0130431,
  88. 0042246,0126327,0166065,0116357,
  89. 0042372,0033420,0157525,0124560,
  90. 0042271,0167002,0066537,0172303,
  91. 0041730,0164777,0113711,0044407,
  92. };
  93. #endif
  94. #ifdef IBMPC
  95. static unsigned short P[] = {
  96. 0x1bb0,0x93c3,0xb4c2,0x3f1a,
  97. 0x52f2,0x3f56,0xd6f5,0x3fdf,
  98. 0x6911,0xed92,0xd2ba,0x4012,
  99. 0xeb2e,0xc63e,0xff72,0x402c,
  100. 0xc84d,0x924b,0xefd6,0x4031,
  101. 0xdcf8,0x7d7e,0xd563,0x401e,
  102. };
  103. static unsigned short Q[] = {
  104. /*0x0000,0x0000,0x0000,0x3ff0,*/
  105. 0xef8e,0xae97,0x9320,0x4026,
  106. 0xc033,0x4e19,0x9d2c,0x4046,
  107. 0xbdbd,0xa326,0xbf33,0x4054,
  108. 0xae21,0xeb5e,0xc9e2,0x4051,
  109. 0x25b2,0x9e1f,0x200a,0x4037,
  110. };
  111. #endif
  112. #ifdef MIEEE
  113. static unsigned short P[] = {
  114. 0x3f1a,0xb4c2,0x93c3,0x1bb0,
  115. 0x3fdf,0xd6f5,0x3f56,0x52f2,
  116. 0x4012,0xd2ba,0xed92,0x6911,
  117. 0x402c,0xff72,0xc63e,0xeb2e,
  118. 0x4031,0xefd6,0x924b,0xc84d,
  119. 0x401e,0xd563,0x7d7e,0xdcf8,
  120. };
  121. static unsigned short Q[] = {
  122. /*0x3ff0,0x0000,0x0000,0x0000,*/
  123. 0x4026,0x9320,0xae97,0xef8e,
  124. 0x4046,0x9d2c,0x4e19,0xc033,
  125. 0x4054,0xbf33,0xa326,0xbdbd,
  126. 0x4051,0xc9e2,0xeb5e,0xae21,
  127. 0x4037,0x200a,0x9e1f,0x25b2,
  128. };
  129. #endif
  130. /* Coefficients for log(x) = z + z**3 P(z)/Q(z),
  131. * where z = 2(x-1)/(x+1)
  132. * 1/sqrt(2) <= x < sqrt(2)
  133. */
  134. #ifdef UNK
  135. static double R[3] = {
  136. -7.89580278884799154124E-1,
  137. 1.63866645699558079767E1,
  138. -6.41409952958715622951E1,
  139. };
  140. static double S[3] = {
  141. /* 1.00000000000000000000E0,*/
  142. -3.56722798256324312549E1,
  143. 3.12093766372244180303E2,
  144. -7.69691943550460008604E2,
  145. };
  146. #endif
  147. #ifdef DEC
  148. static unsigned short R[12] = {
  149. 0140112,0020756,0161540,0072035,
  150. 0041203,0013743,0114023,0155527,
  151. 0141600,0044060,0104421,0050400,
  152. };
  153. static unsigned short S[12] = {
  154. /*0040200,0000000,0000000,0000000,*/
  155. 0141416,0130152,0017543,0064122,
  156. 0042234,0006000,0104527,0020155,
  157. 0142500,0066110,0146631,0174731,
  158. };
  159. #endif
  160. #ifdef IBMPC
  161. static unsigned short R[12] = {
  162. 0x0e84,0xdc6c,0x443d,0xbfe9,
  163. 0x7b6b,0x7302,0x62fc,0x4030,
  164. 0x2a20,0x1122,0x0906,0xc050,
  165. };
  166. static unsigned short S[12] = {
  167. /*0x0000,0x0000,0x0000,0x3ff0,*/
  168. 0x6d0a,0x43ec,0xd60d,0xc041,
  169. 0xe40e,0x112a,0x8180,0x4073,
  170. 0x3f3b,0x19b3,0x0d89,0xc088,
  171. };
  172. #endif
  173. #ifdef MIEEE
  174. static unsigned short R[12] = {
  175. 0xbfe9,0x443d,0xdc6c,0x0e84,
  176. 0x4030,0x62fc,0x7302,0x7b6b,
  177. 0xc050,0x0906,0x1122,0x2a20,
  178. };
  179. static unsigned short S[12] = {
  180. /*0x3ff0,0x0000,0x0000,0x0000,*/
  181. 0xc041,0xd60d,0x43ec,0x6d0a,
  182. 0x4073,0x8180,0x112a,0xe40e,
  183. 0xc088,0x0d89,0x19b3,0x3f3b,
  184. };
  185. #endif
  186. #ifdef ANSIPROT
  187. extern double frexp ( double, int * );
  188. extern double ldexp ( double, int );
  189. extern double polevl ( double, void *, int );
  190. extern double p1evl ( double, void *, int );
  191. extern int isnan ( double );
  192. extern int isfinite ( double );
  193. #else
  194. double frexp(), ldexp(), polevl(), p1evl();
  195. int isnan(), isfinite();
  196. #endif
  197. #define SQRTH 0.70710678118654752440
  198. extern double INFINITY, NAN;
  199. double log(x)
  200. double x;
  201. {
  202. int e;
  203. #ifdef DEC
  204. short *q;
  205. #endif
  206. double y, z;
  207. #ifdef NANS
  208. if( isnan(x) )
  209. return(x);
  210. #endif
  211. #ifdef INFINITIES
  212. if( x == INFINITY )
  213. return(x);
  214. #endif
  215. /* Test for domain */
  216. if( x <= 0.0 )
  217. {
  218. if( x == 0.0 )
  219. {
  220. mtherr( fname, SING );
  221. return( -INFINITY );
  222. }
  223. else
  224. {
  225. mtherr( fname, DOMAIN );
  226. return( NAN );
  227. }
  228. }
  229. /* separate mantissa from exponent */
  230. #ifdef DEC
  231. q = (short *)&x;
  232. e = *q; /* short containing exponent */
  233. e = ((e >> 7) & 0377) - 0200; /* the exponent */
  234. *q &= 0177; /* strip exponent from x */
  235. *q |= 040000; /* x now between 0.5 and 1 */
  236. #endif
  237. /* Note, frexp is used so that denormal numbers
  238. * will be handled properly.
  239. */
  240. #ifdef IBMPC
  241. x = frexp( x, &e );
  242. /*
  243. q = (short *)&x;
  244. q += 3;
  245. e = *q;
  246. e = ((e >> 4) & 0x0fff) - 0x3fe;
  247. *q &= 0x0f;
  248. *q |= 0x3fe0;
  249. */
  250. #endif
  251. /* Equivalent C language standard library function: */
  252. #ifdef UNK
  253. x = frexp( x, &e );
  254. #endif
  255. #ifdef MIEEE
  256. x = frexp( x, &e );
  257. #endif
  258. /* logarithm using log(x) = z + z**3 P(z)/Q(z),
  259. * where z = 2(x-1)/x+1)
  260. */
  261. if( (e > 2) || (e < -2) )
  262. {
  263. if( x < SQRTH )
  264. { /* 2( 2x-1 )/( 2x+1 ) */
  265. e -= 1;
  266. z = x - 0.5;
  267. y = 0.5 * z + 0.5;
  268. }
  269. else
  270. { /* 2 (x-1)/(x+1) */
  271. z = x - 0.5;
  272. z -= 0.5;
  273. y = 0.5 * x + 0.5;
  274. }
  275. x = z / y;
  276. /* rational form */
  277. z = x*x;
  278. z = x * ( z * polevl( z, R, 2 ) / p1evl( z, S, 3 ) );
  279. y = e;
  280. z = z - y * 2.121944400546905827679e-4;
  281. z = z + x;
  282. z = z + e * 0.693359375;
  283. goto ldone;
  284. }
  285. /* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */
  286. if( x < SQRTH )
  287. {
  288. e -= 1;
  289. x = ldexp( x, 1 ) - 1.0; /* 2x - 1 */
  290. }
  291. else
  292. {
  293. x = x - 1.0;
  294. }
  295. /* rational form */
  296. z = x*x;
  297. #if DEC
  298. y = x * ( z * polevl( x, P, 5 ) / p1evl( x, Q, 6 ) );
  299. #else
  300. y = x * ( z * polevl( x, P, 5 ) / p1evl( x, Q, 5 ) );
  301. #endif
  302. if( e )
  303. y = y - e * 2.121944400546905827679e-4;
  304. y = y - ldexp( z, -1 ); /* y - 0.5 * z */
  305. z = x + y;
  306. if( e )
  307. z = z + e * 0.693359375;
  308. ldone:
  309. return( z );
  310. }