ci.f
1.66 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 ci (x)
c december 1980 edition, w. fullerton, bell labs.
dimension cics(13)
external csevl, inits, r1mach
c
c series for ci on the interval 0.00000e+00 to 1.60000e+01
c with weighted error 1.94e-18
c log weighted error 17.71
c significant figures required 17.74
c decimal places required 18.27
c
data ci cs( 1) / -0.3400428185 6055363156 e0/
data ci cs( 2) / -1.0330216640 1177456807 e0/
data ci cs( 3) / 0.1938822265 9917082877 e0/
data ci cs( 4) / -0.0191826043 6019865894 e0/
data ci cs( 5) / 0.0011078925 2584784967 e0/
data ci cs( 6) / -0.0000415723 4558247209 e0/
data ci cs( 7) / 0.0000010927 8524300229 e0/
data ci cs( 8) / -0.0000000212 3285954183 e0/
data ci cs( 9) / 0.0000000003 1733482164 e0/
data ci cs( 10) / -0.0000000000 0376141548 e0/
data ci cs( 11) / 0.0000000000 0003622653 e0/
data ci cs( 12) / -0.0000000000 0000028912 e0/
data ci cs( 13) / 0.0000000000 0000000194 e0/
c
data nci, xsml /0, 0.0/
c
if (ntci.ne.0) go to 10
nci = inits (cics, 13, 0.1*r1mach(3))
xsml = sqrt (r1mach(3))
c
10 if (x.le.0.0) call seteru (
1 17hci x is le 0, 17, 1, 2)
c
if (x.gt.4.0) go to 20
y = -1.0
if (x.gt.xsml) y = (x*x-8.0)*0.125
ci = alog(x) - 0.5 + csevl (y, cics, nci)
return
c
20 call r9sifg (x, f, g)
sinx = sin (x)
call erroff
ci = f*sinx - g*cos(x)
c
return
end