Blame view
fvn_fnlib/cin.f
1.67 KB
38581db0c git-svn-id: https... |
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 |