← Back to branch summary

~ubuntu-branches/debian/squeeze/maxima/squeeze

« back to all changes in this revision

Viewing changes to src/numerical/slatec/fortran/dbi.f

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2006-10-18 14:52:42 UTC
  • mto: (1.1.5 upstream)
  • mto: This revision was merged to the branch mainline in revision 4.
  • Revision ID: james.westby@ubuntu.com-20061018145242-vzyrm5hmxr8kiosf
Import upstream version 5.10.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/numerical/slatec/fortran/dbi.f
 
1
*DECK DBI
 
2
      DOUBLE PRECISION FUNCTION DBI (X)
 
3
C***BEGIN PROLOGUE  DBI
 
4
C***PURPOSE  Evaluate the Bairy function (the Airy function of the
 
5
C            second kind).
 
6
C***LIBRARY   SLATEC (FNLIB)
 
7
C***CATEGORY  C10D
 
8
C***TYPE      DOUBLE PRECISION (BI-S, DBI-D)
 
9
C***KEYWORDS  BAIRY FUNCTION, FNLIB, SPECIAL FUNCTIONS
 
10
C***AUTHOR  Fullerton, W., (LANL)
 
11
C***DESCRIPTION
 
12
C
 
13
C DBI(X) calculates the double precision Airy function of the
 
14
C second kind for double precision argument X.
 
15
C
 
16
C Series for BIF        on the interval -1.00000E+00 to  1.00000E+00
 
17
C                                        with weighted error   1.45E-32
 
18
C                                         log weighted error  31.84
 
19
C                               significant figures required  30.85
 
20
C                                    decimal places required  32.40
 
21
C
 
22
C Series for BIG        on the interval -1.00000E+00 to  1.00000E+00
 
23
C                                        with weighted error   1.29E-33
 
24
C                                         log weighted error  32.89
 
25
C                               significant figures required  31.48
 
26
C                                    decimal places required  33.45
 
27
C
 
28
C Series for BIF2       on the interval  1.00000E+00 to  8.00000E+00
 
29
C                                        with weighted error   6.08E-32
 
30
C                                         log weighted error  31.22
 
31
C                        approx significant figures required  30.8
 
32
C                                    decimal places required  31.80
 
33
C
 
34
C Series for BIG2       on the interval  1.00000E+00 to  8.00000E+00
 
35
C                                        with weighted error   4.91E-33
 
36
C                                         log weighted error  32.31
 
37
C                        approx significant figures required  31.6
 
38
C                                    decimal places required  32.90
 
39
C
 
40
C***REFERENCES  (NONE)
 
41
C***ROUTINES CALLED  D1MACH, D9AIMP, DBIE, DCSEVL, INITDS, XERMSG
 
42
C***REVISION HISTORY  (YYMMDD)
 
43
C   770701  DATE WRITTEN
 
44
C   890531  Changed all specific intrinsics to generic.  (WRB)
 
45
C   890531  REVISION DATE from Version 3.2
 
46
C   891214  Prologue converted to Version 4.0 format.  (BAB)
 
47
C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
 
48
C***END PROLOGUE  DBI
 
49
      DOUBLE PRECISION X, BIFCS(13), BIGCS(13), BIF2CS(15), BIG2CS(15),
 
50
     1  THETA, XM, XMAX, X3SML, Z,  D1MACH, DCSEVL, DBIE
 
51
      LOGICAL FIRST
 
52
      SAVE BIFCS, BIGCS, BIF2CS, BIG2CS, NBIF, NBIG,
 
53
     1 NBIF2, NBIG2, X3SML, XMAX, FIRST
 
54
      DATA BIFCS(  1) / -.1673021647 1986649483 5374239281 76 D-1     /
 
55
      DATA BIFCS(  2) / +.1025233583 4249445611 4263627777 57 D+0     /
 
56
      DATA BIFCS(  3) / +.1708309250 7381516539 4296502420 13 D-2     /
 
57
      DATA BIFCS(  4) / +.1186254546 7744681179 2164592100 40 D-4     /
 
58
      DATA BIFCS(  5) / +.4493290701 7792133694 5318879272 42 D-7     /
 
59
      DATA BIFCS(  6) / +.1069820714 3387889067 5677676636 28 D-9     /
 
60
      DATA BIFCS(  7) / +.1748064339 9771824706 0105176285 73 D-12    /
 
61
      DATA BIFCS(  8) / +.2081023107 1761711025 8818918343 99 D-15    /
 
62
      DATA BIFCS(  9) / +.1884981469 5665416509 9279717333 33 D-18    /
 
63
      DATA BIFCS( 10) / +.1342577917 3097804625 8826666666 66 D-21    /
 
64
      DATA BIFCS( 11) / +.7715959342 9658887893 3333333333 33 D-25    /
 
65
      DATA BIFCS( 12) / +.3653387961 7478566399 9999999999 99 D-28    /
 
66
      DATA BIFCS( 13) / +.1449756592 7953066666 6666666666 66 D-31    /
 
67
      DATA BIGCS(  1) / +.2246622324 8574522283 4682201390 24 D-1     /
 
68
      DATA BIGCS(  2) / +.3736477545 3019545441 7275616667 52 D-1     /
 
69
      DATA BIGCS(  3) / +.4447621895 7212285696 2152943266 39 D-3     /
 
70
      DATA BIGCS(  4) / +.2470807563 6329384245 4945919488 82 D-5     /
 
71
      DATA BIGCS(  5) / +.7919135339 5149635134 8624262855 96 D-8     /
 
72
      DATA BIGCS(  6) / +.1649807985 1827779880 8878724027 06 D-10    /
 
73
      DATA BIGCS(  7) / +.2411990666 4835455909 2475011228 41 D-13    /
 
74
      DATA BIGCS(  8) / +.2610373623 6091436985 1847812693 33 D-16    /
 
75
      DATA BIGCS(  9) / +.2175308297 7160323853 1237920000 00 D-19    /
 
76
      DATA BIGCS( 10) / +.1438694640 0390433219 4837333333 33 D-22    /
 
77
      DATA BIGCS( 11) / +.7734912561 2083468629 3333333333 33 D-26    /
 
78
      DATA BIGCS( 12) / +.3446929203 3849002666 6666666666 66 D-29    /
 
79
      DATA BIGCS( 13) / +.1293891927 3216000000 0000000000 00 D-32    /
 
80
      DATA BIF2CS(  1) / +.0998457269 3816041044 6828425799 3 D+0      /
 
81
      DATA BIF2CS(  2) / +.4786249778 6300553772 2114673182 31 D+0     /
 
82
      DATA BIF2CS(  3) / +.2515521196 0433011771 3244154366 75 D-1     /
 
83
      DATA BIF2CS(  4) / +.5820693885 2326456396 5156978722 16 D-3     /
 
84
      DATA BIF2CS(  5) / +.7499765964 4377865943 8614573782 17 D-5     /
 
85
      DATA BIF2CS(  6) / +.6134602870 3493836681 4030103564 74 D-7     /
 
86
      DATA BIF2CS(  7) / +.3462753885 1480632900 4342687333 59 D-9     /
 
87
      DATA BIF2CS(  8) / +.1428891008 0270254287 7708467489 31 D-11    /
 
88
      DATA BIF2CS(  9) / +.4496270429 8334641895 0564721792 00 D-14    /
 
89
      DATA BIF2CS( 10) / +.1114232306 5833011708 4283001066 66 D-16    /
 
90
      DATA BIF2CS( 11) / +.2230479106 6175002081 5178666666 66 D-19    /
 
91
      DATA BIF2CS( 12) / +.3681577873 6393142842 9226666666 66 D-22    /
 
92
      DATA BIF2CS( 13) / +.5096086844 9338261333 3333333333 33 D-25    /
 
93
      DATA BIF2CS( 14) / +.6000338692 6288554666 6666666666 66 D-28    /
 
94
      DATA BIF2CS( 15) / +.6082749744 6570666666 6666666666 66 D-31    /
 
95
      DATA BIG2CS(  1) / +.0333056621 4551434046 5176188111 647 D+0    /
 
96
      DATA BIG2CS(  2) / +.1613092151 2319706761 3287532084 943 D+0    /
 
97
      DATA BIG2CS(  3) / +.6319007309 6134286912 1615634921 173 D-2    /
 
98
      DATA BIG2CS(  4) / +.1187904568 1625173638 9780192304 567 D-3    /
 
99
      DATA BIG2CS(  5) / +.1304534588 6200265614 7116485012 843 D-5    /
 
100
      DATA BIG2CS(  6) / +.9374125995 5352172954 6809615508 936 D-8    /
 
101
      DATA BIG2CS(  7) / +.4745801886 7472515378 8510169834 595 D-10   /
 
102
      DATA BIG2CS(  8) / +.1783107265 0948139980 0065667560 946 D-12   /
 
103
      DATA BIG2CS(  9) / +.5167591927 8495818037 4276356640 000 D-15   /
 
104
      DATA BIG2CS( 10) / +.1190045083 8682712512 9496251733 333 D-17   /
 
105
      DATA BIG2CS( 11) / +.2229828806 6640351727 7063466666 666 D-20   /
 
106
      DATA BIG2CS( 12) / +.3465519230 2768941972 2666666666 666 D-23   /
 
107
      DATA BIG2CS( 13) / +.4539263363 2050451413 3333333333 333 D-26   /
 
108
      DATA BIG2CS( 14) / +.5078849965 1352234666 6666666666 666 D-29   /
 
109
      DATA BIG2CS( 15) / +.4910206746 9653333333 3333333333 333 D-32   /
 
110
      DATA FIRST /.TRUE./
 
111
C***FIRST EXECUTABLE STATEMENT  DBI
 
112
      IF (FIRST) THEN
 
113
         ETA = 0.1*REAL(D1MACH(3))
 
114
         NBIF = INITDS (BIFCS, 13, ETA)
 
115
         NBIG = INITDS (BIGCS, 13, ETA)
 
116
         NBIF2 = INITDS (BIF2CS, 15, ETA)
 
117
         NBIG2 = INITDS (BIG2CS, 15, ETA)
 
118
C
 
119
         X3SML = ETA**0.3333
 
120
         XMAX = (1.5*LOG(D1MACH(2)))**0.6666D0
 
121
      ENDIF
 
122
      FIRST = .FALSE.
 
123
C
 
124
      IF (X.GE.(-1.0D0)) GO TO 20
 
125
      CALL D9AIMP (X, XM, THETA)
 
126
      DBI = XM * SIN(THETA)
 
127
      RETURN
 
128
C
 
129
 20   IF (X.GT.1.0D0) GO TO 30
 
130
      Z = 0.D0
 
131
      IF (ABS(X).GT.X3SML) Z = X**3
 
132
      DBI = 0.625D0 + DCSEVL (Z, BIFCS, NBIF) + X*(0.4375D0 +
 
133
     1  DCSEVL (Z, BIGCS, NBIG))
 
134
      RETURN
 
135
C
 
136
 30   IF (X.GT.2.0D0) GO TO 40
 
137
      Z = (2.0D0*X**3 - 9.0D0)/7.D0
 
138
      DBI = 1.125D0 + DCSEVL (Z, BIF2CS, NBIF2) + X*(0.625D0 +
 
139
     1  DCSEVL (Z, BIG2CS, NBIG2))
 
140
      RETURN
 
141
C
 
142
 40   IF (X .GT. XMAX) CALL XERMSG ('SLATEC', 'DBI',
 
143
     +   'X SO BIG THAT BI OVERFLOWS', 1, 2)
 
144
C
 
145
      DBI = DBIE(X) * EXP(2.0D0*X*SQRT(X)/3.0D0)
 
146
      RETURN
 
147
C
 
148
      END