Back to index

glibc  2.9
s_tanhl.c
Go to the documentation of this file.
00001 /* @(#)s_tanh.c 5.1 93/09/24 */
00002 /*
00003  * ====================================================
00004  * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
00005  *
00006  * Developed at SunPro, a Sun Microsystems, Inc. business.
00007  * Permission to use, copy, modify, and distribute this
00008  * software is freely granted, provided that this notice
00009  * is preserved.
00010  * ====================================================
00011  */
00012 
00013 #if defined(LIBM_SCCS) && !defined(lint)
00014 static char rcsid[] = "$NetBSD: s_tanh.c,v 1.7 1995/05/10 20:48:22 jtc Exp $";
00015 #endif
00016 
00017 /* Tanh(x)
00018  * Return the Hyperbolic Tangent of x
00019  *
00020  * Method :
00021  *                                 x    -x
00022  *                                e  - e
00023  *     0. tanh(x) is defined to be -----------
00024  *                                 x    -x
00025  *                                e  + e
00026  *     1. reduce x to non-negative by tanh(-x) = -tanh(x).
00027  *     2.  0      <= x <= 2**-57 : tanh(x) := x*(one+x)
00028  *                                         -t
00029  *         2**-57 <  x <=  1     : tanh(x) := -----; t = expm1(-2x)
00030  *                                        t + 2
00031  *                                             2
00032  *         1      <= x <=  22.0  : tanh(x) := 1-  ----- ; t=expm1(2x)
00033  *                                           t + 2
00034  *         22.0   <  x <= INF    : tanh(x) := 1.
00035  *
00036  * Special cases:
00037  *     tanh(NaN) is NaN;
00038  *     only tanh(0)=0 is exact for finite argument.
00039  */
00040 
00041 #include "math.h"
00042 #include "math_private.h"
00043 #include <math_ldbl_opt.h>
00044 
00045 #ifdef __STDC__
00046 static const long double one=1.0L, two=2.0L, tiny = 1.0e-300L;
00047 #else
00048 static long double one=1.0L, two=2.0L, tiny = 1.0e-300L;
00049 #endif
00050 
00051 #ifdef __STDC__
00052        long double __tanhl(long double x)
00053 #else
00054        long double __tanhl(x)
00055        long double x;
00056 #endif
00057 {
00058        long double t,z;
00059        int64_t jx,ix,lx;
00060 
00061     /* High word of |x|. */
00062        GET_LDOUBLE_WORDS64(jx,lx,x);
00063        ix = jx&0x7fffffffffffffffLL;
00064 
00065     /* x is INF or NaN */
00066        if(ix>=0x7ff0000000000000LL) {
00067            if (jx>=0) return one/x+one;    /* tanh(+-inf)=+-1 */
00068            else       return one/x-one;    /* tanh(NaN) = NaN */
00069        }
00070 
00071     /* |x| < 22 */
00072        if (ix < 0x4036000000000000LL) {          /* |x|<22 */
00073            if ((ix | (lx&0x7fffffffffffffffLL)) == 0)
00074               return x;            /* x == +-0 */
00075            if (ix<0x3c60000000000000LL)   /* |x|<2**-57 */
00076               return x*(one+x);           /* tanh(small) = small */
00077            if (ix>=0x3ff0000000000000LL) {       /* |x|>=1  */
00078               t = __expm1l(two*fabsl(x));
00079               z = one - two/(t+two);
00080            } else {
00081                t = __expm1l(-two*fabsl(x));
00082                z= -t/(t+two);
00083            }
00084     /* |x| > 22, return +-1 */
00085        } else {
00086            z = one - tiny;         /* raised inexact flag */
00087        }
00088        return (jx>=0)? z: -z;
00089 }
00090 long_double_symbol (libm, __tanhl, tanhl);