1
2
3
4
5
6
7
8
9
10
11
12 tanh_: procedure (number) returns (float binary (27));
13
14
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_;