ellpel.c 4.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173
  1. /* ellpel.c
  2. *
  3. * Complete elliptic integral of the second kind
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * long double m1, y, ellpel();
  10. *
  11. * y = ellpel( m1 );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. * Approximates the integral
  18. *
  19. *
  20. * pi/2
  21. * -
  22. * | | 2
  23. * E(m) = | sqrt( 1 - m sin t ) dt
  24. * | |
  25. * -
  26. * 0
  27. *
  28. * Where m = 1 - m1, using the approximation
  29. *
  30. * P(x) - x log x Q(x).
  31. *
  32. * Though there are no singularities, the argument m1 is used
  33. * rather than m for compatibility with ellpk().
  34. *
  35. * E(1) = 1; E(0) = pi/2.
  36. *
  37. *
  38. * ACCURACY:
  39. *
  40. * Relative error:
  41. * arithmetic domain # trials peak rms
  42. * IEEE 0, 1 10000 1.1e-19 3.5e-20
  43. *
  44. *
  45. * ERROR MESSAGES:
  46. *
  47. * message condition value returned
  48. * ellpel domain x<0, x>1 0.0
  49. *
  50. */
  51. /* ellpe.c */
  52. /* Elliptic integral of second kind */
  53. /*
  54. Cephes Math Library, Release 2.3: October, 1995
  55. Copyright 1984, 1987, 1989, 1995 by Stephen L. Moshier
  56. */
  57. #include <math.h>
  58. #if UNK
  59. static long double P[12] = {
  60. 3.198937812032341294902E-5L,
  61. 7.742523238588775116241E-4L,
  62. 4.140384701571542000550E-3L,
  63. 7.963509564694454269086E-3L,
  64. 7.280911706839967541799E-3L,
  65. 5.044067167184043853799E-3L,
  66. 5.076832243257395296304E-3L,
  67. 7.155775630578315248130E-3L,
  68. 1.154485760526450950611E-2L,
  69. 2.183137319801117971860E-2L,
  70. 5.680519271556930583433E-2L,
  71. 4.431471805599467050354E-1L,
  72. };
  73. static long double Q[12] = {
  74. 6.393938134301205485085E-6L,
  75. 2.741404591220851603273E-4L,
  76. 2.480876752984331133799E-3L,
  77. 8.770638497964078750003E-3L,
  78. 1.676835725889463343319E-2L,
  79. 2.281970801531577700830E-2L,
  80. 2.767367465121309044166E-2L,
  81. 3.364167778770018154356E-2L,
  82. 4.272453406734691973083E-2L,
  83. 5.859374951483909267451E-2L,
  84. 9.374999999923942267270E-2L,
  85. 2.499999999999998643587E-1L,
  86. };
  87. #endif
  88. #if IBMPC
  89. static short P[] = {
  90. 0x7a78,0x5a02,0x554d,0x862c,0x3ff0, XPD
  91. 0x34db,0xa965,0x31a3,0xcaf7,0x3ff4, XPD
  92. 0xca6c,0x6c00,0x1071,0x87ac,0x3ff7, XPD
  93. 0x4cdb,0x125d,0x6149,0x8279,0x3ff8, XPD
  94. 0xadbd,0x3d8f,0xb6d5,0xee94,0x3ff7, XPD
  95. 0x8189,0xcd0e,0xb3c2,0xa548,0x3ff7, XPD
  96. 0x32b5,0xdd64,0x8e39,0xa65b,0x3ff7, XPD
  97. 0x0344,0xc9db,0xff27,0xea7a,0x3ff7, XPD
  98. 0xba2d,0x806a,0xa476,0xbd26,0x3ff8, XPD
  99. 0xc3e0,0x30fa,0xb53d,0xb2d7,0x3ff9, XPD
  100. 0x23b8,0x4d33,0x8fcf,0xe8ac,0x3ffa, XPD
  101. 0xbc79,0xa39f,0x2fef,0xe2e4,0x3ffd, XPD
  102. };
  103. static short Q[] = {
  104. 0x89f1,0xe234,0x82a6,0xd68b,0x3fed, XPD
  105. 0x202a,0x96b3,0x8273,0x8fba,0x3ff3, XPD
  106. 0xc183,0xfc45,0x3484,0xa296,0x3ff6, XPD
  107. 0x683e,0xe201,0xb960,0x8fb2,0x3ff8, XPD
  108. 0x721a,0x1b6a,0xcb41,0x895d,0x3ff9, XPD
  109. 0x4eee,0x295f,0x6574,0xbaf0,0x3ff9, XPD
  110. 0x3ade,0xc98f,0xe6f2,0xe2b3,0x3ff9, XPD
  111. 0xd470,0x1784,0xdb1e,0x89cb,0x3ffa, XPD
  112. 0xa649,0xe5c1,0xebc8,0xaeff,0x3ffa, XPD
  113. 0x84c0,0xa8f5,0xffde,0xefff,0x3ffa, XPD
  114. 0x5506,0xf94f,0xffff,0xbfff,0x3ffb, XPD
  115. 0xd8e7,0xffff,0xffff,0xffff,0x3ffc, XPD
  116. };
  117. #endif
  118. #if MIEEE
  119. static long P[36] = {
  120. 0x3ff00000,0x862c554d,0x5a027a78,
  121. 0x3ff40000,0xcaf731a3,0xa96534db,
  122. 0x3ff70000,0x87ac1071,0x6c00ca6c,
  123. 0x3ff80000,0x82796149,0x125d4cdb,
  124. 0x3ff70000,0xee94b6d5,0x3d8fadbd,
  125. 0x3ff70000,0xa548b3c2,0xcd0e8189,
  126. 0x3ff70000,0xa65b8e39,0xdd6432b5,
  127. 0x3ff70000,0xea7aff27,0xc9db0344,
  128. 0x3ff80000,0xbd26a476,0x806aba2d,
  129. 0x3ff90000,0xb2d7b53d,0x30fac3e0,
  130. 0x3ffa0000,0xe8ac8fcf,0x4d3323b8,
  131. 0x3ffd0000,0xe2e42fef,0xa39fbc79,
  132. };
  133. static long Q[36] = {
  134. 0x3fed0000,0xd68b82a6,0xe23489f1,
  135. 0x3ff30000,0x8fba8273,0x96b3202a,
  136. 0x3ff60000,0xa2963484,0xfc45c183,
  137. 0x3ff80000,0x8fb2b960,0xe201683e,
  138. 0x3ff90000,0x895dcb41,0x1b6a721a,
  139. 0x3ff90000,0xbaf06574,0x295f4eee,
  140. 0x3ff90000,0xe2b3e6f2,0xc98f3ade,
  141. 0x3ffa0000,0x89cbdb1e,0x1784d470,
  142. 0x3ffa0000,0xaeffebc8,0xe5c1a649,
  143. 0x3ffa0000,0xefffffde,0xa8f584c0,
  144. 0x3ffb0000,0xbfffffff,0xf94f5506,
  145. 0x3ffc0000,0xffffffff,0xffffd8e7,
  146. };
  147. #endif
  148. #ifdef ANSIPROT
  149. extern long double polevll ( long double, void *, int );
  150. extern long double logl ( long double );
  151. #else
  152. long double polevll(), logl();
  153. #endif
  154. long double ellpel(x)
  155. long double x;
  156. {
  157. if( (x <= 0.0L) || (x > 1.0L) )
  158. {
  159. if( x == 0.0L )
  160. return( 1.0L );
  161. mtherr( "ellpel", DOMAIN );
  162. return( 0.0L );
  163. }
  164. return( 1.0L + x * polevll(x,P,11) - logl(x) * (x * polevll(x,Q,11)) );
  165. }