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