casinl.c revision 1.1 1 1.1 christos /* $NetBSD: casinl.c,v 1.1 2014/10/10 00:48:18 christos Exp $ */
2 1.1 christos
3 1.1 christos /*-
4 1.1 christos * Copyright (c) 2007 The NetBSD Foundation, Inc.
5 1.1 christos * All rights reserved.
6 1.1 christos *
7 1.1 christos * This code is derived from software written by Stephen L. Moshier.
8 1.1 christos * It is redistributed by the NetBSD Foundation by permission of the author.
9 1.1 christos *
10 1.1 christos * Redistribution and use in source and binary forms, with or without
11 1.1 christos * modification, are permitted provided that the following conditions
12 1.1 christos * are met:
13 1.1 christos * 1. Redistributions of source code must retain the above copyright
14 1.1 christos * notice, this list of conditions and the following disclaimer.
15 1.1 christos * 2. Redistributions in binary form must reproduce the above copyright
16 1.1 christos * notice, this list of conditions and the following disclaimer in the
17 1.1 christos * documentation and/or other materials provided with the distribution.
18 1.1 christos *
19 1.1 christos * THIS SOFTWARE IS PROVIDED BY THE NETBSD FOUNDATION, INC. AND CONTRIBUTORS
20 1.1 christos * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
21 1.1 christos * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
22 1.1 christos * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE FOUNDATION OR CONTRIBUTORS
23 1.1 christos * BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
24 1.1 christos * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
25 1.1 christos * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
26 1.1 christos * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
27 1.1 christos * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
28 1.1 christos * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
29 1.1 christos * POSSIBILITY OF SUCH DAMAGE.
30 1.1 christos */
31 1.1 christos
32 1.1 christos #include "../src/namespace.h"
33 1.1 christos #include <complex.h>
34 1.1 christos #include <math.h>
35 1.1 christos
36 1.1 christos #ifdef __weak_alias
37 1.1 christos __weak_alias(casinl, _casinl)
38 1.1 christos #endif
39 1.1 christos
40 1.1 christos long double complex
41 1.1 christos casinl(long double complex z)
42 1.1 christos {
43 1.1 christos long double complex w;
44 1.1 christos long double complex ca, ct, zz, z2;
45 1.1 christos long double x, y;
46 1.1 christos
47 1.1 christos x = creall(z);
48 1.1 christos y = cimagl(z);
49 1.1 christos
50 1.1 christos #if 0 /* MD: test is incorrect, casin(>1) is defined */
51 1.1 christos if (y == 0.0L) {
52 1.1 christos if (fabsl(x) > 1.0L) {
53 1.1 christos w = M_PI_2L + 0.0L * I;
54 1.1 christos #if 0
55 1.1 christos mtherr ("casinl", DOMAIN);
56 1.1 christos #endif
57 1.1 christos } else {
58 1.1 christos w = asinl(x) + 0.0L * I;
59 1.1 christos }
60 1.1 christos return w;
61 1.1 christos }
62 1.1 christos #endif
63 1.1 christos
64 1.1 christos /* Power series expansion */
65 1.1 christos /*
66 1.1 christos b = cabsl(z);
67 1.1 christos if( b < 0.125L )
68 1.1 christos {
69 1.1 christos z2.r = (x - y) * (x + y);
70 1.1 christos z2.i = 2.0L * x * y;
71 1.1 christos
72 1.1 christos cn = 1.0L;
73 1.1 christos n = 1.0L;
74 1.1 christos ca.r = x;
75 1.1 christos ca.i = y;
76 1.1 christos sum.r = x;
77 1.1 christos sum.i = y;
78 1.1 christos do
79 1.1 christos {
80 1.1 christos ct.r = z2.r * ca.r - z2.i * ca.i;
81 1.1 christos ct.i = z2.r * ca.i + z2.i * ca.r;
82 1.1 christos ca.r = ct.r;
83 1.1 christos ca.i = ct.i;
84 1.1 christos
85 1.1 christos cn *= n;
86 1.1 christos n += 1.0;
87 1.1 christos cn /= n;
88 1.1 christos n += 1.0;
89 1.1 christos b = cn/n;
90 1.1 christos
91 1.1 christos ct.r *= b;
92 1.1 christos ct.i *= b;
93 1.1 christos sum.r += ct.r;
94 1.1 christos sum.i += ct.i;
95 1.1 christos b = fabsl(ct.r) + fabsl(ct.i);
96 1.1 christos }
97 1.1 christos while( b > MACHEPL );
98 1.1 christos w->r = sum.r;
99 1.1 christos w->i = sum.i;
100 1.1 christos return;
101 1.1 christos }
102 1.1 christos */
103 1.1 christos
104 1.1 christos
105 1.1 christos ca = x + y * I;
106 1.1 christos ct = ca * I;
107 1.1 christos /* sqrtl( 1 - z*z) */
108 1.1 christos /* cmull( &ca, &ca, &zz ) */
109 1.1 christos /*x * x - y * y */
110 1.1 christos zz = (x - y) * (x + y) + (2.0L * x * y) * I;
111 1.1 christos
112 1.1 christos zz = 1.0L - creall(zz) - cimagl(zz) * I;
113 1.1 christos z2 = csqrtl(zz);
114 1.1 christos
115 1.1 christos zz = ct + z2;
116 1.1 christos zz = clogl(zz);
117 1.1 christos /* multiply by 1/i = -i */
118 1.1 christos w = zz * (-1.0L * I);
119 1.1 christos return w;
120 1.1 christos }
121