1*48402Sbostic /*- 2*48402Sbostic * Copyright (c) 1985 The Regents of the University of California. 3*48402Sbostic * All rights reserved. 4*48402Sbostic * 5*48402Sbostic * %sccs.include.proprietary.c% 634117Sbostic */ 734117Sbostic 824597Szliu #ifndef lint 9*48402Sbostic static char sccsid[] = "@(#)j0.c 5.4 (Berkeley) 04/20/91"; 1034117Sbostic #endif /* not lint */ 1124597Szliu 1224597Szliu /* 1324597Szliu floating point Bessel's function 1424597Szliu of the first and second kinds 1524597Szliu of order zero 1624597Szliu 1724597Szliu j0(x) returns the value of J0(x) 1824597Szliu for all real values of x. 1924597Szliu 2024597Szliu There are no error returns. 2124597Szliu Calls sin, cos, sqrt. 2224597Szliu 2324597Szliu There is a niggling bug in J0 which 2424597Szliu causes errors up to 2e-16 for x in the 2524597Szliu interval [-8,8]. 2624597Szliu The bug is caused by an inappropriate order 2724597Szliu of summation of the series. rhm will fix it 2824597Szliu someday. 2924597Szliu 3024597Szliu Coefficients are from Hart & Cheney. 3124597Szliu #5849 (19.22D) 3224597Szliu #6549 (19.25D) 3324597Szliu #6949 (19.41D) 3424597Szliu 3524597Szliu y0(x) returns the value of Y0(x) 3624597Szliu for positive real values of x. 3724597Szliu For x<=0, if on the VAX, error number EDOM is set and 3824597Szliu the reserved operand fault is generated; 3924597Szliu otherwise (an IEEE machine) an invalid operation is performed. 4024597Szliu 4124597Szliu Calls sin, cos, sqrt, log, j0. 4224597Szliu 4324597Szliu The values of Y0 have not been checked 4424597Szliu to more than ten places. 4524597Szliu 4624597Szliu Coefficients are from Hart & Cheney. 4724597Szliu #6245 (18.78D) 4824597Szliu #6549 (19.25D) 4924597Szliu #6949 (19.41D) 5024597Szliu */ 5124597Szliu 5235679Sbostic #include "mathimpl.h" 5335679Sbostic 5431853Szliu #if defined(vax)||defined(tahoe) 5524597Szliu #include <errno.h> 5631853Szliu #else /* defined(vax)||defined(tahoe) */ 5735679Sbostic static const double zero = 0.e0; 5831853Szliu #endif /* defined(vax)||defined(tahoe) */ 5935679Sbostic 6024597Szliu static double pzero, qzero; 6135679Sbostic 6235679Sbostic static const double tpi = .6366197723675813430755350535e0; 6335679Sbostic static const double pio4 = .7853981633974483096156608458e0; 6435679Sbostic static const double p1[] = { 6524597Szliu 0.4933787251794133561816813446e21, 6624597Szliu -.1179157629107610536038440800e21, 6724597Szliu 0.6382059341072356562289432465e19, 6824597Szliu -.1367620353088171386865416609e18, 6924597Szliu 0.1434354939140344111664316553e16, 7024597Szliu -.8085222034853793871199468171e13, 7124597Szliu 0.2507158285536881945555156435e11, 7224597Szliu -.4050412371833132706360663322e8, 7324597Szliu 0.2685786856980014981415848441e5, 7424597Szliu }; 7535679Sbostic static const double q1[] = { 7624597Szliu 0.4933787251794133562113278438e21, 7724597Szliu 0.5428918384092285160200195092e19, 7824597Szliu 0.3024635616709462698627330784e17, 7924597Szliu 0.1127756739679798507056031594e15, 8024597Szliu 0.3123043114941213172572469442e12, 8124597Szliu 0.6699987672982239671814028660e9, 8224597Szliu 0.1114636098462985378182402543e7, 8324597Szliu 0.1363063652328970604442810507e4, 8424597Szliu 1.0 8524597Szliu }; 8635679Sbostic static const double p2[] = { 8724597Szliu 0.5393485083869438325262122897e7, 8824597Szliu 0.1233238476817638145232406055e8, 8924597Szliu 0.8413041456550439208464315611e7, 9024597Szliu 0.2016135283049983642487182349e7, 9124597Szliu 0.1539826532623911470917825993e6, 9224597Szliu 0.2485271928957404011288128951e4, 9324597Szliu 0.0, 9424597Szliu }; 9535679Sbostic static const double q2[] = { 9624597Szliu 0.5393485083869438325560444960e7, 9724597Szliu 0.1233831022786324960844856182e8, 9824597Szliu 0.8426449050629797331554404810e7, 9924597Szliu 0.2025066801570134013891035236e7, 10024597Szliu 0.1560017276940030940592769933e6, 10124597Szliu 0.2615700736920839685159081813e4, 10224597Szliu 1.0, 10324597Szliu }; 10435679Sbostic static const double p3[] = { 10524597Szliu -.3984617357595222463506790588e4, 10624597Szliu -.1038141698748464093880530341e5, 10724597Szliu -.8239066313485606568803548860e4, 10824597Szliu -.2365956170779108192723612816e4, 10924597Szliu -.2262630641933704113967255053e3, 11024597Szliu -.4887199395841261531199129300e1, 11124597Szliu 0.0, 11224597Szliu }; 11335679Sbostic static const double q3[] = { 11424597Szliu 0.2550155108860942382983170882e6, 11524597Szliu 0.6667454239319826986004038103e6, 11624597Szliu 0.5332913634216897168722255057e6, 11724597Szliu 0.1560213206679291652539287109e6, 11824597Szliu 0.1570489191515395519392882766e5, 11924597Szliu 0.4087714673983499223402830260e3, 12024597Szliu 1.0, 12124597Szliu }; 12235679Sbostic static const double p4[] = { 12324597Szliu -.2750286678629109583701933175e20, 12424597Szliu 0.6587473275719554925999402049e20, 12524597Szliu -.5247065581112764941297350814e19, 12624597Szliu 0.1375624316399344078571335453e18, 12724597Szliu -.1648605817185729473122082537e16, 12824597Szliu 0.1025520859686394284509167421e14, 12924597Szliu -.3436371222979040378171030138e11, 13024597Szliu 0.5915213465686889654273830069e8, 13124597Szliu -.4137035497933148554125235152e5, 13224597Szliu }; 13335679Sbostic static const double q4[] = { 13424597Szliu 0.3726458838986165881989980e21, 13524597Szliu 0.4192417043410839973904769661e19, 13624597Szliu 0.2392883043499781857439356652e17, 13724597Szliu 0.9162038034075185262489147968e14, 13824597Szliu 0.2613065755041081249568482092e12, 13924597Szliu 0.5795122640700729537480087915e9, 14024597Szliu 0.1001702641288906265666651753e7, 14124597Szliu 0.1282452772478993804176329391e4, 14224597Szliu 1.0, 14324597Szliu }; 14424597Szliu 14535679Sbostic static void asympt(); 14635679Sbostic 14724597Szliu double 14824597Szliu j0(arg) double arg;{ 14924597Szliu double argsq, n, d; 15024597Szliu int i; 15124597Szliu 15224597Szliu if(arg < 0.) arg = -arg; 15324597Szliu if(arg > 8.){ 15424597Szliu asympt(arg); 15524597Szliu n = arg - pio4; 15624597Szliu return(sqrt(tpi/arg)*(pzero*cos(n) - qzero*sin(n))); 15724597Szliu } 15824597Szliu argsq = arg*arg; 15924597Szliu for(n=0,d=0,i=8;i>=0;i--){ 16024597Szliu n = n*argsq + p1[i]; 16124597Szliu d = d*argsq + q1[i]; 16224597Szliu } 16324597Szliu return(n/d); 16424597Szliu } 16524597Szliu 16624597Szliu double 16724597Szliu y0(arg) double arg;{ 16824597Szliu double argsq, n, d; 16924597Szliu int i; 17024597Szliu 17124597Szliu if(arg <= 0.){ 17231853Szliu #if defined(vax)||defined(tahoe) 17324597Szliu return(infnan(EDOM)); /* NaN */ 17431853Szliu #else /* defined(vax)||defined(tahoe) */ 17524597Szliu return(zero/zero); /* IEEE machines: invalid operation */ 17631853Szliu #endif /* defined(vax)||defined(tahoe) */ 17724597Szliu } 17824597Szliu if(arg > 8.){ 17924597Szliu asympt(arg); 18024597Szliu n = arg - pio4; 18124597Szliu return(sqrt(tpi/arg)*(pzero*sin(n) + qzero*cos(n))); 18224597Szliu } 18324597Szliu argsq = arg*arg; 18424597Szliu for(n=0,d=0,i=8;i>=0;i--){ 18524597Szliu n = n*argsq + p4[i]; 18624597Szliu d = d*argsq + q4[i]; 18724597Szliu } 18824597Szliu return(n/d + tpi*j0(arg)*log(arg)); 18924597Szliu } 19024597Szliu 19135679Sbostic static void 19224597Szliu asympt(arg) double arg;{ 19324597Szliu double zsq, n, d; 19424597Szliu int i; 19524597Szliu zsq = 64./(arg*arg); 19624597Szliu for(n=0,d=0,i=6;i>=0;i--){ 19724597Szliu n = n*zsq + p2[i]; 19824597Szliu d = d*zsq + q2[i]; 19924597Szliu } 20024597Szliu pzero = n/d; 20124597Szliu for(n=0,d=0,i=6;i>=0;i--){ 20224597Szliu n = n*zsq + p3[i]; 20324597Szliu d = d*zsq + q3[i]; 20424597Szliu } 20524597Szliu qzero = (8./arg)*(n/d); 20624597Szliu } 207