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