expl.c 4.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183
  1. /* expl.c
  2. *
  3. * Exponential function, long double precision
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * long double x, y, expl();
  10. *
  11. * y = expl( x );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. * Returns e (2.71828...) raised to the x power.
  18. *
  19. * Range reduction is accomplished by separating the argument
  20. * into an integer k and fraction f such that
  21. *
  22. * x k f
  23. * e = 2 e.
  24. *
  25. * A Pade' form of degree 2/3 is used to approximate exp(f) - 1
  26. * in the basic range [-0.5 ln 2, 0.5 ln 2].
  27. *
  28. *
  29. * ACCURACY:
  30. *
  31. * Relative error:
  32. * arithmetic domain # trials peak rms
  33. * IEEE +-10000 50000 1.12e-19 2.81e-20
  34. *
  35. *
  36. * Error amplification in the exponential function can be
  37. * a serious matter. The error propagation involves
  38. * exp( X(1+delta) ) = exp(X) ( 1 + X*delta + ... ),
  39. * which shows that a 1 lsb error in representing X produces
  40. * a relative error of X times 1 lsb in the function.
  41. * While the routine gives an accurate result for arguments
  42. * that are exactly represented by a long double precision
  43. * computer number, the result contains amplified roundoff
  44. * error for large arguments not exactly represented.
  45. *
  46. *
  47. * ERROR MESSAGES:
  48. *
  49. * message condition value returned
  50. * exp underflow x < MINLOG 0.0
  51. * exp overflow x > MAXLOG MAXNUM
  52. *
  53. */
  54. /*
  55. Cephes Math Library Release 2.7: May, 1998
  56. Copyright 1984, 1990, 1998 by Stephen L. Moshier
  57. */
  58. /* Exponential function */
  59. #include <math.h>
  60. #ifdef UNK
  61. static long double P[3] = {
  62. 1.2617719307481059087798E-4L,
  63. 3.0299440770744196129956E-2L,
  64. 9.9999999999999999991025E-1L,
  65. };
  66. static long double Q[4] = {
  67. 3.0019850513866445504159E-6L,
  68. 2.5244834034968410419224E-3L,
  69. 2.2726554820815502876593E-1L,
  70. 2.0000000000000000000897E0L,
  71. };
  72. static long double C1 = 6.9314575195312500000000E-1L;
  73. static long double C2 = 1.4286068203094172321215E-6L;
  74. #endif
  75. #ifdef DEC
  76. not supported in long double precision
  77. #endif
  78. #ifdef IBMPC
  79. static short P[] = {
  80. 0x424e,0x225f,0x6eaf,0x844e,0x3ff2, XPD
  81. 0xf39e,0x5163,0x8866,0xf836,0x3ff9, XPD
  82. 0xfffe,0xffff,0xffff,0xffff,0x3ffe, XPD
  83. };
  84. static short Q[] = {
  85. 0xff1e,0xb2fc,0xb5e1,0xc975,0x3fec, XPD
  86. 0xff3e,0x45b5,0xcda8,0xa571,0x3ff6, XPD
  87. 0x9ee1,0x3f03,0x4cc4,0xe8b8,0x3ffc, XPD
  88. 0x0000,0x0000,0x0000,0x8000,0x4000, XPD
  89. };
  90. static short sc1[] = {0x0000,0x0000,0x0000,0xb172,0x3ffe, XPD};
  91. #define C1 (*(long double *)sc1)
  92. static short sc2[] = {0x4f1e,0xcd5e,0x8e7b,0xbfbe,0x3feb, XPD};
  93. #define C2 (*(long double *)sc2)
  94. #endif
  95. #ifdef MIEEE
  96. static long P[9] = {
  97. 0x3ff20000,0x844e6eaf,0x225f424e,
  98. 0x3ff90000,0xf8368866,0x5163f39e,
  99. 0x3ffe0000,0xffffffff,0xfffffffe,
  100. };
  101. static long Q[12] = {
  102. 0x3fec0000,0xc975b5e1,0xb2fcff1e,
  103. 0x3ff60000,0xa571cda8,0x45b5ff3e,
  104. 0x3ffc0000,0xe8b84cc4,0x3f039ee1,
  105. 0x40000000,0x80000000,0x00000000,
  106. };
  107. static long sc1[] = {0x3ffe0000,0xb1720000,0x00000000};
  108. #define C1 (*(long double *)sc1)
  109. static long sc2[] = {0x3feb0000,0xbfbe8e7b,0xcd5e4f1e};
  110. #define C2 (*(long double *)sc2)
  111. #endif
  112. extern long double LOG2EL, MAXLOGL, MINLOGL, MAXNUML;
  113. #ifdef ANSIPROT
  114. extern long double polevll ( long double, void *, int );
  115. extern long double floorl ( long double );
  116. extern long double ldexpl ( long double, int );
  117. extern int isnanl ( long double );
  118. #else
  119. long double polevll(), floorl(), ldexpl(), isnanl();
  120. #endif
  121. #ifdef INFINITIES
  122. extern long double INFINITYL;
  123. #endif
  124. long double expl(x)
  125. long double x;
  126. {
  127. long double px, xx;
  128. int n;
  129. #ifdef NANS
  130. if( isnanl(x) )
  131. return(x);
  132. #endif
  133. if( x > MAXLOGL)
  134. {
  135. #ifdef INFINITIES
  136. return( INFINITYL );
  137. #else
  138. mtherr( "expl", OVERFLOW );
  139. return( MAXNUML );
  140. #endif
  141. }
  142. if( x < MINLOGL )
  143. {
  144. #ifndef INFINITIES
  145. mtherr( "expl", UNDERFLOW );
  146. #endif
  147. return(0.0L);
  148. }
  149. /* Express e**x = e**g 2**n
  150. * = e**g e**( n loge(2) )
  151. * = e**( g + n loge(2) )
  152. */
  153. px = floorl( LOG2EL * x + 0.5L ); /* floor() truncates toward -infinity. */
  154. n = px;
  155. x -= px * C1;
  156. x -= px * C2;
  157. /* rational approximation for exponential
  158. * of the fractional part:
  159. * e**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) )
  160. */
  161. xx = x * x;
  162. px = x * polevll( xx, P, 2 );
  163. x = px/( polevll( xx, Q, 3 ) - px );
  164. x = 1.0L + ldexpl( x, 1 );
  165. x = ldexpl( x, n );
  166. return(x);
  167. }