cin.f
1.67 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
function cin (x)
c december 1980 edition. w. fullerton, bell labs.
dimension cincs(11)
external csevl, inits, r1mach
c
c series for cin on the interval 0.00000e+00 to 1.60000e+01
c with weighted error 7.33e-17
c log weighted error 16.14
c significant figures required 15.42
c decimal places required 16.66
c
data cin cs( 1) / 0.3707450175 090968874 e0/
data cin cs( 2) / -0.0589357489 636444683 e0/
data cin cs( 3) / 0.0053818964 211356912 e0/
data cin cs( 4) / -0.0002986005 284196214 e0/
data cin cs( 5) / 0.0000109557 257532162 e0/
data cin cs( 6) / -0.0000002840 545487735 e0/
data cin cs( 7) / 0.0000000054 697399488 e0/
data cin cs( 8) / -0.0000000000 812418746 e0/
data cin cs( 9) / 0.0000000000 009586859 e0/
data cin cs( 10) / -0.0000000000 000092027 e0/
data cin cs( 11) / 0.0000000000 000000733 e0/
c
data eul / 0.5772156649 0153286 e0 /
data ncin, xmin /0, 0.0/
c
if (ncin.ne.0) go to 10
ncin = inits (cincs, 11, 0.1*r1mach(3))
xmin = sqrt (r1mach(1))
c
10 cin = 0.0
absx = abs(x)
if (x.ne.0.0 .and. absx.le.xmin) call seteru (
1 38hcin x so small that cin underflows, 38, 1, 0)
if (absx.le.xmin) return
c
if (x.gt.4.0) go to 20
cin = x*x*csevl ((x*x-8.0)*.125, cincs, ncin)
return
c
20 call r9sifg (x, f, g)
sinx = sin (absx)
call erroff
cin = -f*sinx + g*cos(absx) + alog(absx) + eul
c
return
end