1*34117Sbostic /* 2*34117Sbostic * Copyright (c) 1985 Regents of the University of California. 3*34117Sbostic * All rights reserved. The Berkeley software License Agreement 4*34117Sbostic * specifies the terms and conditions for redistribution. 5*34117Sbostic */ 6*34117Sbostic 724597Szliu #ifndef lint 8*34117Sbostic static char sccsid[] = "@(#)j0.c 5.2 (Berkeley) 04/29/88"; 9*34117Sbostic #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 5124597Szliu #include <math.h> 5231853Szliu #if defined(vax)||defined(tahoe) 5324597Szliu #include <errno.h> 5431853Szliu #else /* defined(vax)||defined(tahoe) */ 5524597Szliu static double zero = 0.e0; 5631853Szliu #endif /* defined(vax)||defined(tahoe) */ 5724597Szliu static double pzero, qzero; 5824597Szliu static double tpi = .6366197723675813430755350535e0; 5924597Szliu static double pio4 = .7853981633974483096156608458e0; 6024597Szliu static double p1[] = { 6124597Szliu 0.4933787251794133561816813446e21, 6224597Szliu -.1179157629107610536038440800e21, 6324597Szliu 0.6382059341072356562289432465e19, 6424597Szliu -.1367620353088171386865416609e18, 6524597Szliu 0.1434354939140344111664316553e16, 6624597Szliu -.8085222034853793871199468171e13, 6724597Szliu 0.2507158285536881945555156435e11, 6824597Szliu -.4050412371833132706360663322e8, 6924597Szliu 0.2685786856980014981415848441e5, 7024597Szliu }; 7124597Szliu static double q1[] = { 7224597Szliu 0.4933787251794133562113278438e21, 7324597Szliu 0.5428918384092285160200195092e19, 7424597Szliu 0.3024635616709462698627330784e17, 7524597Szliu 0.1127756739679798507056031594e15, 7624597Szliu 0.3123043114941213172572469442e12, 7724597Szliu 0.6699987672982239671814028660e9, 7824597Szliu 0.1114636098462985378182402543e7, 7924597Szliu 0.1363063652328970604442810507e4, 8024597Szliu 1.0 8124597Szliu }; 8224597Szliu static double p2[] = { 8324597Szliu 0.5393485083869438325262122897e7, 8424597Szliu 0.1233238476817638145232406055e8, 8524597Szliu 0.8413041456550439208464315611e7, 8624597Szliu 0.2016135283049983642487182349e7, 8724597Szliu 0.1539826532623911470917825993e6, 8824597Szliu 0.2485271928957404011288128951e4, 8924597Szliu 0.0, 9024597Szliu }; 9124597Szliu static double q2[] = { 9224597Szliu 0.5393485083869438325560444960e7, 9324597Szliu 0.1233831022786324960844856182e8, 9424597Szliu 0.8426449050629797331554404810e7, 9524597Szliu 0.2025066801570134013891035236e7, 9624597Szliu 0.1560017276940030940592769933e6, 9724597Szliu 0.2615700736920839685159081813e4, 9824597Szliu 1.0, 9924597Szliu }; 10024597Szliu static double p3[] = { 10124597Szliu -.3984617357595222463506790588e4, 10224597Szliu -.1038141698748464093880530341e5, 10324597Szliu -.8239066313485606568803548860e4, 10424597Szliu -.2365956170779108192723612816e4, 10524597Szliu -.2262630641933704113967255053e3, 10624597Szliu -.4887199395841261531199129300e1, 10724597Szliu 0.0, 10824597Szliu }; 10924597Szliu static double q3[] = { 11024597Szliu 0.2550155108860942382983170882e6, 11124597Szliu 0.6667454239319826986004038103e6, 11224597Szliu 0.5332913634216897168722255057e6, 11324597Szliu 0.1560213206679291652539287109e6, 11424597Szliu 0.1570489191515395519392882766e5, 11524597Szliu 0.4087714673983499223402830260e3, 11624597Szliu 1.0, 11724597Szliu }; 11824597Szliu static double p4[] = { 11924597Szliu -.2750286678629109583701933175e20, 12024597Szliu 0.6587473275719554925999402049e20, 12124597Szliu -.5247065581112764941297350814e19, 12224597Szliu 0.1375624316399344078571335453e18, 12324597Szliu -.1648605817185729473122082537e16, 12424597Szliu 0.1025520859686394284509167421e14, 12524597Szliu -.3436371222979040378171030138e11, 12624597Szliu 0.5915213465686889654273830069e8, 12724597Szliu -.4137035497933148554125235152e5, 12824597Szliu }; 12924597Szliu static double q4[] = { 13024597Szliu 0.3726458838986165881989980e21, 13124597Szliu 0.4192417043410839973904769661e19, 13224597Szliu 0.2392883043499781857439356652e17, 13324597Szliu 0.9162038034075185262489147968e14, 13424597Szliu 0.2613065755041081249568482092e12, 13524597Szliu 0.5795122640700729537480087915e9, 13624597Szliu 0.1001702641288906265666651753e7, 13724597Szliu 0.1282452772478993804176329391e4, 13824597Szliu 1.0, 13924597Szliu }; 14024597Szliu 14124597Szliu double 14224597Szliu j0(arg) double arg;{ 14324597Szliu double argsq, n, d; 14424597Szliu double sin(), cos(), sqrt(); 14524597Szliu int i; 14624597Szliu 14724597Szliu if(arg < 0.) arg = -arg; 14824597Szliu if(arg > 8.){ 14924597Szliu asympt(arg); 15024597Szliu n = arg - pio4; 15124597Szliu return(sqrt(tpi/arg)*(pzero*cos(n) - qzero*sin(n))); 15224597Szliu } 15324597Szliu argsq = arg*arg; 15424597Szliu for(n=0,d=0,i=8;i>=0;i--){ 15524597Szliu n = n*argsq + p1[i]; 15624597Szliu d = d*argsq + q1[i]; 15724597Szliu } 15824597Szliu return(n/d); 15924597Szliu } 16024597Szliu 16124597Szliu double 16224597Szliu y0(arg) double arg;{ 16324597Szliu double argsq, n, d; 16424597Szliu double sin(), cos(), sqrt(), log(), j0(); 16524597Szliu int i; 16624597Szliu 16724597Szliu if(arg <= 0.){ 16831853Szliu #if defined(vax)||defined(tahoe) 16924597Szliu extern double infnan(); 17024597Szliu return(infnan(EDOM)); /* NaN */ 17131853Szliu #else /* defined(vax)||defined(tahoe) */ 17224597Szliu return(zero/zero); /* IEEE machines: invalid operation */ 17331853Szliu #endif /* defined(vax)||defined(tahoe) */ 17424597Szliu } 17524597Szliu if(arg > 8.){ 17624597Szliu asympt(arg); 17724597Szliu n = arg - pio4; 17824597Szliu return(sqrt(tpi/arg)*(pzero*sin(n) + qzero*cos(n))); 17924597Szliu } 18024597Szliu argsq = arg*arg; 18124597Szliu for(n=0,d=0,i=8;i>=0;i--){ 18224597Szliu n = n*argsq + p4[i]; 18324597Szliu d = d*argsq + q4[i]; 18424597Szliu } 18524597Szliu return(n/d + tpi*j0(arg)*log(arg)); 18624597Szliu } 18724597Szliu 18824597Szliu static 18924597Szliu asympt(arg) double arg;{ 19024597Szliu double zsq, n, d; 19124597Szliu int i; 19224597Szliu zsq = 64./(arg*arg); 19324597Szliu for(n=0,d=0,i=6;i>=0;i--){ 19424597Szliu n = n*zsq + p2[i]; 19524597Szliu d = d*zsq + q2[i]; 19624597Szliu } 19724597Szliu pzero = n/d; 19824597Szliu for(n=0,d=0,i=6;i>=0;i--){ 19924597Szliu n = n*zsq + p3[i]; 20024597Szliu d = d*zsq + q3[i]; 20124597Szliu } 20224597Szliu qzero = (8./arg)*(n/d); 20324597Szliu } 204