bessel.cpp

基于Visual C++环境的的Bessel函数程序

    double qzero;
    double p4;
    double q4;

    if( x>8.0 )
    {
        besselasympt1(x, pzero, qzero);
        nn = x-3*ap::pi()/4;
        result = sqrt(2/ap::pi()/x)*(pzero*sin(nn)+qzero*cos(nn));
        return result;
    }
    xsq = ap::sqr(x);
    p4 = -2108847.540133123652824139923;
    p4 = 3639488548.124002058278999428+xsq*p4;
    p4 = -2580681702194.450950541426399+xsq*p4;
    p4 = 956993023992168.3481121552788+xsq*p4;
    p4 = -196588746272214065.8820322248+xsq*p4;
    p4 = 21931073399177975921.11427556+xsq*p4;
    p4 = -1212297555414509577913.561535+xsq*p4;
    p4 = 26554738314348543268942.48968+xsq*p4;
    p4 = -99637534243069222259967.44354+xsq*p4;
    q4 = 1.0;
    q4 = 1612.361029677000859332072312+xsq*q4;
    q4 = 1563282.754899580604737366452+xsq*q4;
    q4 = 1128686837.169442121732366891+xsq*q4;
    q4 = 646534088126.5275571961681500+xsq*q4;
    q4 = 297663212564727.6729292742282+xsq*q4;
    q4 = 108225825940881955.2553850180+xsq*q4;
    q4 = 29549879358971486742.90758119+xsq*q4;
    q4 = 5435310377188854170800.653097+xsq*q4;
    q4 = 508206736694124324531442.4152+xsq*q4;
    result = x*p4/q4+2/ap::pi()*(besselj1(x)*log(x)-1/x);
    return result;
}


/*************************************************************************
Bessel function of second kind of integer order

Returns Bessel function of order n, where n is a
(possibly negative) integer.

The function is evaluated by forward recurrence on
n, starting with values computed by the routines
y0() and y1().

If n = 0 or 1 the routine for y0 or y1 is called
directly.

ACCURACY:
                     Absolute error, except relative
                     when y > 1:
arithmetic   domain     # trials      peak         rms
   IEEE      0, 30       30000       3.4e-15     4.3e-16

Cephes Math Library Release 2.8:  June, 2000
Copyright 1984, 1987, 2000 by Stephen L. Moshier
*************************************************************************/
BESSEL_API double besselyn(int n, double x)
{
    double result;
    int i;
    double a;
    double b;
    double tmp;
    double s;

    s = 1;
    if( n<0 )
    {
        n = -n;
        if( n%2!=0 )
        {
            s = -1;
        }
    }
    if( n==0 )
    {
        result = bessely0(x);
        return result;
    }
    if( n==1 )
    {
        result = s*bessely1(x);
        return result;
    }
    a = bessely0(x);
    b = bessely1(x);
    for(i = 1; i <= n-1; i++)
    {
        tmp = b;
        b = 2*i/x*b-a;
        a = tmp;
    }
    result = s*b;
    return result;
}


/*************************************************************************
Modified Bessel function of order zero

Returns modified Bessel function of order zero of the
argument.

The function is defined as i0(x) = j0( ix ).

The range is partitioned into the two intervals [0,8] and
(8, infinity).  Chebyshev polynomial expansions are employed
in each interval.

ACCURACY:

                     Relative error:
arithmetic   domain     # trials      peak         rms
   IEEE      0,30        30000       5.8e-16     1.4e-16

Cephes Math Library Release 2.8:  June, 2000
Copyright 1984, 1987, 2000 by Stephen L. Moshier
*************************************************************************/
BESSEL_API double besseli0(double x)
{
    double result;
    double y;
    double v;
    double z;
    double b0;
    double b1;
    double b2;

    if( x<0 )
    {
        x = -x;
    }
    if( x<=8.0 )
    {
        y = x/2.0-2.0;
        besselmfirstcheb(-4.41534164647933937950E-18, b0, b1, b2);
        besselmnextcheb(y, 3.33079451882223809783E-17, b0, b1, b2);
        besselmnextcheb(y, -2.43127984654795469359E-16, b0, b1, b2);
        besselmnextcheb(y, 1.71539128555513303061E-15, b0, b1, b2);
        besselmnextcheb(y, -1.16853328779934516808E-14, b0, b1, b2);
        besselmnextcheb(y, 7.67618549860493561688E-14, b0, b1, b2);
        besselmnextcheb(y, -4.85644678311192946090E-13, b0, b1, b2);
        besselmnextcheb(y, 2.95505266312963983461E-12, b0, b1, b2);
        besselmnextcheb(y, -1.72682629144155570723E-11, b0, b1, b2);
        besselmnextcheb(y, 9.67580903537323691224E-11, b0, b1, b2);
        besselmnextcheb(y, -5.18979560163526290666E-10, b0, b1, b2);
        besselmnextcheb(y, 2.65982372468238665035E-9, b0, b1, b2);
        besselmnextcheb(y, -1.30002500998624804212E-8, b0, b1, b2);
        besselmnextcheb(y, 6.04699502254191894932E-8, b0, b1, b2);
        besselmnextcheb(y, -2.67079385394061173391E-7, b0, b1, b2);
        besselmnextcheb(y, 1.11738753912010371815E-6, b0, b1, b2);
        besselmnextcheb(y, -4.41673835845875056359E-6, b0, b1, b2);
        besselmnextcheb(y, 1.64484480707288970893E-5, b0, b1, b2);
        besselmnextcheb(y, -5.75419501008210370398E-5, b0, b1, b2);
        besselmnextcheb(y, 1.88502885095841655729E-4, b0, b1, b2);
        besselmnextcheb(y, -5.76375574538582365885E-4, b0, b1, b2);
        besselmnextcheb(y, 1.63947561694133579842E-3, b0, b1, b2);
        besselmnextcheb(y, -4.32430999505057594430E-3, b0, b1, b2);
        besselmnextcheb(y, 1.05464603945949983183E-2, b0, b1, b2);
        besselmnextcheb(y, -2.37374148058994688156E-2, b0, b1, b2);
        besselmnextcheb(y, 4.93052842396707084878E-2, b0, b1, b2);
        besselmnextcheb(y, -9.49010970480476444210E-2, b0, b1, b2);
        besselmnextcheb(y, 1.71620901522208775349E-1, b0, b1, b2);
        besselmnextcheb(y, -3.04682672343198398683E-1, b0, b1, b2);
        besselmnextcheb(y, 6.76795274409476084995E-1, b0, b1, b2);
        v = 0.5*(b0-b2);
        result = exp(x)*v;
        return result;
    }
    z = 32.0/x-2.0;
    besselmfirstcheb(-7.23318048787475395456E-18, b0, b1, b2);
    besselmnextcheb(z, -4.83050448594418207126E-18, b0, b1, b2);
    besselmnextcheb(z, 4.46562142029675999901E-17, b0, b1, b2);
    besselmnextcheb(z, 3.46122286769746109310E-17, b0, b1, b2);
    besselmnextcheb(z, -2.82762398051658348494E-16, b0, b1, b2);
    besselmnextcheb(z, -3.42548561967721913462E-16, b0, b1, b2);
    besselmnextcheb(z, 1.77256013305652638360E-15, b0, b1, b2);
    besselmnextcheb(z, 3.81168066935262242075E-15, b0, b1, b2);
    besselmnextcheb(z, -9.55484669882830764870E-15, b0, b1, b2);
    besselmnextcheb(z, -4.15056934728722208663E-14, b0, b1, b2);
    besselmnextcheb(z, 1.54008621752140982691E-14, b0, b1, b2);
    besselmnextcheb(z, 3.85277838274214270114E-13, b0, b1, b2);
    besselmnextcheb(z, 7.18012445138366623367E-13, b0, b1, b2);
    besselmnextcheb(z, -1.79417853150680611778E-12, b0, b1, b2);
    besselmnextcheb(z, -1.32158118404477131188E-11, b0, b1, b2);
    besselmnextcheb(z, -3.14991652796324136454E-11, b0, b1, b2);
    besselmnextcheb(z, 1.18891471078464383424E-11, b0, b1, b2);
    besselmnextcheb(z, 4.94060238822496958910E-10, b0, b1, b2);
    besselmnextcheb(z, 3.39623202570838634515E-9, b0, b1, b2);
    besselmnextcheb(z, 2.26666899049817806459E-8, b0, b1, b2);
    besselmnextcheb(z, 2.04891858946906374183E-7, b0, b1, b2);
    besselmnextcheb(z, 2.89137052083475648297E-6, b0, b1, b2);
    besselmnextcheb(z, 6.88975834691682398426E-5, b0, b1, b2);
    besselmnextcheb(z, 3.36911647825569408990E-3, b0, b1, b2);
    besselmnextcheb(z, 8.04490411014108831608E-1, b0, b1, b2);
    v = 0.5*(b0-b2);
    result = exp(x)*v/sqrt(x);
    return result;
}


/*************************************************************************
Modified Bessel function of order one

Returns modified Bessel function of order one of the
argument.

The function is defined as i1(x) = -i j1( ix ).

The range is partitioned into the two intervals [0,8] and
(8, infinity).  Chebyshev polynomial expansions are employed
in each interval.

ACCURACY:

                     Relative error:
arithmetic   domain     # trials      peak         rms
   IEEE      0, 30       30000       1.9e-15     2.1e-16

Cephes Math Library Release 2.8:  June, 2000
Copyright 1985, 1987, 2000 by Stephen L. Moshier
*************************************************************************/
BESSEL_API double besseli1(double x)
{
    double result;
    double y;
    double z;
    double v;
    double b0;
    double b1;
    double b2;

    z = fabs(x);
    if( z<=8.0 )
    {
        y = z/2.0-2.0;
        besselm1firstcheb(2.77791411276104639959E-18, b0, b1, b2);
        besselm1nextcheb(y, -2.11142121435816608115E-17, b0, b1, b2);
        besselm1nextcheb(y, 1.55363195773620046921E-16, b0, b1, b2);
        besselm1nextcheb(y, -1.10559694773538630805E-15, b0, b1, b2);
        besselm1nextcheb(y, 7.60068429473540693410E-15, b0, b1, b2);
        besselm1nextcheb(y, -5.04218550472791168711E-14, b0, b1, b2);
        besselm1nextcheb(y, 3.22379336594557470981E-13, b0, b1, b2);
        besselm1nextcheb(y, -1.98397439776494371520E-12, b0, b1, b2);
        besselm1nextcheb(y, 1.17361862988909016308E-11, b0, b1, b2);
        besselm1nextcheb(y, -6.66348972350202774223E-11, b0, b1, b2);
        besselm1nextcheb(y, 3.62559028155211703701E-10, b0, b1, b2);
        besselm1nextcheb(y, -1.88724975172282928790E-9, b0, b1, b2);
        besselm1nextcheb(y, 9.38153738649577178388E-9, b0, b1, b2);
        besselm1nextcheb(y, -4.44505912879632808065E-8, b0, b1, b2);
        besselm1nextcheb(y, 2.00329475355213526229E-7, b0, b1, b2);
        besselm1nextcheb(y, -8.56872026469545474066E-7, b0, b1, b2);
        besselm1nextcheb(y, 3.47025130813767847674E-6, b0, b1, b2);
        besselm1nextcheb(y, -1.32731636560394358279E-5, b0, b1, b2);
        besselm1nextcheb(y, 4.78156510755005422638E-5, b0, b1, b2);
        besselm1nextcheb(y, -1.61760815825896745588E-4, b0, b1, b2);
        besselm1nextcheb(y, 5.12285956168575772895E-4, b0, b1, b2);
        besselm1nextcheb(y, -1.51357245063125314899E-3, b0, b1, b2);
        besselm1nextcheb(y, 4.15642294431288815669E-3, b0, b1, b2);
        besselm1nextcheb(y, -1.05640848946261981558E-2, b0, b1, b2);
        besselm1nextcheb(y, 2.47264490306265168283E-2, b0, b1, b2);
        besselm1nextcheb(y, -5.29459812080949914269E-2, b0, b1, b2);
        besselm1nextcheb(y, 1.02643658689847095384E-1, b0, b1, b2);
        besselm1nextcheb(y, -1.76416518357834055153E-1, b0, b1, b2);
        besselm1nextcheb(y, 2.52587186443633654823E-1, b0, b1, b2);
        v = 0.5*(b0-b2);
        z = v*z*exp(z);
    }
    else
    {
        y = 32.0/z-2.0;
        besselm1firstcheb(7.51729631084210481353E-18, b0, b1, b2);
        besselm1nextcheb(y, 4.41434832307170791151E-18, b0, b1, b2);
        besselm1nextcheb(y, -4.65030536848935832153E-17, b0, b1, b2);
        besselm1nextcheb(y, -3.20952592199342395980E-17, b0, b1, b2);
        besselm1nextcheb(y, 2.96262899764595013876E-16, b0, b1, b2);
        besselm1nextcheb(y, 3.30820231092092828324E-16, b0, b1, b2);
        besselm1nextcheb(y, -1.88035477551078244854E-15, b0, b1, b2);
        besselm1nextcheb(y, -3.81440307243700780478E-15, b0, b1, b2);
        besselm1nextcheb(y, 1.04202769841288027642E-14, b0, b1, b2);
        besselm1nextcheb(y, 4.27244001671195135429E-14, b0, b1, b2);
        besselm1nextcheb(y, -2.10154184277266431302E-14, b0, b1, b2);
        besselm1nextcheb(y, -4.08355111109219731823E-13, b0, b1, b2);
        besselm1nextcheb(y, -7.19855177624590851209E-13, b0, b1, b2);
        besselm1nextcheb(y, 2.03562854414708950722E-12, b0, b1, b2);
        besselm1nextcheb(y, 1.41258074366137813316E-11, b0, b1, b2);
        besselm1nextcheb(y, 3.25260358301548823856E-11, b0, b1, b2);
        besselm1nextcheb(y, -1.89749581235054123450E-11, b0, b1, b2);
        besselm1nextcheb(y, -5.58974346219658380687E-10, b0, b1, b2);
        besselm1nextcheb(y, -3.83538038596423702205E-9, b0, b1, b2);
        besselm1nextcheb(y, -2.63146884688951950684E-8, b0, b1, b2);
        besselm1nextcheb(y, -2.51223623787020892529E-7, b0, b1, b2);
        besselm1nextcheb(y, -3.88256480887769039346E-6, b0, b1, b2);
        besselm1nextcheb(y, -1.10588938762623716291E-4, b0, b1, b2);
        besselm1nextcheb(y, -9.76109749136146840777E-3, b0, b1, b2);
        besselm1nextcheb(y, 7.78576235018280120474E-1, b0, b1, b2);
        v = 0.5*(b0-b2);
        z = v*exp(z)/sqrt(z);
    }
    if( x<0 )
    {
        z = -z;
    }
    result = z;
    return result;
}


/*************************************************************************
Modified Bessel function, second kind, order zero

Returns modified Bessel function of the second kind
of order zero of the argument.

The range is partitioned into the two intervals [0,8] and
(8, infinity).  Chebyshev polynomial expansions are employed
in each interval.

ACCURACY:

Tested at 2000 random points between 0 and 8.  Peak absolute
error (relative when K0 > 1) was 1.46e-14; rms, 4.26e-15.
                     Relative error:
arithmetic   domain     # trials      peak         rms
   IEEE      0, 30       30000       1.2e-15     1.6e-16

Cephes Math Library Release 2.8:  June, 2000
Copyright 1984, 1987, 2000 by Stephen L. Moshier
*************************************************************************/
BESSEL_API double besselk0(double x)
{
    double result;
    double y;
    double z;
    double v;
    double b0;
    double b1;
    double b2;

    ap::ap_error::make_assertion(x>0);
    if( x<=2 )
    {
        y = x*x-2.0;
        besselmfirstcheb(1.37446543561352307156E-16, b0, b1, b2);
        besselmnextcheb(y, 4.25981614279661018399E-14, b0, b1, b2);
        besselmnextcheb(y, 1.03496952576338420167E-11, b0, b1, b2);
        besselmnextcheb(y, 1.90451637722020886025E-9, b0, b1, b2);
        besselmnextcheb(y, 2.53479107902614945675E-7, b0, b1, b2);
        besselmnextcheb(y, 2.28621210311945178607E-5, b0, b1, b2);
        besselmnextcheb(y, 1.26461541144692592338E-3, b0, b1, b2);
        besselmnextcheb(y, 3.59799365153615016266E-2, b0, b1, b2);
        besselmnextcheb(y, 3.44289899924628486886E-1, b0, b1, b2);
        besselmnextcheb(y, -5.35327393233902768720E-1, b0, b1, b2);
        v = 0.5*(b0-b2);
        v = v-log(0.5*x)*besseli0(x);
    }
    else
    {
        z = 8.0/x-2.0;
        besselmfirstcheb(5.30043377268626276149E-18, b0, b1, b2);
        besselmnextcheb(z, -1.64758043015242134646E-17, b0, b1, b2);
        besselmnextcheb(z, 5.21039150503902756861E-17, b0, b1, b2);
        besselmnextcheb(z, -1.67823109680541210385E-16, b0, b1, b2);
        besselmnextcheb(z, 5.51205597852431940784E-16, b0, b1, b2);
        besselmnextcheb(z, -1.84859337734377901440E-15, b0, b1, b2);
        besselmnextcheb(z, 6.34007647740507060557E-15, b0, b1, b2);
        besselmnextcheb(z, -2.22751332699166985548E-14, b0, b1, b2);
        besselmnextcheb(z, 8.03289077536357521100E-14, b0, b1, b2);
        besselmnextcheb(z, -2.98009692317273043925E-13, b0, b1, b2);
        besselmnextcheb(z, 1.14034058820847496303E-12, b0, b1, b2);
        besselmnextcheb(z, -4.51459788337394416547E-12, b0, b1, b2);
        besselmnextcheb(z, 1.85594911495471785253E-11, b0, b1, b2);
        besselmnextcheb(z, -7.95748924447710747776E-11, b0, b1, b2);
        besselmnextcheb(z, 3.57739728140030116597E-10, b0, b1, b2);
        besselmnextcheb(z, -1.69753450938905987466E-9, b0, b1, b2);
        besselmnextcheb(z, 8.57403401741422608519E-9, b0, b1, b2);
        besselmnextcheb(z, -4.66048989768794782956E-8, b0, b1, b2);
        besselmnextcheb(z, 2.76681363944501510342E-7, b0, b1, b2);
        besselmnextcheb(z, -1.83175552271911948767E-6, b0, b1, b2);
        besselmnextcheb(z, 1.39498137188764993662E-5, b0, b1, b2);
        besselmnextcheb(z, -1.28495495816278026384E-4, b0, b1, b2);
        besselmnextcheb(z, 1.56988388573005337491E-3, b0, b1, b2);
        besselmnextcheb(z, -3.14481013119645005427E-2, b0, b1, b2);
        besselmnextcheb(z, 2.44030308206595545468E0, b0, b1, b2);
        v = 0.5*(b0-b2);
        v = v*exp(-x)/sqrt(x);
    }
    result = v;
    return result;
}


/*************************************************************************
Modified Bessel function, second kind, order one

Computes the modified Bessel function of the second kind
of order one of the argument.

The range is partitioned into the two intervals [0,2] and
(2, infinity).  Chebyshev polynomial expansions are employed
in each interval.

ACCURACY:

                     Relative error:
arithmetic   domain     # trials      peak         rms
   IEEE      0, 30       30000       1.2e-15     1.6e-16

Cephes Math Library Release 2.8:  June, 2000
Copyright 1984, 1987, 2000 by Stephen L. Moshier
*************************************************************************/
BESSEL_API double besselk1(double x)
{
    double result;
    double y;
    double z;
    double v;
    double b0;
    double b1;
    double b2;

    z = 0.5*x;
    ap::ap_error::make_assertion(z>0);
    if( x<=2 )
    {
        y = x*x-2.0;
        besselm1firstcheb(-7.02386347938628759343E-18, b0, b1, b2);
        besselm1nextcheb(y, -2.42744985051936593393E-15, b0, b1, b2);
        besselm1nextcheb(y, -6.66690169419932900609E-13, b0, b1, b2);
        besselm1nextcheb(y, -1.41148839263352776110E-10, b0, b1, b2);
        besselm1nextcheb(y, -2.21338763073472585583E-8, b0, b1, b2);
        besselm1nextcheb(y, -2.43340614156596823496E-6, b0, b1, b2);
        besselm1nextcheb(y, -1.73028895751305206302E-4, b0, b1, b2);
        besselm1nextcheb(y, -6.97572385963986435018E-3, b0, b1, b2);
        besselm1nextcheb(y, -1.22611180822657148235E-1, b0, b1, b2);
        besselm1nextcheb(y, -3.53155960776544875667E-1, b0, b1, b2);
        besselm1nextcheb(y, 1.52530022733894777053E0, b0, b1, b2);
        v = 0.5*(b0-b2);
        result = log(z)*besseli1(x)+v/x;
    }
    else
    {