PyFiberModes 0.2.1__py3-none-any.whl

PyFiberModes/fiber/solver/cudasrc/hypergf.c

@@ -0,0 +1,264 @@
+
+/*                          hyp2f0()    */
+
+__device__ float hyp2f0f(float a, float b, float x, int type, float *err)
+{
+    float a0, alast, t, tlast, maxt;
+    float n, an, bn, u, sum, temp;
+
+    an = a;
+    bn = b;
+    a0 = 1.0;
+    alast = 1.0;
+    sum = 0.0;
+    n = 1.0;
+    t = 1.0;
+    tlast = 1.0e9;
+    maxt = 0.0;
+
+    do
+        {
+        if( an == 0 )
+            goto pdone;
+        if( bn == 0 )
+            goto pdone;
+
+        u = an * (bn * x / n);
+
+        /* check for blowup */
+        temp = fabsf(u);
+        if( (temp > 1.0 ) && (maxt > (MAXNUMF/temp)) )
+            goto error;
+
+        a0 *= u;
+        t = fabsf(a0);
+
+        /* terminating condition for asymptotic series */
+        if( t > tlast )
+            goto ndone;
+
+        tlast = t;
+        sum += alast;   /* the sum is one term behind */
+        alast = a0;
+
+        if( n > 200 )
+            goto ndone;
+
+        an += 1.0;
+        bn += 1.0;
+        n += 1.0;
+        if( t > maxt )
+            maxt = t;
+        }
+    while( t > MACHEPF );
+
+
+    pdone:  /* series converged! */
+
+    /* estimate error due to roundoff and cancellation */
+    *err = fabsf(  MACHEPF * (n + maxt)  );
+
+    alast = a0;
+    goto done;
+
+    ndone:  /* series did not converge */
+
+    /* The following "Converging factors" are supposed to improve accuracy,
+     * but do not actually seem to accomplish very much. */
+
+    n -= 1.0;
+    x = 1.0/x;
+
+    switch( type )  /* "type" given as subroutine argument */
+    {
+    case 1:
+        alast *= ( 0.5 + (0.125 + 0.25*b - 0.5*a + 0.25*x - 0.25*n)/x );
+        break;
+
+    case 2:
+        alast *= 2.0/3.0 - b + 2.0*a + x - n;
+        break;
+
+    default:
+        ;
+    }
+
+    /* estimate error due to roundoff, cancellation, and nonconvergence */
+    *err = MACHEPF * (n + maxt)  +  fabsf( a0 );
+
+
+    done:
+    sum += alast;
+    return( sum );
+
+    /* series blew up: */
+    error:
+    *err = MAXNUMF;
+    /* mtherr( "hypergf", TLOSS ); */
+    return( sum );
+}
+
+__device__ float hy1f1af( float a, float b, float x, float *err )
+{
+    float h1, h2, t, u, temp, acanc, asum, err1, err2;
+
+    if( x == 0 )
+        {
+        acanc = 1.0;
+        asum = MAXNUMF;
+        goto adone;
+        }
+    temp = logf( fabsf(x) );
+    t = x + temp * (a-b);
+    u = -temp * a;
+
+    if( b > 0 )
+        {
+        temp = lgammaf(b);
+        t += temp;
+        u += temp;
+        }
+
+    h1 = hyp2f0f( a, a-b+1, -1.0/x, 1, &err1 );
+
+    temp = expf(u) / tgammaf(b-a);
+    h1 *= temp;
+    err1 *= temp;
+
+    h2 = hyp2f0f( b-a, 1.0-a, 1.0/x, 2, &err2 );
+
+    if( a < 0 )
+        temp = expf(t) / tgammaf(a);
+    else
+        temp = expf( t - lgammaf(a) );
+
+    h2 *= temp;
+    err2 *= temp;
+
+    if( x < 0.0 )
+        asum = h1;
+    else
+        asum = h2;
+
+    acanc = fabsf(err1) + fabsf(err2);
+
+
+    if( b < 0 )
+        {
+        temp = tgammaf(b);
+        asum *= temp;
+        acanc *= fabsf(temp);
+        }
+
+
+    if( asum != 0.0 )
+        acanc /= fabsf(asum);
+
+    acanc *= 30.0;  /* fudge factor, since error of asymptotic formula
+             * often seems this much larger than advertised */
+
+    adone:
+
+
+    *err = acanc;
+    return( asum );
+}
+
+/* Power series summation for confluent hypergeometric function     */
+__device__ float hy1f1pf( float a, float b, float x, float *err )
+{
+    float n, a0, sum, t, u, temp;
+    float an, bn, maxt, pcanc;
+
+    /* set up for power series summation */
+    an = a;
+    bn = b;
+    a0 = 1.0;
+    sum = 1.0;
+    n = 1.0;
+    t = 1.0;
+    maxt = 0.0;
+
+    while( t > MACHEPF )
+        {
+        if( bn == 0 )           /* check bn first since if both */
+            {
+            /* mtherr( "hypergf", SING ); */
+            return( MAXNUMF );  /* an and bn are zero it is */
+            }
+        if( an == 0 )           /* a singularity        */
+            return( sum );
+        if( n > 200 )
+            goto pdone;
+        u = x * ( an / (bn * n) );
+
+        /* check for blowup */
+        temp = fabsf(u);
+        if( (temp > 1.0 ) && (maxt > (MAXNUMF/temp)) )
+            {
+            pcanc = 1.0;    /* estimate 100% error */
+            goto blowup;
+            }
+
+        a0 *= u;
+        sum += a0;
+        t = fabsf(a0);
+        if( t > maxt )
+            maxt = t;
+    /*
+        if( (maxt/fabsf(sum)) > 1.0e17 )
+            {
+            pcanc = 1.0;
+            goto blowup;
+            }
+    */
+        an += 1.0;
+        bn += 1.0;
+        n += 1.0;
+        }
+
+    pdone:
+
+    /* estimate error due to roundoff and cancellation */
+    if( sum != 0.0 )
+        maxt /= fabsf(sum);
+    maxt *= MACHEPF;    /* this way avoids multiply overflow */
+    pcanc = fabsf( MACHEPF * n  +  maxt );
+
+    blowup:
+
+    *err = pcanc;
+
+    return( sum );
+}
+
+__device__ float hypergf( float a, float b, float x ) {
+    float asum, psum, acanc, pcanc, temp;
+
+    /* See if a Kummer transformation will help */
+    temp = b - a;
+    if( fabsf(temp) < 0.001 * fabsf(a) )
+        return( expf(x) * hypergf( temp, b, -x )  );
+
+    psum = hy1f1pf( a, b, x, &pcanc );
+    if( pcanc < 1.0e-6 )
+        goto done;
+
+    /* try asymptotic series */
+
+    asum = hy1f1af( a, b, x, &acanc );
+
+    /* Pick the result with less estimated error */
+
+    if( acanc < pcanc )
+        {
+        pcanc = acanc;
+        psum = asum;
+        }
+
+    done:
+    /* if( pcanc > 1.0e-3 )
+        mtherr( "hyperg", PLOSS ); */
+
+    return( psum );
+}

PyFiberModes/fiber/solver/cudasrc/ivf.c

@@ -0,0 +1,49 @@
+
+__device__ float ivf( float v, float x )
+{
+    int sign;
+    float t, ax;
+
+    /* If v is a negative integer, invoke symmetry */
+    t = floorf(v);
+    if( v < 0.0 )
+        {
+        if( t == v )
+            {
+            v = -v; /* symmetry */
+            t = -t;
+            }
+        }
+    /* If x is negative, require v to be an integer */
+    sign = 1;
+    if( x < 0.0 )
+        {
+        if( t != v )
+            {
+            /* mtherr( "ivf", DOMAIN ); */
+            return( 0.0 );
+            }
+        if( v != 2.0 * floorf(v/2.0) )
+            sign = -1;
+        }
+
+    /* Avoid logarithm singularity */
+    if( x == 0.0 )
+        {
+        if( v == 0.0 )
+            return( 1.0 );
+        if( v < 0.0 )
+            {
+            /* mtherr( "ivf", OVERFLOW ); */
+            return( MAXNUMF );
+            }
+        else
+            return( 0.0 );
+        }
+
+    ax = fabsf(x);
+    t = v * logf( 0.5 * ax )  -  x;
+    t = sign * expf(t) / tgammaf( v + 1.0 );
+    ax = v + 0.5;
+    return( t * hypergf( ax,  2.0 * ax,  2.0 * x ) );
+}

PyFiberModes/fiber/solver/cudasrc/knf.c

@@ -0,0 +1,166 @@
+
+#define EUL 5.772156649015328606065e-1
+#define MAXFAC 31
+
+__device__ float knf( int nn, float x )
+{
+    float k, kf, nk1f, nkf, zn, t, s, z0, z;
+    float ans, fn, pn, pk, zmn, tlg, tox;
+    int i, n;
+
+    if( nn < 0 )
+        n = -nn;
+    else
+        n = nn;
+
+    if( n > MAXFAC )
+        {
+    overf:
+        /* mtherr( "knf", OVERFLOW ); */
+        return( MAXNUMF );
+        }
+
+    if( x <= 0.0 )
+        {
+        /*
+        if( x < 0.0 )
+            mtherr( "knf", DOMAIN );
+        else
+            mtherr( "knf", SING );
+        */
+        return( MAXNUMF );
+        }
+
+
+    if( x > 9.55 )
+        goto asymp;
+
+    ans = 0.0;
+    z0 = 0.25 * x * x;
+    fn = 1.0;
+    pn = 0.0;
+    zmn = 1.0;
+    tox = 2.0/x;
+
+    if( n > 0 )
+        {
+        /* compute factorial of n and psi(n) */
+        pn = -EUL;
+        k = 1.0;
+        for( i=1; i<n; i++ )
+            {
+            pn += 1.0/k;
+            k += 1.0;
+            fn *= k;
+            }
+
+        zmn = tox;
+
+        if( n == 1 )
+            {
+            ans = 1.0/x;
+            }
+        else
+            {
+            nk1f = fn/n;
+            kf = 1.0;
+            s = nk1f;
+            z = -z0;
+            zn = 1.0;
+            for( i=1; i<n; i++ )
+                {
+                nk1f = nk1f/(n-i);
+                kf = kf * i;
+                zn *= z;
+                t = nk1f * zn / kf;
+                s += t;
+                if( (MAXNUMF - fabsf(t)) < fabsf(s) )
+                    goto overf;
+                if( (tox > 1.0) && ((MAXNUMF/tox) < zmn) )
+                    goto overf;
+                zmn *= tox;
+                }
+            s *= 0.5;
+            t = fabsf(s);
+            if( (zmn > 1.0) && ((MAXNUMF/zmn) < t) )
+                goto overf;
+            if( (t > 1.0) && ((MAXNUMF/t) < zmn) )
+                goto overf;
+            ans = s * zmn;
+            }
+        }
+
+
+    tlg = 2.0 * logf( 0.5 * x );
+    pk = -EUL;
+    if( n == 0 )
+        {
+        pn = pk;
+        t = 1.0;
+        }
+    else
+        {
+        pn = pn + 1.0/n;
+        t = 1.0/fn;
+        }
+    s = (pk+pn-tlg)*t;
+    k = 1.0;
+    do
+        {
+        t *= z0 / (k * (k+n));
+        pk += 1.0/k;
+        pn += 1.0/(k+n);
+        s += (pk+pn-tlg)*t;
+        k += 1.0;
+        }
+    while( fabsf(t/s) > MACHEPF );
+
+    s = 0.5 * s / zmn;
+    if( n & 1 )
+        s = -s;
+    ans += s;
+
+    return(ans);
+
+
+
+    /* Asymptotic expansion for Kn(x) */
+    /* Converges to 1.4e-17 for x > 18.4 */
+
+    asymp:
+
+    if( x > MAXLOGF )
+        {
+        /* mtherr( "knf", UNDERFLOW ); */
+        return(0.0);
+        }
+    k = n;
+    pn = 4.0 * k * k;
+    pk = 1.0;
+    z0 = 8.0 * x;
+    fn = 1.0;
+    t = 1.0;
+    s = t;
+    nkf = MAXNUMF;
+    i = 0;
+    do
+        {
+        z = pn - pk * pk;
+        t = t * z /(fn * z0);
+        nk1f = fabsf(t);
+        if( (i >= n) && (nk1f > nkf) )
+            {
+            goto adone;
+            }
+        nkf = nk1f;
+        s += t;
+        fn += 1.0;
+        pk += 2.0;
+        i += 1;
+        }
+    while( fabsf(t/s) > MACHEPF );
+
+    adone:
+    ans = expf(-x) * sqrtf( PIF/(2.0*x) ) * s;
+    return(ans);
+}