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