os/ossrv/genericopenlibs/cstdlib/LMATH/S_TANH.C
changeset 0 bde4ae8d615e
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/os/ossrv/genericopenlibs/cstdlib/LMATH/S_TANH.C	Fri Jun 15 03:10:57 2012 +0200
     1.3 @@ -0,0 +1,126 @@
     1.4 +/* S_TANH.C
     1.5 + * 
     1.6 + * Portions Copyright (c) 1993-1999 Nokia Corporation and/or its subsidiary(-ies).
     1.7 + * All rights reserved.
     1.8 + */
     1.9 +
    1.10 +
    1.11 +/* @(#)s_tanh.c 5.1 93/09/24 */
    1.12 +/*
    1.13 + * ====================================================
    1.14 + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
    1.15 + *
    1.16 + * Developed at SunPro, a Sun Microsystems, Inc. business.
    1.17 + * Permission to use, copy, modify, and distribute this
    1.18 + * software is freely granted, provided that this notice 
    1.19 + * is preserved.
    1.20 + * ====================================================
    1.21 + */
    1.22 +
    1.23 +/*
    1.24 +
    1.25 +FUNCTION
    1.26 +        <<tanh>>, <<tanhf>>---hyperbolic tangent
    1.27 +
    1.28 +INDEX
    1.29 +tanh
    1.30 +INDEX
    1.31 +tanhf
    1.32 +
    1.33 +ANSI_SYNOPSIS
    1.34 +        #include <math.h>
    1.35 +        double tanh(double <[x]>);
    1.36 +        float tanhf(float <[x]>);
    1.37 +
    1.38 +TRAD_SYNOPSIS
    1.39 +        #include <math.h>
    1.40 +        double tanh(<[x]>)
    1.41 +        double <[x]>;
    1.42 +
    1.43 +        float tanhf(<[x]>)
    1.44 +        float <[x]>;
    1.45 +
    1.46 +
    1.47 +DESCRIPTION
    1.48 +
    1.49 +<<tanh>> computes the hyperbolic tangent of
    1.50 +the argument <[x]>.  Angles are specified in radians.  
    1.51 +
    1.52 +<<tanh(<[x]>)>> is defined as 
    1.53 +. sinh(<[x]>)/cosh(<[x]>)
    1.54 +	
    1.55 +<<tanhf>> is identical, save that it takes and returns <<float>> values.
    1.56 +
    1.57 +RETURNS
    1.58 +The hyperbolic tangent of <[x]> is returned.
    1.59 +
    1.60 +PORTABILITY
    1.61 +<<tanh>> is ANSI C.  <<tanhf>> is an extension.
    1.62 +
    1.63 +*/
    1.64 +
    1.65 +/* Tanh(x)
    1.66 + * Return the Hyperbolic Tangent of x
    1.67 + *
    1.68 + * Method :
    1.69 + *				       x    -x
    1.70 + *				      e  - e
    1.71 + *	0. tanh(x) is defined to be -----------
    1.72 + *				       x    -x
    1.73 + *				      e  + e
    1.74 + *	1. reduce x to non-negative by tanh(-x) = -tanh(x).
    1.75 + *	2.  0      <= x <= 2**-55 : tanh(x) := x*(one+x)
    1.76 + *					        -t
    1.77 + *	    2**-55 <  x <=  1     : tanh(x) := -----; t = expm1(-2x)
    1.78 + *					       t + 2
    1.79 + *						     2
    1.80 + *	    1      <= x <=  22.0  : tanh(x) := 1-  ----- ; t=expm1(2x)
    1.81 + *						   t + 2
    1.82 + *	    22.0   <  x <= INF    : tanh(x) := 1.
    1.83 + *
    1.84 + * Special cases:
    1.85 + *	tanh(NaN) is NaN;
    1.86 + *	only tanh(0)=0 is exact for finite argument.
    1.87 + */
    1.88 +
    1.89 +#include "FDLIBM.H"
    1.90 +
    1.91 +static const double one=1.0, two=2.0, tiny = 1.0e-300;
    1.92 +
    1.93 +/**
    1.94 +Calculate hyperbolic tangent.
    1.95 +@return hyperbolic tangent of x.
    1.96 +@param x Angle expressed in radians (180 degrees = PI radians).
    1.97 +*/	
    1.98 +EXPORT_C double tanh(double x) __SOFTFP
    1.99 +{
   1.100 +	double t,z;
   1.101 +	__int32_t jx,ix;
   1.102 +
   1.103 +    /* High word of |x|. */
   1.104 +	GET_HIGH_WORD(jx,x);
   1.105 +	ix = jx&0x7fffffff;
   1.106 +
   1.107 +    /* x is INF or NaN */
   1.108 +	if(ix>=0x7ff00000) { 
   1.109 +	    if (jx>=0) return one/x+one;    /* tanh(+-inf)=+-1 */
   1.110 +	    else       return one/x-one;    /* tanh(NaN) = NaN */
   1.111 +	}
   1.112 +
   1.113 +    /* |x| < 22 */
   1.114 +	if (ix < 0x40360000) {		/* |x|<22 */
   1.115 +	    if (ix<0x3c800000) 		/* |x|<2**-55 */
   1.116 +		return x*(one+x);    	/* tanh(small) = small */
   1.117 +	    if (ix>=0x3ff00000) {	/* |x|>=1  */
   1.118 +		t = expm1(two*fabs(x));
   1.119 +		z = one - two/(t+two);
   1.120 +	    } else {
   1.121 +	        t = expm1(-two*fabs(x));
   1.122 +	        z= -t/(t+two);
   1.123 +	    }
   1.124 +    /* |x| > 22, return +-1 */
   1.125 +	} else {
   1.126 +	    z = one - tiny;		/* raised inexact flag */
   1.127 +	}
   1.128 +	return (jx>=0)? z: -z;
   1.129 +}