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