1 REAL FUNCTION SBESJ1 (X) 2c Copyright (c) 1996 California Institute of Technology, Pasadena, CA. 3c ALL RIGHTS RESERVED. 4c Based on Government Sponsored Research NAS7-03001. 5c>> 1996-03-30 SBESJ1 Krogh Added external statement. 6C>> 1995-11-13 SBESJ1 Krogh Changed data statment for C converstion. 7C>> 1995-11-03 SBESJ1 Krogh Removed blanks in numbers for C conversion. 8C>> 1994-11-11 SBESJ1 Krogh Declared all vars. 9C>> 1994-10-20 SBESJ1 Krogh Changes to use M77CON 10C>> 1992-02-07 SBESJ1 WV Snyder Correct sign for X < 0. 11C>> 1990-11-29 SBESJ1 CLL 12C>> 1985-08-02 SBESJ1 Lawson Initial code. 13C JUNE 1978 EDITION. W. FULLERTON, C3, LOS ALAMOS SCIENTIFIC LAB. 14C C.L.LAWSON & S.CHAN, JPL, 1984 FEB ADAPTED TO JPL MATH77 LIBRARY. 15c ------------------------------------------------------------------ 16c--S replaces "?": ?BESJ1, ?BMP1, ?INITS, ?CSEVL 17c ------------------------------------------------------------------ 18 EXTERNAL R1MACH, SCSEVL 19 INTEGER NTJ1 20 REAL X, BJ1CS(19), AMPL, THETA, XSML, XMIN, Y, 21 1 R1MACH, SCSEVL 22C 23C SERIES FOR BJ1 ON THE INTERVAL 0. TO 1.60000E+01 24C WITH WEIGHTED ERROR 1.16E-33 25C LOG WEIGHTED ERROR 32.93 26C SIGNIFICANT FIGURES REQUIRED 32.36 27C DECIMAL PLACES REQUIRED 33.57 28C 29 SAVE NTJ1, XSML, XMIN 30C 31 DATA BJ1CS / -.117261415133327865606240574524003E+0, 32 * -.253615218307906395623030884554698E+0, 33 * +.501270809844695685053656363203743E-1, 34 * -.463151480962508191842619728789772E-2, 35 * +.247996229415914024539124064592364E-3, 36 * -.867894868627882584521246435176416E-5, 37 * +.214293917143793691502766250991292E-6, 38 * -.393609307918317979229322764073061E-8, 39 * +.559118231794688004018248059864032E-10, 40 * -.632761640466139302477695274014880E-12, 41 * +.584099161085724700326945563268266E-14, 42 * -.448253381870125819039135059199999E-16, 43 * +.290538449262502466306018688000000E-18, 44 * -.161173219784144165412118186666666E-20, 45 * +.773947881939274637298346666666666E-23, 46 * -.324869378211199841143466666666666E-25, 47 * +.120223767722741022720000000000000E-27, 48 * -.395201221265134933333333333333333E-30, 49 * +.116167808226645333333333333333333E-32 / 50C 51 DATA NTJ1, XSML, XMIN / 0, 2*0.E0 / 52C ------------------------------------------------------------------ 53 IF (NTJ1 .eq. 0) then 54 call SINITS (BJ1CS, 19, 0.1E0*R1MACH(3), NTJ1) 55 XSML = SQRT (4.0E0*R1MACH(3)) 56 XMIN = 2.0E0*R1MACH(1) 57 endif 58C 59 Y = ABS(X) 60C 61 IF (Y .LE. XMIN) THEN 62 SBESJ1 = 0.E0 63 ELSE IF (Y .LE. XSML) THEN 64 SBESJ1 = .5E0 * X 65 ELSE IF (Y .LE. 4.E0) THEN 66 SBESJ1 = X * ( .25E0 + SCSEVL (.125E0*Y*Y-1.E0,BJ1CS, NTJ1) ) 67 ELSE 68 CALL SBMP1 (Y, AMPL, THETA) 69 SBESJ1 = AMPL * COS(THETA) 70 IF (X .LT. 0.0e0) SBESJ1 = -SBESJ1 71 END IF 72C 73 RETURN 74 END 75