124598Szliu #ifndef lint 224706Selefunt static char sccsid[] = 3*31853Szliu "@(#)j1.c 4.2 (Berkeley) 8/21/85; 1.4 (ucb.elefunt) 07/13/87"; 4*31853Szliu #endif /* not lint */ 524598Szliu 624598Szliu /* 724598Szliu floating point Bessel's function 824598Szliu of the first and second kinds 924598Szliu of order one 1024598Szliu 1124598Szliu j1(x) returns the value of J1(x) 1224598Szliu for all real values of x. 1324598Szliu 1424598Szliu There are no error returns. 1524598Szliu Calls sin, cos, sqrt. 1624598Szliu 1724598Szliu There is a niggling bug in J1 which 1824598Szliu causes errors up to 2e-16 for x in the 1924598Szliu interval [-8,8]. 2024598Szliu The bug is caused by an inappropriate order 2124598Szliu of summation of the series. rhm will fix it 2224598Szliu someday. 2324598Szliu 2424598Szliu Coefficients are from Hart & Cheney. 2524598Szliu #6050 (20.98D) 2624598Szliu #6750 (19.19D) 2724598Szliu #7150 (19.35D) 2824598Szliu 2924598Szliu y1(x) returns the value of Y1(x) 3024598Szliu for positive real values of x. 3124598Szliu For x<=0, if on the VAX, error number EDOM is set and 3224598Szliu the reserved operand fault is generated; 3324598Szliu otherwise (an IEEE machine) an invalid operation is performed. 3424598Szliu 3524598Szliu Calls sin, cos, sqrt, log, j1. 3624598Szliu 3724598Szliu The values of Y1 have not been checked 3824598Szliu to more than ten places. 3924598Szliu 4024598Szliu Coefficients are from Hart & Cheney. 4124598Szliu #6447 (22.18D) 4224598Szliu #6750 (19.19D) 4324598Szliu #7150 (19.35D) 4424598Szliu */ 4524598Szliu 4624598Szliu #include <math.h> 47*31853Szliu #if defined(vax)||defined(tahoe) 4824598Szliu #include <errno.h> 49*31853Szliu #else /* defined(vax)||defined(tahoe) */ 5024598Szliu static double zero = 0.e0; 51*31853Szliu #endif /* defined(vax)||defined(tahoe) */ 5224598Szliu static double pzero, qzero; 5324598Szliu static double tpi = .6366197723675813430755350535e0; 5424598Szliu static double pio4 = .7853981633974483096156608458e0; 5524598Szliu static double p1[] = { 5624598Szliu 0.581199354001606143928050809e21, 5724598Szliu -.6672106568924916298020941484e20, 5824598Szliu 0.2316433580634002297931815435e19, 5924598Szliu -.3588817569910106050743641413e17, 6024598Szliu 0.2908795263834775409737601689e15, 6124598Szliu -.1322983480332126453125473247e13, 6224598Szliu 0.3413234182301700539091292655e10, 6324598Szliu -.4695753530642995859767162166e7, 6424598Szliu 0.2701122710892323414856790990e4, 6524598Szliu }; 6624598Szliu static double q1[] = { 6724598Szliu 0.1162398708003212287858529400e22, 6824598Szliu 0.1185770712190320999837113348e20, 6924598Szliu 0.6092061398917521746105196863e17, 7024598Szliu 0.2081661221307607351240184229e15, 7124598Szliu 0.5243710262167649715406728642e12, 7224598Szliu 0.1013863514358673989967045588e10, 7324598Szliu 0.1501793594998585505921097578e7, 7424598Szliu 0.1606931573481487801970916749e4, 7524598Szliu 1.0, 7624598Szliu }; 7724598Szliu static double p2[] = { 7824598Szliu -.4435757816794127857114720794e7, 7924598Szliu -.9942246505077641195658377899e7, 8024598Szliu -.6603373248364939109255245434e7, 8124598Szliu -.1523529351181137383255105722e7, 8224598Szliu -.1098240554345934672737413139e6, 8324598Szliu -.1611616644324610116477412898e4, 8424598Szliu 0.0, 8524598Szliu }; 8624598Szliu static double q2[] = { 8724598Szliu -.4435757816794127856828016962e7, 8824598Szliu -.9934124389934585658967556309e7, 8924598Szliu -.6585339479723087072826915069e7, 9024598Szliu -.1511809506634160881644546358e7, 9124598Szliu -.1072638599110382011903063867e6, 9224598Szliu -.1455009440190496182453565068e4, 9324598Szliu 1.0, 9424598Szliu }; 9524598Szliu static double p3[] = { 9624598Szliu 0.3322091340985722351859704442e5, 9724598Szliu 0.8514516067533570196555001171e5, 9824598Szliu 0.6617883658127083517939992166e5, 9924598Szliu 0.1849426287322386679652009819e5, 10024598Szliu 0.1706375429020768002061283546e4, 10124598Szliu 0.3526513384663603218592175580e2, 10224598Szliu 0.0, 10324598Szliu }; 10424598Szliu static double q3[] = { 10524598Szliu 0.7087128194102874357377502472e6, 10624598Szliu 0.1819458042243997298924553839e7, 10724598Szliu 0.1419460669603720892855755253e7, 10824598Szliu 0.4002944358226697511708610813e6, 10924598Szliu 0.3789022974577220264142952256e5, 11024598Szliu 0.8638367769604990967475517183e3, 11124598Szliu 1.0, 11224598Szliu }; 11324598Szliu static double p4[] = { 11424598Szliu -.9963753424306922225996744354e23, 11524598Szliu 0.2655473831434854326894248968e23, 11624598Szliu -.1212297555414509577913561535e22, 11724598Szliu 0.2193107339917797592111427556e20, 11824598Szliu -.1965887462722140658820322248e18, 11924598Szliu 0.9569930239921683481121552788e15, 12024598Szliu -.2580681702194450950541426399e13, 12124598Szliu 0.3639488548124002058278999428e10, 12224598Szliu -.2108847540133123652824139923e7, 12324598Szliu 0.0, 12424598Szliu }; 12524598Szliu static double q4[] = { 12624598Szliu 0.5082067366941243245314424152e24, 12724598Szliu 0.5435310377188854170800653097e22, 12824598Szliu 0.2954987935897148674290758119e20, 12924598Szliu 0.1082258259408819552553850180e18, 13024598Szliu 0.2976632125647276729292742282e15, 13124598Szliu 0.6465340881265275571961681500e12, 13224598Szliu 0.1128686837169442121732366891e10, 13324598Szliu 0.1563282754899580604737366452e7, 13424598Szliu 0.1612361029677000859332072312e4, 13524598Szliu 1.0, 13624598Szliu }; 13724598Szliu 13824598Szliu double 13924598Szliu j1(arg) double arg;{ 14024598Szliu double xsq, n, d, x; 14124598Szliu double sin(), cos(), sqrt(); 14224598Szliu int i; 14324598Szliu 14424598Szliu x = arg; 14524598Szliu if(x < 0.) x = -x; 14624598Szliu if(x > 8.){ 14724598Szliu asympt(x); 14824598Szliu n = x - 3.*pio4; 14924598Szliu n = sqrt(tpi/x)*(pzero*cos(n) - qzero*sin(n)); 15024598Szliu if(arg <0.) n = -n; 15124598Szliu return(n); 15224598Szliu } 15324598Szliu xsq = x*x; 15424598Szliu for(n=0,d=0,i=8;i>=0;i--){ 15524598Szliu n = n*xsq + p1[i]; 15624598Szliu d = d*xsq + q1[i]; 15724598Szliu } 15824598Szliu return(arg*n/d); 15924598Szliu } 16024598Szliu 16124598Szliu double 16224598Szliu y1(arg) double arg;{ 16324598Szliu double xsq, n, d, x; 16424598Szliu double sin(), cos(), sqrt(), log(), j1(); 16524598Szliu int i; 16624598Szliu 16724598Szliu x = arg; 16824598Szliu if(x <= 0.){ 169*31853Szliu #if defined(vax)||defined(tahoe) 17024598Szliu extern double infnan(); 17124598Szliu return(infnan(EDOM)); /* NaN */ 172*31853Szliu #else /* defined(vax)||defined(tahoe) */ 17324598Szliu return(zero/zero); /* IEEE machines: invalid operation */ 174*31853Szliu #endif /* defined(vax)||defined(tahoe) */ 17524598Szliu } 17624598Szliu if(x > 8.){ 17724598Szliu asympt(x); 17824598Szliu n = x - 3*pio4; 17924598Szliu return(sqrt(tpi/x)*(pzero*sin(n) + qzero*cos(n))); 18024598Szliu } 18124598Szliu xsq = x*x; 18224598Szliu for(n=0,d=0,i=9;i>=0;i--){ 18324598Szliu n = n*xsq + p4[i]; 18424598Szliu d = d*xsq + q4[i]; 18524598Szliu } 18624598Szliu return(x*n/d + tpi*(j1(x)*log(x)-1./x)); 18724598Szliu } 18824598Szliu 18924598Szliu static 19024598Szliu asympt(arg) double arg;{ 19124598Szliu double zsq, n, d; 19224598Szliu int i; 19324598Szliu zsq = 64./(arg*arg); 19424598Szliu for(n=0,d=0,i=6;i>=0;i--){ 19524598Szliu n = n*zsq + p2[i]; 19624598Szliu d = d*zsq + q2[i]; 19724598Szliu } 19824598Szliu pzero = n/d; 19924598Szliu for(n=0,d=0,i=6;i>=0;i--){ 20024598Szliu n = n*zsq + p3[i]; 20124598Szliu d = d*zsq + q3[i]; 20224598Szliu } 20324598Szliu qzero = (8./arg)*(n/d); 20424598Szliu } 205