124597Szliu #ifndef lint 224706Selefunt static char sccsid[] = 3*31853Szliu "@(#)j0.c 4.2 (Berkeley) 8/21/85; 1.3 (ucb.elefunt) 07/13/87"; 4*31853Szliu #endif /* not lint */ 524597Szliu 624597Szliu /* 724597Szliu floating point Bessel's function 824597Szliu of the first and second kinds 924597Szliu of order zero 1024597Szliu 1124597Szliu j0(x) returns the value of J0(x) 1224597Szliu for all real values of x. 1324597Szliu 1424597Szliu There are no error returns. 1524597Szliu Calls sin, cos, sqrt. 1624597Szliu 1724597Szliu There is a niggling bug in J0 which 1824597Szliu causes errors up to 2e-16 for x in the 1924597Szliu interval [-8,8]. 2024597Szliu The bug is caused by an inappropriate order 2124597Szliu of summation of the series. rhm will fix it 2224597Szliu someday. 2324597Szliu 2424597Szliu Coefficients are from Hart & Cheney. 2524597Szliu #5849 (19.22D) 2624597Szliu #6549 (19.25D) 2724597Szliu #6949 (19.41D) 2824597Szliu 2924597Szliu y0(x) returns the value of Y0(x) 3024597Szliu for positive real values of x. 3124597Szliu For x<=0, if on the VAX, error number EDOM is set and 3224597Szliu the reserved operand fault is generated; 3324597Szliu otherwise (an IEEE machine) an invalid operation is performed. 3424597Szliu 3524597Szliu Calls sin, cos, sqrt, log, j0. 3624597Szliu 3724597Szliu The values of Y0 have not been checked 3824597Szliu to more than ten places. 3924597Szliu 4024597Szliu Coefficients are from Hart & Cheney. 4124597Szliu #6245 (18.78D) 4224597Szliu #6549 (19.25D) 4324597Szliu #6949 (19.41D) 4424597Szliu */ 4524597Szliu 4624597Szliu #include <math.h> 47*31853Szliu #if defined(vax)||defined(tahoe) 4824597Szliu #include <errno.h> 49*31853Szliu #else /* defined(vax)||defined(tahoe) */ 5024597Szliu static double zero = 0.e0; 51*31853Szliu #endif /* defined(vax)||defined(tahoe) */ 5224597Szliu static double pzero, qzero; 5324597Szliu static double tpi = .6366197723675813430755350535e0; 5424597Szliu static double pio4 = .7853981633974483096156608458e0; 5524597Szliu static double p1[] = { 5624597Szliu 0.4933787251794133561816813446e21, 5724597Szliu -.1179157629107610536038440800e21, 5824597Szliu 0.6382059341072356562289432465e19, 5924597Szliu -.1367620353088171386865416609e18, 6024597Szliu 0.1434354939140344111664316553e16, 6124597Szliu -.8085222034853793871199468171e13, 6224597Szliu 0.2507158285536881945555156435e11, 6324597Szliu -.4050412371833132706360663322e8, 6424597Szliu 0.2685786856980014981415848441e5, 6524597Szliu }; 6624597Szliu static double q1[] = { 6724597Szliu 0.4933787251794133562113278438e21, 6824597Szliu 0.5428918384092285160200195092e19, 6924597Szliu 0.3024635616709462698627330784e17, 7024597Szliu 0.1127756739679798507056031594e15, 7124597Szliu 0.3123043114941213172572469442e12, 7224597Szliu 0.6699987672982239671814028660e9, 7324597Szliu 0.1114636098462985378182402543e7, 7424597Szliu 0.1363063652328970604442810507e4, 7524597Szliu 1.0 7624597Szliu }; 7724597Szliu static double p2[] = { 7824597Szliu 0.5393485083869438325262122897e7, 7924597Szliu 0.1233238476817638145232406055e8, 8024597Szliu 0.8413041456550439208464315611e7, 8124597Szliu 0.2016135283049983642487182349e7, 8224597Szliu 0.1539826532623911470917825993e6, 8324597Szliu 0.2485271928957404011288128951e4, 8424597Szliu 0.0, 8524597Szliu }; 8624597Szliu static double q2[] = { 8724597Szliu 0.5393485083869438325560444960e7, 8824597Szliu 0.1233831022786324960844856182e8, 8924597Szliu 0.8426449050629797331554404810e7, 9024597Szliu 0.2025066801570134013891035236e7, 9124597Szliu 0.1560017276940030940592769933e6, 9224597Szliu 0.2615700736920839685159081813e4, 9324597Szliu 1.0, 9424597Szliu }; 9524597Szliu static double p3[] = { 9624597Szliu -.3984617357595222463506790588e4, 9724597Szliu -.1038141698748464093880530341e5, 9824597Szliu -.8239066313485606568803548860e4, 9924597Szliu -.2365956170779108192723612816e4, 10024597Szliu -.2262630641933704113967255053e3, 10124597Szliu -.4887199395841261531199129300e1, 10224597Szliu 0.0, 10324597Szliu }; 10424597Szliu static double q3[] = { 10524597Szliu 0.2550155108860942382983170882e6, 10624597Szliu 0.6667454239319826986004038103e6, 10724597Szliu 0.5332913634216897168722255057e6, 10824597Szliu 0.1560213206679291652539287109e6, 10924597Szliu 0.1570489191515395519392882766e5, 11024597Szliu 0.4087714673983499223402830260e3, 11124597Szliu 1.0, 11224597Szliu }; 11324597Szliu static double p4[] = { 11424597Szliu -.2750286678629109583701933175e20, 11524597Szliu 0.6587473275719554925999402049e20, 11624597Szliu -.5247065581112764941297350814e19, 11724597Szliu 0.1375624316399344078571335453e18, 11824597Szliu -.1648605817185729473122082537e16, 11924597Szliu 0.1025520859686394284509167421e14, 12024597Szliu -.3436371222979040378171030138e11, 12124597Szliu 0.5915213465686889654273830069e8, 12224597Szliu -.4137035497933148554125235152e5, 12324597Szliu }; 12424597Szliu static double q4[] = { 12524597Szliu 0.3726458838986165881989980e21, 12624597Szliu 0.4192417043410839973904769661e19, 12724597Szliu 0.2392883043499781857439356652e17, 12824597Szliu 0.9162038034075185262489147968e14, 12924597Szliu 0.2613065755041081249568482092e12, 13024597Szliu 0.5795122640700729537480087915e9, 13124597Szliu 0.1001702641288906265666651753e7, 13224597Szliu 0.1282452772478993804176329391e4, 13324597Szliu 1.0, 13424597Szliu }; 13524597Szliu 13624597Szliu double 13724597Szliu j0(arg) double arg;{ 13824597Szliu double argsq, n, d; 13924597Szliu double sin(), cos(), sqrt(); 14024597Szliu int i; 14124597Szliu 14224597Szliu if(arg < 0.) arg = -arg; 14324597Szliu if(arg > 8.){ 14424597Szliu asympt(arg); 14524597Szliu n = arg - pio4; 14624597Szliu return(sqrt(tpi/arg)*(pzero*cos(n) - qzero*sin(n))); 14724597Szliu } 14824597Szliu argsq = arg*arg; 14924597Szliu for(n=0,d=0,i=8;i>=0;i--){ 15024597Szliu n = n*argsq + p1[i]; 15124597Szliu d = d*argsq + q1[i]; 15224597Szliu } 15324597Szliu return(n/d); 15424597Szliu } 15524597Szliu 15624597Szliu double 15724597Szliu y0(arg) double arg;{ 15824597Szliu double argsq, n, d; 15924597Szliu double sin(), cos(), sqrt(), log(), j0(); 16024597Szliu int i; 16124597Szliu 16224597Szliu if(arg <= 0.){ 163*31853Szliu #if defined(vax)||defined(tahoe) 16424597Szliu extern double infnan(); 16524597Szliu return(infnan(EDOM)); /* NaN */ 166*31853Szliu #else /* defined(vax)||defined(tahoe) */ 16724597Szliu return(zero/zero); /* IEEE machines: invalid operation */ 168*31853Szliu #endif /* defined(vax)||defined(tahoe) */ 16924597Szliu } 17024597Szliu if(arg > 8.){ 17124597Szliu asympt(arg); 17224597Szliu n = arg - pio4; 17324597Szliu return(sqrt(tpi/arg)*(pzero*sin(n) + qzero*cos(n))); 17424597Szliu } 17524597Szliu argsq = arg*arg; 17624597Szliu for(n=0,d=0,i=8;i>=0;i--){ 17724597Szliu n = n*argsq + p4[i]; 17824597Szliu d = d*argsq + q4[i]; 17924597Szliu } 18024597Szliu return(n/d + tpi*j0(arg)*log(arg)); 18124597Szliu } 18224597Szliu 18324597Szliu static 18424597Szliu asympt(arg) double arg;{ 18524597Szliu double zsq, n, d; 18624597Szliu int i; 18724597Szliu zsq = 64./(arg*arg); 18824597Szliu for(n=0,d=0,i=6;i>=0;i--){ 18924597Szliu n = n*zsq + p2[i]; 19024597Szliu d = d*zsq + q2[i]; 19124597Szliu } 19224597Szliu pzero = n/d; 19324597Szliu for(n=0,d=0,i=6;i>=0;i--){ 19424597Szliu n = n*zsq + p3[i]; 19524597Szliu d = d*zsq + q3[i]; 19624597Szliu } 19724597Szliu qzero = (8./arg)*(n/d); 19824597Szliu } 199