1 /* ******************************************************
 2    *                                                    *
 3    *                                                    *
 4    * Copyright (c) 1972 by Massachusetts Institute of   *
 5    * Technology and Honeywell Information Systems, Inc. *
 6    *                                                    *
 7    *                                                    *
 8    ****************************************************** */
 9 
10 dtanh_: procedure (number) returns (float binary (63));
11 
12 /*      compute the hyperbolic tangent of a double-precision floating-point number      */
13 declare (number, f, n, p, q) float binary (63),
14           (abs, exp) builtin;
15           n = number;
16           f = abs (n);
17 if f >= 0.55e0 then if f >= 24.5e0 then f = 1.e0; else large: do;
18                f = f + f;
19                f = exp (f);
20                p = f + 1.e0;
21                f = (f - 1.e0) / p;
22 end large; else if f >= 1.e-10 then small: do;
23                p = f*f;
24                q = ((((((( 0.4779477332387385297e-13 * p + 0.1147074559772972471e-10) * p
25                + 0.2087675698786809898e-8) * p + 0.2755731922398589065e-6) * p + 0.2480158730158730159e-4) * p
26                + 0.1388888888888888889e-2) * p + 0.4166666666666666667e-1) * p + 0.5e0) * p + 1.e0;
27                f = ((((((((0.2811457254345520763e-14 * p + 0.7647163731819816476e-12) * p + 0.1605904383682161460e-9) * p
28                + 0.2505210838544171878e-7) * p + 0.2755731922398589065e-5) * p + 0.1984126984126984127e-3) * p
29                + 0.8333333333333333333e-2) * p + 0.1666666666666666667e0) * p + 1.e0) * f / q;
30           end small;
31           if n < 0.0e0 then f = -f;
32           return (f);
33      end dtanh_;