tan.c 5.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304
  1. /* tan.c
  2. *
  3. * Circular tangent
  4. *
  5. *
  6. *
  7. * SYNOPSIS:
  8. *
  9. * double x, y, tan();
  10. *
  11. * y = tan( x );
  12. *
  13. *
  14. *
  15. * DESCRIPTION:
  16. *
  17. * Returns the circular tangent of the radian argument x.
  18. *
  19. * Range reduction is modulo pi/4. A rational function
  20. * x + x**3 P(x**2)/Q(x**2)
  21. * is employed in the basic interval [0, pi/4].
  22. *
  23. *
  24. *
  25. * ACCURACY:
  26. *
  27. * Relative error:
  28. * arithmetic domain # trials peak rms
  29. * DEC +-1.07e9 44000 4.1e-17 1.0e-17
  30. * IEEE +-1.07e9 30000 2.9e-16 8.1e-17
  31. *
  32. * ERROR MESSAGES:
  33. *
  34. * message condition value returned
  35. * tan total loss x > 1.073741824e9 0.0
  36. *
  37. */
  38. /* cot.c
  39. *
  40. * Circular cotangent
  41. *
  42. *
  43. *
  44. * SYNOPSIS:
  45. *
  46. * double x, y, cot();
  47. *
  48. * y = cot( x );
  49. *
  50. *
  51. *
  52. * DESCRIPTION:
  53. *
  54. * Returns the circular cotangent of the radian argument x.
  55. *
  56. * Range reduction is modulo pi/4. A rational function
  57. * x + x**3 P(x**2)/Q(x**2)
  58. * is employed in the basic interval [0, pi/4].
  59. *
  60. *
  61. *
  62. * ACCURACY:
  63. *
  64. * Relative error:
  65. * arithmetic domain # trials peak rms
  66. * IEEE +-1.07e9 30000 2.9e-16 8.2e-17
  67. *
  68. *
  69. * ERROR MESSAGES:
  70. *
  71. * message condition value returned
  72. * cot total loss x > 1.073741824e9 0.0
  73. * cot singularity x = 0 INFINITY
  74. *
  75. */
  76. /*
  77. Cephes Math Library Release 2.8: June, 2000
  78. yright 1984, 1995, 2000 by Stephen L. Moshier
  79. */
  80. #include <math.h>
  81. #ifdef UNK
  82. static double P[] = {
  83. -1.30936939181383777646E4,
  84. 1.15351664838587416140E6,
  85. -1.79565251976484877988E7
  86. };
  87. static double Q[] = {
  88. /* 1.00000000000000000000E0,*/
  89. 1.36812963470692954678E4,
  90. -1.32089234440210967447E6,
  91. 2.50083801823357915839E7,
  92. -5.38695755929454629881E7
  93. };
  94. static double DP1 = 7.853981554508209228515625E-1;
  95. static double DP2 = 7.94662735614792836714E-9;
  96. static double DP3 = 3.06161699786838294307E-17;
  97. static double lossth = 1.073741824e9;
  98. #endif
  99. #ifdef DEC
  100. static unsigned short P[] = {
  101. 0143514,0113306,0111171,0174674,
  102. 0045214,0147545,0027744,0167346,
  103. 0146210,0177526,0114514,0105660
  104. };
  105. static unsigned short Q[] = {
  106. /*0040200,0000000,0000000,0000000,*/
  107. 0043525,0142457,0072633,0025617,
  108. 0145241,0036742,0140525,0162256,
  109. 0046276,0146176,0013526,0143573,
  110. 0146515,0077401,0162762,0150607
  111. };
  112. /* 7.853981629014015197753906250000E-1 */
  113. static unsigned short P1[] = {0040111,0007732,0120000,0000000,};
  114. /* 4.960467869796758577649598009884E-10 */
  115. static unsigned short P2[] = {0030410,0055060,0100000,0000000,};
  116. /* 2.860594363054915898381331279295E-18 */
  117. static unsigned short P3[] = {0021523,0011431,0105056,0001560,};
  118. #define DP1 *(double *)P1
  119. #define DP2 *(double *)P2
  120. #define DP3 *(double *)P3
  121. static double lossth = 1.073741824e9;
  122. #endif
  123. #ifdef IBMPC
  124. static unsigned short P[] = {
  125. 0x3f38,0xd24f,0x92d8,0xc0c9,
  126. 0x9ddd,0xa5fc,0x99ec,0x4131,
  127. 0x9176,0xd329,0x1fea,0xc171
  128. };
  129. static unsigned short Q[] = {
  130. /*0x0000,0x0000,0x0000,0x3ff0,*/
  131. 0x6572,0xeeb3,0xb8a5,0x40ca,
  132. 0xbc96,0x582a,0x27bc,0xc134,
  133. 0xd8ef,0xc2ea,0xd98f,0x4177,
  134. 0x5a31,0x3cbe,0xafe0,0xc189
  135. };
  136. /*
  137. 7.85398125648498535156E-1,
  138. 3.77489470793079817668E-8,
  139. 2.69515142907905952645E-15,
  140. */
  141. static unsigned short P1[] = {0x0000,0x4000,0x21fb,0x3fe9};
  142. static unsigned short P2[] = {0x0000,0x0000,0x442d,0x3e64};
  143. static unsigned short P3[] = {0x5170,0x98cc,0x4698,0x3ce8};
  144. #define DP1 *(double *)P1
  145. #define DP2 *(double *)P2
  146. #define DP3 *(double *)P3
  147. static double lossth = 1.073741824e9;
  148. #endif
  149. #ifdef MIEEE
  150. static unsigned short P[] = {
  151. 0xc0c9,0x92d8,0xd24f,0x3f38,
  152. 0x4131,0x99ec,0xa5fc,0x9ddd,
  153. 0xc171,0x1fea,0xd329,0x9176
  154. };
  155. static unsigned short Q[] = {
  156. 0x40ca,0xb8a5,0xeeb3,0x6572,
  157. 0xc134,0x27bc,0x582a,0xbc96,
  158. 0x4177,0xd98f,0xc2ea,0xd8ef,
  159. 0xc189,0xafe0,0x3cbe,0x5a31
  160. };
  161. static unsigned short P1[] = {
  162. 0x3fe9,0x21fb,0x4000,0x0000
  163. };
  164. static unsigned short P2[] = {
  165. 0x3e64,0x442d,0x0000,0x0000
  166. };
  167. static unsigned short P3[] = {
  168. 0x3ce8,0x4698,0x98cc,0x5170,
  169. };
  170. #define DP1 *(double *)P1
  171. #define DP2 *(double *)P2
  172. #define DP3 *(double *)P3
  173. static double lossth = 1.073741824e9;
  174. #endif
  175. #ifdef ANSIPROT
  176. extern double polevl ( double, void *, int );
  177. extern double p1evl ( double, void *, int );
  178. extern double floor ( double );
  179. extern double ldexp ( double, int );
  180. extern int isnan ( double );
  181. extern int isfinite ( double );
  182. static double tancot(double, int);
  183. #else
  184. double polevl(), p1evl(), floor(), ldexp();
  185. static double tancot();
  186. int isnan(), isfinite();
  187. #endif
  188. extern double PIO4;
  189. extern double INFINITY;
  190. extern double NAN;
  191. double tan(x)
  192. double x;
  193. {
  194. #ifdef MINUSZERO
  195. if( x == 0.0 )
  196. return(x);
  197. #endif
  198. #ifdef NANS
  199. if( isnan(x) )
  200. return(x);
  201. if( !isfinite(x) )
  202. {
  203. mtherr( "tan", DOMAIN );
  204. return(NAN);
  205. }
  206. #endif
  207. return( tancot(x,0) );
  208. }
  209. double cot(x)
  210. double x;
  211. {
  212. if( x == 0.0 )
  213. {
  214. mtherr( "cot", SING );
  215. return( INFINITY );
  216. }
  217. return( tancot(x,1) );
  218. }
  219. static double tancot( xx, cotflg )
  220. double xx;
  221. int cotflg;
  222. {
  223. double x, y, z, zz;
  224. int j, sign;
  225. /* make argument positive but save the sign */
  226. if( xx < 0 )
  227. {
  228. x = -xx;
  229. sign = -1;
  230. }
  231. else
  232. {
  233. x = xx;
  234. sign = 1;
  235. }
  236. if( x > lossth )
  237. {
  238. if( cotflg )
  239. mtherr( "cot", TLOSS );
  240. else
  241. mtherr( "tan", TLOSS );
  242. return(0.0);
  243. }
  244. /* compute x mod PIO4 */
  245. y = floor( x/PIO4 );
  246. /* strip high bits of integer part */
  247. z = ldexp( y, -3 );
  248. z = floor(z); /* integer part of y/8 */
  249. z = y - ldexp( z, 3 ); /* y - 16 * (y/16) */
  250. /* integer and fractional part modulo one octant */
  251. j = z;
  252. /* map zeros and singularities to origin */
  253. if( j & 1 )
  254. {
  255. j += 1;
  256. y += 1.0;
  257. }
  258. z = ((x - y * DP1) - y * DP2) - y * DP3;
  259. zz = z * z;
  260. if( zz > 1.0e-14 )
  261. y = z + z * (zz * polevl( zz, P, 2 )/p1evl(zz, Q, 4));
  262. else
  263. y = z;
  264. if( j & 2 )
  265. {
  266. if( cotflg )
  267. y = -y;
  268. else
  269. y = -1.0/y;
  270. }
  271. else
  272. {
  273. if( cotflg )
  274. y = 1.0/y;
  275. }
  276. if( sign < 0 )
  277. y = -y;
  278. return( y );
  279. }