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