/newlib/libm/complex/casin.c

https://bitbucket.org/pizzafactory/binutils · C · 165 lines · 36 code · 13 blank · 116 comment · 4 complexity · 526a0a154667cb773f56abd8fee14294 MD5 · raw file

  1. /* $NetBSD: casin.c,v 1.1 2007/08/20 16:01:31 drochner Exp $ */
  2. /*-
  3. * Copyright (c) 2007 The NetBSD Foundation, Inc.
  4. * All rights reserved.
  5. *
  6. * This code is derived from software written by Stephen L. Moshier.
  7. * It is redistributed by the NetBSD Foundation by permission of the author.
  8. *
  9. * Redistribution and use in source and binary forms, with or without
  10. * modification, are permitted provided that the following conditions
  11. * are met:
  12. * 1. Redistributions of source code must retain the above copyright
  13. * notice, this list of conditions and the following disclaimer.
  14. * 2. Redistributions in binary form must reproduce the above copyright
  15. * notice, this list of conditions and the following disclaimer in the
  16. * documentation and/or other materials provided with the distribution.
  17. *
  18. * THIS SOFTWARE IS PROVIDED BY THE NETBSD FOUNDATION, INC. AND CONTRIBUTORS
  19. * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
  20. * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
  21. * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE FOUNDATION OR CONTRIBUTORS
  22. * BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  23. * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  24. * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
  25. * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
  26. * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
  27. * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  28. * POSSIBILITY OF SUCH DAMAGE.
  29. *
  30. * imported and modified include for newlib 2010/10/03
  31. * Marco Atzeri <marco_atzeri@yahoo.it>
  32. */
  33. /*
  34. FUNCTION
  35. <<casin>>, <<casinf>>---complex arc sine
  36. INDEX
  37. casin
  38. INDEX
  39. casinf
  40. ANSI_SYNOPSIS
  41. #include <complex.h>
  42. double complex casin(double complex <[z]>);
  43. float complex casinf(float complex <[z]>);
  44. DESCRIPTION
  45. These functions compute the complex arc sine of <[z]>,
  46. with branch cuts outside the interval [-1, +1] along the real axis.
  47. <<casinf>> is identical to <<casin>>, except that it performs
  48. its calculations on <<floats complex>>.
  49. RETURNS
  50. @ifnottex
  51. These functions return the complex arc sine value, in the range
  52. of a strip mathematically unbounded along the imaginary axis
  53. and in the interval [-pi/2, +pi/2] along the real axis.
  54. @end ifnottex
  55. @tex
  56. These functions return the complex arc sine value, in the range
  57. of a strip mathematically unbounded along the imaginary axis
  58. and in the interval [$-\pi/2$, $+\pi/2$] along the real axis.
  59. @end tex
  60. PORTABILITY
  61. <<casin>> and <<casinf>> are ISO C99
  62. QUICKREF
  63. <<casin>> and <<casinf>> are ISO C99
  64. */
  65. #include <complex.h>
  66. #include <math.h>
  67. #ifdef __weak_alias
  68. __weak_alias(casin, _casin)
  69. #endif
  70. double complex
  71. casin(double complex z)
  72. {
  73. double complex w;
  74. double complex ca, ct, zz, z2;
  75. double x, y;
  76. x = creal(z);
  77. y = cimag(z);
  78. #if 0 /* MD: test is incorrect, casin(>1) is defined */
  79. if (y == 0.0) {
  80. if (fabs(x) > 1.0) {
  81. w = M_PI_2 + 0.0 * I;
  82. #if 0
  83. mtherr ("casin", DOMAIN);
  84. #endif
  85. } else {
  86. w = asin(x) + 0.0 * I;
  87. }
  88. return w;
  89. }
  90. #endif
  91. /* Power series expansion */
  92. /*
  93. b = cabs(z);
  94. if( b < 0.125 )
  95. {
  96. z2.r = (x - y) * (x + y);
  97. z2.i = 2.0 * x * y;
  98. cn = 1.0;
  99. n = 1.0;
  100. ca.r = x;
  101. ca.i = y;
  102. sum.r = x;
  103. sum.i = y;
  104. do
  105. {
  106. ct.r = z2.r * ca.r - z2.i * ca.i;
  107. ct.i = z2.r * ca.i + z2.i * ca.r;
  108. ca.r = ct.r;
  109. ca.i = ct.i;
  110. cn *= n;
  111. n += 1.0;
  112. cn /= n;
  113. n += 1.0;
  114. b = cn/n;
  115. ct.r *= b;
  116. ct.i *= b;
  117. sum.r += ct.r;
  118. sum.i += ct.i;
  119. b = fabs(ct.r) + fabs(ct.i);
  120. }
  121. while( b > MACHEP );
  122. w->r = sum.r;
  123. w->i = sum.i;
  124. return;
  125. }
  126. */
  127. ca = x + y * I;
  128. ct = ca * I;
  129. /* sqrt( 1 - z*z) */
  130. /* cmul( &ca, &ca, &zz ) */
  131. /*x * x - y * y */
  132. zz = (x - y) * (x + y) + (2.0 * x * y) * I;
  133. zz = 1.0 - creal(zz) - cimag(zz) * I;
  134. z2 = csqrt(zz);
  135. zz = ct + z2;
  136. zz = clog(zz);
  137. /* multiply by 1/i = -i */
  138. w = zz * (-1.0 * I);
  139. return w;
  140. }