134117Sbostic /* 234117Sbostic * Copyright (c) 1985 Regents of the University of California. 334117Sbostic * All rights reserved. The Berkeley software License Agreement 434117Sbostic * specifies the terms and conditions for redistribution. 534117Sbostic */ 634117Sbostic 724597Szliu #ifndef lint 8*35679Sbostic static char sccsid[] = "@(#)j0.c 5.3 (Berkeley) 09/22/88"; 934117Sbostic #endif /* not lint */ 1024597Szliu 1124597Szliu /* 1224597Szliu floating point Bessel's function 1324597Szliu of the first and second kinds 1424597Szliu of order zero 1524597Szliu 1624597Szliu j0(x) returns the value of J0(x) 1724597Szliu for all real values of x. 1824597Szliu 1924597Szliu There are no error returns. 2024597Szliu Calls sin, cos, sqrt. 2124597Szliu 2224597Szliu There is a niggling bug in J0 which 2324597Szliu causes errors up to 2e-16 for x in the 2424597Szliu interval [-8,8]. 2524597Szliu The bug is caused by an inappropriate order 2624597Szliu of summation of the series. rhm will fix it 2724597Szliu someday. 2824597Szliu 2924597Szliu Coefficients are from Hart & Cheney. 3024597Szliu #5849 (19.22D) 3124597Szliu #6549 (19.25D) 3224597Szliu #6949 (19.41D) 3324597Szliu 3424597Szliu y0(x) returns the value of Y0(x) 3524597Szliu for positive real values of x. 3624597Szliu For x<=0, if on the VAX, error number EDOM is set and 3724597Szliu the reserved operand fault is generated; 3824597Szliu otherwise (an IEEE machine) an invalid operation is performed. 3924597Szliu 4024597Szliu Calls sin, cos, sqrt, log, j0. 4124597Szliu 4224597Szliu The values of Y0 have not been checked 4324597Szliu to more than ten places. 4424597Szliu 4524597Szliu Coefficients are from Hart & Cheney. 4624597Szliu #6245 (18.78D) 4724597Szliu #6549 (19.25D) 4824597Szliu #6949 (19.41D) 4924597Szliu */ 5024597Szliu 51*35679Sbostic #include "mathimpl.h" 52*35679Sbostic 5331853Szliu #if defined(vax)||defined(tahoe) 5424597Szliu #include <errno.h> 5531853Szliu #else /* defined(vax)||defined(tahoe) */ 56*35679Sbostic static const double zero = 0.e0; 5731853Szliu #endif /* defined(vax)||defined(tahoe) */ 58*35679Sbostic 5924597Szliu static double pzero, qzero; 60*35679Sbostic 61*35679Sbostic static const double tpi = .6366197723675813430755350535e0; 62*35679Sbostic static const double pio4 = .7853981633974483096156608458e0; 63*35679Sbostic static const double p1[] = { 6424597Szliu 0.4933787251794133561816813446e21, 6524597Szliu -.1179157629107610536038440800e21, 6624597Szliu 0.6382059341072356562289432465e19, 6724597Szliu -.1367620353088171386865416609e18, 6824597Szliu 0.1434354939140344111664316553e16, 6924597Szliu -.8085222034853793871199468171e13, 7024597Szliu 0.2507158285536881945555156435e11, 7124597Szliu -.4050412371833132706360663322e8, 7224597Szliu 0.2685786856980014981415848441e5, 7324597Szliu }; 74*35679Sbostic static const double q1[] = { 7524597Szliu 0.4933787251794133562113278438e21, 7624597Szliu 0.5428918384092285160200195092e19, 7724597Szliu 0.3024635616709462698627330784e17, 7824597Szliu 0.1127756739679798507056031594e15, 7924597Szliu 0.3123043114941213172572469442e12, 8024597Szliu 0.6699987672982239671814028660e9, 8124597Szliu 0.1114636098462985378182402543e7, 8224597Szliu 0.1363063652328970604442810507e4, 8324597Szliu 1.0 8424597Szliu }; 85*35679Sbostic static const double p2[] = { 8624597Szliu 0.5393485083869438325262122897e7, 8724597Szliu 0.1233238476817638145232406055e8, 8824597Szliu 0.8413041456550439208464315611e7, 8924597Szliu 0.2016135283049983642487182349e7, 9024597Szliu 0.1539826532623911470917825993e6, 9124597Szliu 0.2485271928957404011288128951e4, 9224597Szliu 0.0, 9324597Szliu }; 94*35679Sbostic static const double q2[] = { 9524597Szliu 0.5393485083869438325560444960e7, 9624597Szliu 0.1233831022786324960844856182e8, 9724597Szliu 0.8426449050629797331554404810e7, 9824597Szliu 0.2025066801570134013891035236e7, 9924597Szliu 0.1560017276940030940592769933e6, 10024597Szliu 0.2615700736920839685159081813e4, 10124597Szliu 1.0, 10224597Szliu }; 103*35679Sbostic static const double p3[] = { 10424597Szliu -.3984617357595222463506790588e4, 10524597Szliu -.1038141698748464093880530341e5, 10624597Szliu -.8239066313485606568803548860e4, 10724597Szliu -.2365956170779108192723612816e4, 10824597Szliu -.2262630641933704113967255053e3, 10924597Szliu -.4887199395841261531199129300e1, 11024597Szliu 0.0, 11124597Szliu }; 112*35679Sbostic static const double q3[] = { 11324597Szliu 0.2550155108860942382983170882e6, 11424597Szliu 0.6667454239319826986004038103e6, 11524597Szliu 0.5332913634216897168722255057e6, 11624597Szliu 0.1560213206679291652539287109e6, 11724597Szliu 0.1570489191515395519392882766e5, 11824597Szliu 0.4087714673983499223402830260e3, 11924597Szliu 1.0, 12024597Szliu }; 121*35679Sbostic static const double p4[] = { 12224597Szliu -.2750286678629109583701933175e20, 12324597Szliu 0.6587473275719554925999402049e20, 12424597Szliu -.5247065581112764941297350814e19, 12524597Szliu 0.1375624316399344078571335453e18, 12624597Szliu -.1648605817185729473122082537e16, 12724597Szliu 0.1025520859686394284509167421e14, 12824597Szliu -.3436371222979040378171030138e11, 12924597Szliu 0.5915213465686889654273830069e8, 13024597Szliu -.4137035497933148554125235152e5, 13124597Szliu }; 132*35679Sbostic static const double q4[] = { 13324597Szliu 0.3726458838986165881989980e21, 13424597Szliu 0.4192417043410839973904769661e19, 13524597Szliu 0.2392883043499781857439356652e17, 13624597Szliu 0.9162038034075185262489147968e14, 13724597Szliu 0.2613065755041081249568482092e12, 13824597Szliu 0.5795122640700729537480087915e9, 13924597Szliu 0.1001702641288906265666651753e7, 14024597Szliu 0.1282452772478993804176329391e4, 14124597Szliu 1.0, 14224597Szliu }; 14324597Szliu 144*35679Sbostic static void asympt(); 145*35679Sbostic 14624597Szliu double 14724597Szliu j0(arg) double arg;{ 14824597Szliu double argsq, n, d; 14924597Szliu int i; 15024597Szliu 15124597Szliu if(arg < 0.) arg = -arg; 15224597Szliu if(arg > 8.){ 15324597Szliu asympt(arg); 15424597Szliu n = arg - pio4; 15524597Szliu return(sqrt(tpi/arg)*(pzero*cos(n) - qzero*sin(n))); 15624597Szliu } 15724597Szliu argsq = arg*arg; 15824597Szliu for(n=0,d=0,i=8;i>=0;i--){ 15924597Szliu n = n*argsq + p1[i]; 16024597Szliu d = d*argsq + q1[i]; 16124597Szliu } 16224597Szliu return(n/d); 16324597Szliu } 16424597Szliu 16524597Szliu double 16624597Szliu y0(arg) double arg;{ 16724597Szliu double argsq, n, d; 16824597Szliu int i; 16924597Szliu 17024597Szliu if(arg <= 0.){ 17131853Szliu #if defined(vax)||defined(tahoe) 17224597Szliu return(infnan(EDOM)); /* NaN */ 17331853Szliu #else /* defined(vax)||defined(tahoe) */ 17424597Szliu return(zero/zero); /* IEEE machines: invalid operation */ 17531853Szliu #endif /* defined(vax)||defined(tahoe) */ 17624597Szliu } 17724597Szliu if(arg > 8.){ 17824597Szliu asympt(arg); 17924597Szliu n = arg - pio4; 18024597Szliu return(sqrt(tpi/arg)*(pzero*sin(n) + qzero*cos(n))); 18124597Szliu } 18224597Szliu argsq = arg*arg; 18324597Szliu for(n=0,d=0,i=8;i>=0;i--){ 18424597Szliu n = n*argsq + p4[i]; 18524597Szliu d = d*argsq + q4[i]; 18624597Szliu } 18724597Szliu return(n/d + tpi*j0(arg)*log(arg)); 18824597Szliu } 18924597Szliu 190*35679Sbostic static void 19124597Szliu asympt(arg) double arg;{ 19224597Szliu double zsq, n, d; 19324597Szliu int i; 19424597Szliu zsq = 64./(arg*arg); 19524597Szliu for(n=0,d=0,i=6;i>=0;i--){ 19624597Szliu n = n*zsq + p2[i]; 19724597Szliu d = d*zsq + q2[i]; 19824597Szliu } 19924597Szliu pzero = n/d; 20024597Szliu for(n=0,d=0,i=6;i>=0;i--){ 20124597Szliu n = n*zsq + p3[i]; 20224597Szliu d = d*zsq + q3[i]; 20324597Szliu } 20424597Szliu qzero = (8./arg)*(n/d); 20524597Szliu } 206