exp10l.c 4.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192
  1. /* exp10l.c
  2. *
  3. * Base 10 exponential function, long double precision
  4. * (Common antilogarithm)
  5. *
  6. *
  7. *
  8. * SYNOPSIS:
  9. *
  10. * long double x, y, exp10l()
  11. *
  12. * y = exp10l( x );
  13. *
  14. *
  15. *
  16. * DESCRIPTION:
  17. *
  18. * Returns 10 raised to the x power.
  19. *
  20. * Range reduction is accomplished by expressing the argument
  21. * as 10**x = 2**n 10**f, with |f| < 0.5 log10(2).
  22. * The Pade' form
  23. *
  24. * 1 + 2x P(x**2)/( Q(x**2) - P(x**2) )
  25. *
  26. * is used to approximate 10**f.
  27. *
  28. *
  29. *
  30. * ACCURACY:
  31. *
  32. * Relative error:
  33. * arithmetic domain # trials peak rms
  34. * IEEE +-4900 30000 1.0e-19 2.7e-20
  35. *
  36. * ERROR MESSAGES:
  37. *
  38. * message condition value returned
  39. * exp10l underflow x < -MAXL10 0.0
  40. * exp10l overflow x > MAXL10 MAXNUM
  41. *
  42. * IEEE arithmetic: MAXL10 = 4932.0754489586679023819
  43. *
  44. */
  45. /*
  46. Cephes Math Library Release 2.2: January, 1991
  47. Copyright 1984, 1991 by Stephen L. Moshier
  48. Direct inquiries to 30 Frost Street, Cambridge, MA 02140
  49. */
  50. #include <math.h>
  51. #ifdef UNK
  52. static long double P[] = {
  53. 3.1341179396892496811523E1L,
  54. 4.5618283154904699073999E3L,
  55. 1.3433113468542797218610E5L,
  56. 7.6025447914440301593592E5L,
  57. };
  58. static long double Q[] = {
  59. /* 1.0000000000000000000000E0,*/
  60. 4.7705440288425157637739E2L,
  61. 2.9732606548049614870598E4L,
  62. 4.0843697951001026189583E5L,
  63. 6.6034865026929015925608E5L,
  64. };
  65. /*static long double LOG102 = 3.0102999566398119521373889e-1L;*/
  66. static long double LOG210 = 3.3219280948873623478703L;
  67. static long double LG102A = 3.01025390625e-1L;
  68. static long double LG102B = 4.6050389811952137388947e-6L;
  69. #endif
  70. #ifdef IBMPC
  71. static short P[] = {
  72. 0x399a,0x7dc7,0xbc43,0xfaba,0x4003, XPD
  73. 0xb526,0xdf32,0xa063,0x8e8e,0x400b, XPD
  74. 0x18da,0xafa1,0xc89e,0x832e,0x4010, XPD
  75. 0x503d,0x9352,0xe7aa,0xb99b,0x4012, XPD
  76. };
  77. static short Q[] = {
  78. /*0x0000,0x0000,0x0000,0x8000,0x3fff,*/
  79. 0x947d,0x7855,0xf6ac,0xee86,0x4007, XPD
  80. 0x18cf,0x7749,0x368d,0xe849,0x400d, XPD
  81. 0x85be,0x2560,0x9f58,0xc76e,0x4011, XPD
  82. 0x6d3c,0x80c5,0xca67,0xa137,0x4012, XPD
  83. };
  84. /*
  85. static short L102[] = {0xf799,0xfbcf,0x9a84,0x9a20,0x3ffd, XPD};
  86. #define LOG102 *(long double *)L102
  87. */
  88. static short L210[] = {0x8afe,0xcd1b,0x784b,0xd49a,0x4000, XPD};
  89. #define LOG210 *(long double *)L210
  90. static short L102A[] = {0x0000,0x0000,0x0000,0x9a20,0x3ffd, XPD};
  91. #define LG102A *(long double *)L102A
  92. static short L102B[] = {0x8f89,0xf798,0xfbcf,0x9a84,0x3fed, XPD};
  93. #define LG102B *(long double *)L102B
  94. #endif
  95. #ifdef MIEEE
  96. static long P[] = {
  97. 0x40030000,0xfababc43,0x7dc7399a,
  98. 0x400b0000,0x8e8ea063,0xdf32b526,
  99. 0x40100000,0x832ec89e,0xafa118da,
  100. 0x40120000,0xb99be7aa,0x9352503d,
  101. };
  102. static long Q[] = {
  103. /* 0x3fff0000,0x80000000,0x00000000, */
  104. 0x40070000,0xee86f6ac,0x7855947d,
  105. 0x400d0000,0xe849368d,0x774918cf,
  106. 0x40110000,0xc76e9f58,0x256085be,
  107. 0x40120000,0xa137ca67,0x80c56d3c,
  108. };
  109. /*
  110. static long L102[] = {0x3ffd0000,0x9a209a84,0xfbcff799};
  111. #define LOG102 *(long double *)L102
  112. */
  113. static long L210[] = {0x40000000,0xd49a784b,0xcd1b8afe};
  114. #define LOG210 *(long double *)L210
  115. static long L102A[] = {0x3ffd0000,0x9a200000,0x00000000};
  116. #define LG102A *(long double *)L102A
  117. static long L102B[] = {0x3fed0000,0x9a84fbcf,0xf7988f89};
  118. #define LG102B *(long double *)L102B
  119. #endif
  120. static long double MAXL10 = 4.9320754489586679023819e3L;
  121. extern long double MAXNUML;
  122. #ifdef ANSIPROT
  123. extern long double floorl ( long double );
  124. extern long double ldexpl ( long double, int );
  125. extern long double polevll ( long double, void *, int );
  126. extern long double p1evll ( long double, void *, int );
  127. extern int isnanl ( long double );
  128. #else
  129. long double floorl(), ldexpl(), polevll(), p1evll(), isnanl();
  130. #endif
  131. #ifdef INFINITIES
  132. extern long double INFINITYL;
  133. #endif
  134. long double exp10l(x)
  135. long double x;
  136. {
  137. long double px, xx;
  138. short n;
  139. #ifdef NANS
  140. if( isnanl(x) )
  141. return(x);
  142. #endif
  143. if( x > MAXL10 )
  144. {
  145. #ifdef INFINITIES
  146. return( INFINITYL );
  147. #else
  148. mtherr( "exp10l", OVERFLOW );
  149. return( MAXNUML );
  150. #endif
  151. }
  152. if( x < -MAXL10 ) /* Would like to use MINLOG but can't */
  153. {
  154. #ifndef INFINITIES
  155. mtherr( "exp10l", UNDERFLOW );
  156. #endif
  157. return(0.0L);
  158. }
  159. /* Express 10**x = 10**g 2**n
  160. * = 10**g 10**( n log10(2) )
  161. * = 10**( g + n log10(2) )
  162. */
  163. px = floorl( LOG210 * x + 0.5L );
  164. n = px;
  165. x -= px * LG102A;
  166. x -= px * LG102B;
  167. /* rational approximation for exponential
  168. * of the fractional part:
  169. * 10**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) )
  170. */
  171. xx = x * x;
  172. px = x * polevll( xx, P, 3 );
  173. x = px/( p1evll( xx, Q, 4 ) - px );
  174. x = 1.0L + ldexpl( x, 1 );
  175. /* multiply by power of 2 */
  176. x = ldexpl( x, n );
  177. return(x);
  178. }