1*DECK DBESI1
2      DOUBLE PRECISION FUNCTION DBESI1 (X)
3C***BEGIN PROLOGUE  DBESI1
4C***PURPOSE  Compute the modified (hyperbolic) Bessel function of the
5C            first kind of order one.
6C***LIBRARY   SLATEC (FNLIB)
7C***CATEGORY  C10B1
8C***TYPE      DOUBLE PRECISION (BESI1-S, DBESI1-D)
9C***KEYWORDS  FIRST KIND, FNLIB, HYPERBOLIC BESSEL FUNCTION,
10C             MODIFIED BESSEL FUNCTION, ORDER ONE, SPECIAL FUNCTIONS
11C***AUTHOR  Fullerton, W., (LANL)
12C***DESCRIPTION
13C
14C DBESI1(X) calculates the double precision modified (hyperbolic)
15C Bessel function of the first kind of order one and double precision
16C argument X.
17C
18C Series for BI1        on the interval  0.          to  9.00000E+00
19C                                        with weighted error   1.44E-32
20C                                         log weighted error  31.84
21C                               significant figures required  31.45
22C                                    decimal places required  32.46
23C
24C***REFERENCES  (NONE)
25C***ROUTINES CALLED  D1MACH, DBSI1E, DCSEVL, INITDS, XERMSG
26C***REVISION HISTORY  (YYMMDD)
27C   770701  DATE WRITTEN
28C   890531  Changed all specific intrinsics to generic.  (WRB)
29C   890531  REVISION DATE from Version 3.2
30C   891214  Prologue converted to Version 4.0 format.  (BAB)
31C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
32C***END PROLOGUE  DBESI1
33      DOUBLE PRECISION X, BI1CS(17), XMAX, XMIN, XSML, Y, D1MACH,
34     1  DCSEVL, DBSI1E
35      LOGICAL FIRST
36      SAVE BI1CS, NTI1, XMIN, XSML, XMAX, FIRST
37      DATA BI1CS(  1) / -.1971713261 0998597316 1385032181 49 D-2     /
38      DATA BI1CS(  2) / +.4073488766 7546480608 1553936520 14 D+0     /
39      DATA BI1CS(  3) / +.3483899429 9959455866 2450377837 87 D-1     /
40      DATA BI1CS(  4) / +.1545394556 3001236038 5984010584 89 D-2     /
41      DATA BI1CS(  5) / +.4188852109 8377784129 4588320041 20 D-4     /
42      DATA BI1CS(  6) / +.7649026764 8362114741 9597039660 69 D-6     /
43      DATA BI1CS(  7) / +.1004249392 4741178689 1798080372 38 D-7     /
44      DATA BI1CS(  8) / +.9932207791 9238106481 3712980548 63 D-10    /
45      DATA BI1CS(  9) / +.7663801791 8447637275 2001716813 49 D-12    /
46      DATA BI1CS( 10) / +.4741418923 8167394980 3880919481 60 D-14    /
47      DATA BI1CS( 11) / +.2404114404 0745181799 8631720320 00 D-16    /
48      DATA BI1CS( 12) / +.1017150500 7093713649 1211007999 99 D-18    /
49      DATA BI1CS( 13) / +.3645093565 7866949458 4917333333 33 D-21    /
50      DATA BI1CS( 14) / +.1120574950 2562039344 8106666666 66 D-23    /
51      DATA BI1CS( 15) / +.2987544193 4468088832 0000000000 00 D-26    /
52      DATA BI1CS( 16) / +.6973231093 9194709333 3333333333 33 D-29    /
53      DATA BI1CS( 17) / +.1436794822 0620800000 0000000000 00 D-31    /
54      DATA FIRST /.TRUE./
55C***FIRST EXECUTABLE STATEMENT  DBESI1
56      IF (FIRST) THEN
57         NTI1 = INITDS (BI1CS, 17, 0.1*REAL(D1MACH(3)))
58         XMIN = 2.0D0*D1MACH(1)
59         XSML = SQRT(4.5D0*D1MACH(3))
60         XMAX = LOG (D1MACH(2))
61      ENDIF
62      FIRST = .FALSE.
63C
64      Y = ABS(X)
65      IF (Y.GT.3.0D0) GO TO 20
66C
67      DBESI1 = 0.D0
68      IF (Y.EQ.0.D0)  RETURN
69C
70      IF (Y .LE. XMIN) CALL XERMSG ('SLATEC', 'DBESI1',
71     +   'ABS(X) SO SMALL I1 UNDERFLOWS', 1, 1)
72      IF (Y.GT.XMIN) DBESI1 = 0.5D0*X
73      IF (Y.GT.XSML) DBESI1 = X*(0.875D0 + DCSEVL (Y*Y/4.5D0-1.D0,
74     1  BI1CS, NTI1))
75      RETURN
76C
77 20   IF (Y .GT. XMAX) CALL XERMSG ('SLATEC', 'DBESI1',
78     +   'ABS(X) SO BIG I1 OVERFLOWS', 2, 2)
79C
80      DBESI1 = EXP(Y) * DBSI1E(X)
81C
82      RETURN
83      END
84