Blame view

fvn_fnlib/d9atn1.f 4.3 KB
38581db0c   daniau   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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
        double precision function d9atn1 (x)
  c april 1978 edition.  w. fullerton c3, los alamos scientific lab.
  c
  c evaluate  datan(x)  from first order, that is, evaluate
  c (datan(x)-x)/x**3  with relative error accuracy so that
  c        datan(x) = x + x**3*d9atn1(x).
  c
        double precision x, xbig, xmax, xsml, y, atn1cs(40), dcsevl,
       1  d1mach, datan
        external d1mach,  dcsevl, initds
  c
  c series for atn1       on the interval  0.          to  1.00000e+00
  c                                        with weighted error   3.39e-32
  c                                         log weighted error  31.47
  c                               significant figures required  30.26
  c                                    decimal places required  32.27
  c
        data atn1cs(  1) / -.3283997535 3552023569 0793992299 0 d-1      /
        data atn1cs(  2) / +.5833432343 1724124499 5166991490 7 d-1      /
        data atn1cs(  3) / -.7400369696 7196464638 0901155141 3 d-2      /
        data atn1cs(  4) / +.1009784199 3372880835 9035751163 9 d-2      /
        data atn1cs(  5) / -.1439787163 5652056214 7130369770 0 d-3      /
        data atn1cs(  6) / +.2114512648 9921075720 7211224343 9 d-4      /
        data atn1cs(  7) / -.3172321074 2546671674 0256499675 7 d-5      /
        data atn1cs(  8) / +.4836620365 4607108253 7785938480 0 d-6      /
        data atn1cs(  9) / -.7467746546 8141126704 3761432277 6 d-7      /
        data atn1cs( 10) / +.1164800896 8244298306 2099864134 2 d-7      /
        data atn1cs( 11) / -.1832088370 8472013926 9995624245 2 d-8      /
        data atn1cs( 12) / +.2901908277 9660633131 7535123045 5 d-9      /
        data atn1cs( 13) / -.4623885312 1063267383 5180572151 2 d-10     /
        data atn1cs( 14) / +.7405528668 7757369179 9219704828 6 d-11     /
        data atn1cs( 15) / -.1191354457 8451366823 7082037341 7 d-11     /
        data atn1cs( 16) / +.1924090144 3917725998 6785569251 8 d-12     /
        data atn1cs( 17) / -.3118271051 0761942722 5447615532 7 d-13     /
        data atn1cs( 18) / +.5069240036 5677317896 9452059303 2 d-14     /
        data atn1cs( 19) / -.8263694719 8028660538 1828440596 4 d-15     /
        data atn1cs( 20) / +.1350486709 8170794205 2650612302 9 d-15     /
        data atn1cs( 21) / -.2212023650 4817460458 4013782319 1 d-16     /
        data atn1cs( 22) / +.3630654747 3813567838 2904764770 9 d-17     /
        data atn1cs( 23) / -.5970345328 8471540524 5121585916 5 d-18     /
        data atn1cs( 24) / +.9834816050 0771331194 4832900573 8 d-19     /
        data atn1cs( 25) / -.1622655075 8550623361 4438760448 0 d-19     /
        data atn1cs( 26) / +.2681186176 9454367963 0132030122 6 d-20     /
        data atn1cs( 27) / -.4436309706 7852554796 3624368810 6 d-21     /
        data atn1cs( 28) / +.7349691897 6524969450 7246551040 0 d-22     /
        data atn1cs( 29) / -.1219077508 3500525882 8940137813 3 d-22     /
        data atn1cs( 30) / +.2024298836 8052154031 8454087679 9 d-23     /
        data atn1cs( 31) / -.3364871555 7973545799 2557636266 6 d-24     /
        data atn1cs( 32) / +.5598673968 3469887494 9293397333 3 d-25     /
        data atn1cs( 33) / -.9323939267 2723202296 2853205333 3 d-26     /
        data atn1cs( 34) / +.1554133116 9959702229 3480789333 3 d-26     /
        data atn1cs( 35) / -.2592569534 1797459227 5742719999 9 d-27     /
        data atn1cs( 36) / +.4328193466 2457346850 3790933333 3 d-28     /
        data atn1cs( 37) / -.7231013125 5954374711 9240533333 3 d-29     /
        data atn1cs( 38) / +.1208902859 8304947729 4216533333 3 d-29     /
        data atn1cs( 39) / -.2022404543 4498975793 1519999999 9 d-30     /
        data atn1cs( 40) / +.3385428713 0464938430 7370666666 6 d-31     /
  c
        data ntatn1, xsml, xbig, xmax / 0, 3*0.d0 /
  c
        if (ntatn1.ne.0) go to 10
        eps = d1mach(3)
        ntatn1 = initds (atn1cs, 40, 0.1*eps)
  c
        xsml = sqrt (0.1*eps)
        xbig = 1.571/sqrt(eps)
        xmax = 1.571/eps
  c
   10   y = dabs(x)
        if (y.gt.1.0d0) go to 20
  c
        if (y.le.xsml) d9atn1 = -1.0d0/3.0d0
        if (y.le.xsml) return
  c
        d9atn1 = -0.25d0 + dcsevl (2.d0*y*y-1.d0, atn1cs, ntatn1)
        return
  c
   20   if (y.gt.xmax) call seteru (
       1  51hd9atn1  no precision in answer because x is too big, 51,
       2  2, 2)
        if (y.gt.xbig) call seteru (
       1  53hd9atn1  answer lt half precision because x is too big, 53,
       2  1, 1)
  c
        d9atn1 = (datan(x) - x) / x**3
        return
  c
        end