1  | 
     | 
     | 
    /*  | 
    
    
    2  | 
     | 
     | 
     * ====================================================  | 
    
    
    3  | 
     | 
     | 
     * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.  | 
    
    
    4  | 
     | 
     | 
     *  | 
    
    
    5  | 
     | 
     | 
     * Developed at SunPro, a Sun Microsystems, Inc. business.  | 
    
    
    6  | 
     | 
     | 
     * Permission to use, copy, modify, and distribute this  | 
    
    
    7  | 
     | 
     | 
     * software is freely granted, provided that this notice  | 
    
    
    8  | 
     | 
     | 
     * is preserved.  | 
    
    
    9  | 
     | 
     | 
     * ====================================================  | 
    
    
    10  | 
     | 
     | 
     */  | 
    
    
    11  | 
     | 
     | 
     | 
    
    
    12  | 
     | 
     | 
    /*  | 
    
    
    13  | 
     | 
     | 
     * Copyright (c) 2008 Stephen L. Moshier <steve@moshier.net>  | 
    
    
    14  | 
     | 
     | 
     *  | 
    
    
    15  | 
     | 
     | 
     * Permission to use, copy, modify, and distribute this software for any  | 
    
    
    16  | 
     | 
     | 
     * purpose with or without fee is hereby granted, provided that the above  | 
    
    
    17  | 
     | 
     | 
     * copyright notice and this permission notice appear in all copies.  | 
    
    
    18  | 
     | 
     | 
     *  | 
    
    
    19  | 
     | 
     | 
     * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES  | 
    
    
    20  | 
     | 
     | 
     * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF  | 
    
    
    21  | 
     | 
     | 
     * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  | 
    
    
    22  | 
     | 
     | 
     * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES  | 
    
    
    23  | 
     | 
     | 
     * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN  | 
    
    
    24  | 
     | 
     | 
     * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  | 
    
    
    25  | 
     | 
     | 
     * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.  | 
    
    
    26  | 
     | 
     | 
     */  | 
    
    
    27  | 
     | 
     | 
     | 
    
    
    28  | 
     | 
     | 
    /* lgammal(x)  | 
    
    
    29  | 
     | 
     | 
     * Reentrant version of the logarithm of the Gamma function  | 
    
    
    30  | 
     | 
     | 
     * with user provide pointer for the sign of Gamma(x).  | 
    
    
    31  | 
     | 
     | 
     *  | 
    
    
    32  | 
     | 
     | 
     * Method:  | 
    
    
    33  | 
     | 
     | 
     *   1. Argument Reduction for 0 < x <= 8  | 
    
    
    34  | 
     | 
     | 
     *	Since gamma(1+s)=s*gamma(s), for x in [0,8], we may  | 
    
    
    35  | 
     | 
     | 
     *	reduce x to a number in [1.5,2.5] by  | 
    
    
    36  | 
     | 
     | 
     *		lgamma(1+s) = log(s) + lgamma(s)  | 
    
    
    37  | 
     | 
     | 
     *	for example,  | 
    
    
    38  | 
     | 
     | 
     *		lgamma(7.3) = log(6.3) + lgamma(6.3)  | 
    
    
    39  | 
     | 
     | 
     *			    = log(6.3*5.3) + lgamma(5.3)  | 
    
    
    40  | 
     | 
     | 
     *			    = log(6.3*5.3*4.3*3.3*2.3) + lgamma(2.3)  | 
    
    
    41  | 
     | 
     | 
     *   2. Polynomial approximation of lgamma around its  | 
    
    
    42  | 
     | 
     | 
     *	minimun ymin=1.461632144968362245 to maintain monotonicity.  | 
    
    
    43  | 
     | 
     | 
     *	On [ymin-0.23, ymin+0.27] (i.e., [1.23164,1.73163]), use  | 
    
    
    44  | 
     | 
     | 
     *		Let z = x-ymin;  | 
    
    
    45  | 
     | 
     | 
     *		lgamma(x) = -1.214862905358496078218 + z^2*poly(z)  | 
    
    
    46  | 
     | 
     | 
     *   2. Rational approximation in the primary interval [2,3]  | 
    
    
    47  | 
     | 
     | 
     *	We use the following approximation:  | 
    
    
    48  | 
     | 
     | 
     *		s = x-2.0;  | 
    
    
    49  | 
     | 
     | 
     *		lgamma(x) = 0.5*s + s*P(s)/Q(s)  | 
    
    
    50  | 
     | 
     | 
     *	Our algorithms are based on the following observation  | 
    
    
    51  | 
     | 
     | 
     *  | 
    
    
    52  | 
     | 
     | 
     *                             zeta(2)-1    2    zeta(3)-1    3  | 
    
    
    53  | 
     | 
     | 
     * lgamma(2+s) = s*(1-Euler) + --------- * s  -  --------- * s  + ...  | 
    
    
    54  | 
     | 
     | 
     *                                 2                 3  | 
    
    
    55  | 
     | 
     | 
     *  | 
    
    
    56  | 
     | 
     | 
     *	where Euler = 0.5771... is the Euler constant, which is very  | 
    
    
    57  | 
     | 
     | 
     *	close to 0.5.  | 
    
    
    58  | 
     | 
     | 
     *  | 
    
    
    59  | 
     | 
     | 
     *   3. For x>=8, we have  | 
    
    
    60  | 
     | 
     | 
     *	lgamma(x)~(x-0.5)log(x)-x+0.5*log(2pi)+1/(12x)-1/(360x**3)+....  | 
    
    
    61  | 
     | 
     | 
     *	(better formula:  | 
    
    
    62  | 
     | 
     | 
     *	   lgamma(x)~(x-0.5)*(log(x)-1)-.5*(log(2pi)-1) + ...)  | 
    
    
    63  | 
     | 
     | 
     *	Let z = 1/x, then we approximation  | 
    
    
    64  | 
     | 
     | 
     *		f(z) = lgamma(x) - (x-0.5)(log(x)-1)  | 
    
    
    65  | 
     | 
     | 
     *	by  | 
    
    
    66  | 
     | 
     | 
     *				    3       5             11  | 
    
    
    67  | 
     | 
     | 
     *		w = w0 + w1*z + w2*z  + w3*z  + ... + w6*z  | 
    
    
    68  | 
     | 
     | 
     *  | 
    
    
    69  | 
     | 
     | 
     *   4. For negative x, since (G is gamma function)  | 
    
    
    70  | 
     | 
     | 
     *		-x*G(-x)*G(x) = pi/sin(pi*x),  | 
    
    
    71  | 
     | 
     | 
     *	we have  | 
    
    
    72  | 
     | 
     | 
     *		G(x) = pi/(sin(pi*x)*(-x)*G(-x))  | 
    
    
    73  | 
     | 
     | 
     *	since G(-x) is positive, sign(G(x)) = sign(sin(pi*x)) for x<0  | 
    
    
    74  | 
     | 
     | 
     *	Hence, for x<0, signgam = sign(sin(pi*x)) and  | 
    
    
    75  | 
     | 
     | 
     *		lgamma(x) = log(|Gamma(x)|)  | 
    
    
    76  | 
     | 
     | 
     *			  = log(pi/(|x*sin(pi*x)|)) - lgamma(-x);  | 
    
    
    77  | 
     | 
     | 
     *	Note: one should avoid compute pi*(-x) directly in the  | 
    
    
    78  | 
     | 
     | 
     *	      computation of sin(pi*(-x)).  | 
    
    
    79  | 
     | 
     | 
     *  | 
    
    
    80  | 
     | 
     | 
     *   5. Special Cases  | 
    
    
    81  | 
     | 
     | 
     *		lgamma(2+s) ~ s*(1-Euler) for tiny s  | 
    
    
    82  | 
     | 
     | 
     *		lgamma(1)=lgamma(2)=0  | 
    
    
    83  | 
     | 
     | 
     *		lgamma(x) ~ -log(x) for tiny x  | 
    
    
    84  | 
     | 
     | 
     *		lgamma(0) = lgamma(inf) = inf  | 
    
    
    85  | 
     | 
     | 
     *		lgamma(-integer) = +-inf  | 
    
    
    86  | 
     | 
     | 
     *  | 
    
    
    87  | 
     | 
     | 
     */  | 
    
    
    88  | 
     | 
     | 
     | 
    
    
    89  | 
     | 
     | 
    #include <math.h>  | 
    
    
    90  | 
     | 
     | 
     | 
    
    
    91  | 
     | 
     | 
    #include "math_private.h"  | 
    
    
    92  | 
     | 
     | 
     | 
    
    
    93  | 
     | 
     | 
    static const long double  | 
    
    
    94  | 
     | 
     | 
      half = 0.5L,  | 
    
    
    95  | 
     | 
     | 
      one = 1.0L,  | 
    
    
    96  | 
     | 
     | 
      pi = 3.14159265358979323846264L,  | 
    
    
    97  | 
     | 
     | 
      two63 = 9.223372036854775808e18L,  | 
    
    
    98  | 
     | 
     | 
     | 
    
    
    99  | 
     | 
     | 
      /* lgam(1+x) = 0.5 x + x a(x)/b(x)  | 
    
    
    100  | 
     | 
     | 
         -0.268402099609375 <= x <= 0  | 
    
    
    101  | 
     | 
     | 
         peak relative error 6.6e-22 */  | 
    
    
    102  | 
     | 
     | 
      a0 = -6.343246574721079391729402781192128239938E2L,  | 
    
    
    103  | 
     | 
     | 
      a1 =  1.856560238672465796768677717168371401378E3L,  | 
    
    
    104  | 
     | 
     | 
      a2 =  2.404733102163746263689288466865843408429E3L,  | 
    
    
    105  | 
     | 
     | 
      a3 =  8.804188795790383497379532868917517596322E2L,  | 
    
    
    106  | 
     | 
     | 
      a4 =  1.135361354097447729740103745999661157426E2L,  | 
    
    
    107  | 
     | 
     | 
      a5 =  3.766956539107615557608581581190400021285E0L,  | 
    
    
    108  | 
     | 
     | 
     | 
    
    
    109  | 
     | 
     | 
      b0 =  8.214973713960928795704317259806842490498E3L,  | 
    
    
    110  | 
     | 
     | 
      b1 =  1.026343508841367384879065363925870888012E4L,  | 
    
    
    111  | 
     | 
     | 
      b2 =  4.553337477045763320522762343132210919277E3L,  | 
    
    
    112  | 
     | 
     | 
      b3 =  8.506975785032585797446253359230031874803E2L,  | 
    
    
    113  | 
     | 
     | 
      b4 =  6.042447899703295436820744186992189445813E1L,  | 
    
    
    114  | 
     | 
     | 
      /* b5 =  1.000000000000000000000000000000000000000E0 */  | 
    
    
    115  | 
     | 
     | 
     | 
    
    
    116  | 
     | 
     | 
     | 
    
    
    117  | 
     | 
     | 
      tc =  1.4616321449683623412626595423257213284682E0L,  | 
    
    
    118  | 
     | 
     | 
      tf = -1.2148629053584961146050602565082954242826E-1,/* double precision */  | 
    
    
    119  | 
     | 
     | 
    /* tt = (tail of tf), i.e. tf + tt has extended precision. */  | 
    
    
    120  | 
     | 
     | 
      tt = 3.3649914684731379602768989080467587736363E-18L,  | 
    
    
    121  | 
     | 
     | 
      /* lgam ( 1.4616321449683623412626595423257213284682E0 ) =  | 
    
    
    122  | 
     | 
     | 
    -1.2148629053584960809551455717769158215135617312999903886372437313313530E-1 */  | 
    
    
    123  | 
     | 
     | 
     | 
    
    
    124  | 
     | 
     | 
      /* lgam (x + tc) = tf + tt + x g(x)/h(x)  | 
    
    
    125  | 
     | 
     | 
         - 0.230003726999612341262659542325721328468 <= x  | 
    
    
    126  | 
     | 
     | 
         <= 0.2699962730003876587373404576742786715318  | 
    
    
    127  | 
     | 
     | 
         peak relative error 2.1e-21 */  | 
    
    
    128  | 
     | 
     | 
      g0 = 3.645529916721223331888305293534095553827E-18L,  | 
    
    
    129  | 
     | 
     | 
      g1 = 5.126654642791082497002594216163574795690E3L,  | 
    
    
    130  | 
     | 
     | 
      g2 = 8.828603575854624811911631336122070070327E3L,  | 
    
    
    131  | 
     | 
     | 
      g3 = 5.464186426932117031234820886525701595203E3L,  | 
    
    
    132  | 
     | 
     | 
      g4 = 1.455427403530884193180776558102868592293E3L,  | 
    
    
    133  | 
     | 
     | 
      g5 = 1.541735456969245924860307497029155838446E2L,  | 
    
    
    134  | 
     | 
     | 
      g6 = 4.335498275274822298341872707453445815118E0L,  | 
    
    
    135  | 
     | 
     | 
     | 
    
    
    136  | 
     | 
     | 
      h0 = 1.059584930106085509696730443974495979641E4L,  | 
    
    
    137  | 
     | 
     | 
      h1 =  2.147921653490043010629481226937850618860E4L,  | 
    
    
    138  | 
     | 
     | 
      h2 = 1.643014770044524804175197151958100656728E4L,  | 
    
    
    139  | 
     | 
     | 
      h3 =  5.869021995186925517228323497501767586078E3L,  | 
    
    
    140  | 
     | 
     | 
      h4 =  9.764244777714344488787381271643502742293E2L,  | 
    
    
    141  | 
     | 
     | 
      h5 =  6.442485441570592541741092969581997002349E1L,  | 
    
    
    142  | 
     | 
     | 
      /* h6 = 1.000000000000000000000000000000000000000E0 */  | 
    
    
    143  | 
     | 
     | 
     | 
    
    
    144  | 
     | 
     | 
     | 
    
    
    145  | 
     | 
     | 
      /* lgam (x+1) = -0.5 x + x u(x)/v(x)  | 
    
    
    146  | 
     | 
     | 
         -0.100006103515625 <= x <= 0.231639862060546875  | 
    
    
    147  | 
     | 
     | 
         peak relative error 1.3e-21 */  | 
    
    
    148  | 
     | 
     | 
      u0 = -8.886217500092090678492242071879342025627E1L,  | 
    
    
    149  | 
     | 
     | 
      u1 =  6.840109978129177639438792958320783599310E2L,  | 
    
    
    150  | 
     | 
     | 
      u2 =  2.042626104514127267855588786511809932433E3L,  | 
    
    
    151  | 
     | 
     | 
      u3 =  1.911723903442667422201651063009856064275E3L,  | 
    
    
    152  | 
     | 
     | 
      u4 =  7.447065275665887457628865263491667767695E2L,  | 
    
    
    153  | 
     | 
     | 
      u5 =  1.132256494121790736268471016493103952637E2L,  | 
    
    
    154  | 
     | 
     | 
      u6 =  4.484398885516614191003094714505960972894E0L,  | 
    
    
    155  | 
     | 
     | 
     | 
    
    
    156  | 
     | 
     | 
      v0 =  1.150830924194461522996462401210374632929E3L,  | 
    
    
    157  | 
     | 
     | 
      v1 =  3.399692260848747447377972081399737098610E3L,  | 
    
    
    158  | 
     | 
     | 
      v2 =  3.786631705644460255229513563657226008015E3L,  | 
    
    
    159  | 
     | 
     | 
      v3 =  1.966450123004478374557778781564114347876E3L,  | 
    
    
    160  | 
     | 
     | 
      v4 =  4.741359068914069299837355438370682773122E2L,  | 
    
    
    161  | 
     | 
     | 
      v5 =  4.508989649747184050907206782117647852364E1L,  | 
    
    
    162  | 
     | 
     | 
      /* v6 =  1.000000000000000000000000000000000000000E0 */  | 
    
    
    163  | 
     | 
     | 
     | 
    
    
    164  | 
     | 
     | 
     | 
    
    
    165  | 
     | 
     | 
      /* lgam (x+2) = .5 x + x s(x)/r(x)  | 
    
    
    166  | 
     | 
     | 
         0 <= x <= 1  | 
    
    
    167  | 
     | 
     | 
         peak relative error 7.2e-22 */  | 
    
    
    168  | 
     | 
     | 
      s0 =  1.454726263410661942989109455292824853344E6L,  | 
    
    
    169  | 
     | 
     | 
      s1 = -3.901428390086348447890408306153378922752E6L,  | 
    
    
    170  | 
     | 
     | 
      s2 = -6.573568698209374121847873064292963089438E6L,  | 
    
    
    171  | 
     | 
     | 
      s3 = -3.319055881485044417245964508099095984643E6L,  | 
    
    
    172  | 
     | 
     | 
      s4 = -7.094891568758439227560184618114707107977E5L,  | 
    
    
    173  | 
     | 
     | 
      s5 = -6.263426646464505837422314539808112478303E4L,  | 
    
    
    174  | 
     | 
     | 
      s6 = -1.684926520999477529949915657519454051529E3L,  | 
    
    
    175  | 
     | 
     | 
     | 
    
    
    176  | 
     | 
     | 
      r0 = -1.883978160734303518163008696712983134698E7L,  | 
    
    
    177  | 
     | 
     | 
      r1 = -2.815206082812062064902202753264922306830E7L,  | 
    
    
    178  | 
     | 
     | 
      r2 = -1.600245495251915899081846093343626358398E7L,  | 
    
    
    179  | 
     | 
     | 
      r3 = -4.310526301881305003489257052083370058799E6L,  | 
    
    
    180  | 
     | 
     | 
      r4 = -5.563807682263923279438235987186184968542E5L,  | 
    
    
    181  | 
     | 
     | 
      r5 = -3.027734654434169996032905158145259713083E4L,  | 
    
    
    182  | 
     | 
     | 
      r6 = -4.501995652861105629217250715790764371267E2L,  | 
    
    
    183  | 
     | 
     | 
      /* r6 =  1.000000000000000000000000000000000000000E0 */  | 
    
    
    184  | 
     | 
     | 
     | 
    
    
    185  | 
     | 
     | 
     | 
    
    
    186  | 
     | 
     | 
    /* lgam(x) = ( x - 0.5 ) * log(x) - x + LS2PI + 1/x w(1/x^2)  | 
    
    
    187  | 
     | 
     | 
       x >= 8  | 
    
    
    188  | 
     | 
     | 
       Peak relative error 1.51e-21  | 
    
    
    189  | 
     | 
     | 
       w0 = LS2PI - 0.5 */  | 
    
    
    190  | 
     | 
     | 
      w0 =  4.189385332046727417803e-1L,  | 
    
    
    191  | 
     | 
     | 
      w1 =  8.333333333333331447505E-2L,  | 
    
    
    192  | 
     | 
     | 
      w2 = -2.777777777750349603440E-3L,  | 
    
    
    193  | 
     | 
     | 
      w3 =  7.936507795855070755671E-4L,  | 
    
    
    194  | 
     | 
     | 
      w4 = -5.952345851765688514613E-4L,  | 
    
    
    195  | 
     | 
     | 
      w5 =  8.412723297322498080632E-4L,  | 
    
    
    196  | 
     | 
     | 
      w6 = -1.880801938119376907179E-3L,  | 
    
    
    197  | 
     | 
     | 
      w7 =  4.885026142432270781165E-3L;  | 
    
    
    198  | 
     | 
     | 
     | 
    
    
    199  | 
     | 
     | 
    static const long double zero = 0.0L;  | 
    
    
    200  | 
     | 
     | 
     | 
    
    
    201  | 
     | 
     | 
    static long double  | 
    
    
    202  | 
     | 
     | 
    sin_pi(long double x)  | 
    
    
    203  | 
     | 
     | 
    { | 
    
    
    204  | 
     | 
     | 
      long double y, z;  | 
    
    
    205  | 
     | 
     | 
      int n, ix;  | 
    
    
    206  | 
     | 
     | 
      u_int32_t se, i0, i1;  | 
    
    
    207  | 
     | 
     | 
     | 
    
    
    208  | 
     | 
     | 
      GET_LDOUBLE_WORDS (se, i0, i1, x);  | 
    
    
    209  | 
     | 
     | 
      ix = se & 0x7fff;  | 
    
    
    210  | 
     | 
     | 
      ix = (ix << 16) | (i0 >> 16);  | 
    
    
    211  | 
     | 
     | 
      if (ix < 0x3ffd8000) /* 0.25 */  | 
    
    
    212  | 
     | 
     | 
        return sinl (pi * x);  | 
    
    
    213  | 
     | 
     | 
      y = -x;			/* x is assume negative */  | 
    
    
    214  | 
     | 
     | 
     | 
    
    
    215  | 
     | 
     | 
      /*  | 
    
    
    216  | 
     | 
     | 
       * argument reduction, make sure inexact flag not raised if input  | 
    
    
    217  | 
     | 
     | 
       * is an integer  | 
    
    
    218  | 
     | 
     | 
       */  | 
    
    
    219  | 
     | 
     | 
      z = floorl (y);  | 
    
    
    220  | 
     | 
     | 
      if (z != y)  | 
    
    
    221  | 
     | 
     | 
        {				/* inexact anyway */ | 
    
    
    222  | 
     | 
     | 
          y  *= 0.5;  | 
    
    
    223  | 
     | 
     | 
          y = 2.0*(y - floorl(y));		/* y = |x| mod 2.0 */  | 
    
    
    224  | 
     | 
     | 
          n = (int) (y*4.0);  | 
    
    
    225  | 
     | 
     | 
        }  | 
    
    
    226  | 
     | 
     | 
      else  | 
    
    
    227  | 
     | 
     | 
        { | 
    
    
    228  | 
     | 
     | 
          if (ix >= 0x403f8000)  /* 2^64 */  | 
    
    
    229  | 
     | 
     | 
    	{ | 
    
    
    230  | 
     | 
     | 
    	  y = zero; n = 0;		/* y must be even */  | 
    
    
    231  | 
     | 
     | 
    	}  | 
    
    
    232  | 
     | 
     | 
          else  | 
    
    
    233  | 
     | 
     | 
    	{ | 
    
    
    234  | 
     | 
     | 
    	if (ix < 0x403e8000)  /* 2^63 */  | 
    
    
    235  | 
     | 
     | 
    	  z = y + two63;	/* exact */  | 
    
    
    236  | 
     | 
     | 
    	GET_LDOUBLE_WORDS (se, i0, i1, z);  | 
    
    
    237  | 
     | 
     | 
    	n = i1 & 1;  | 
    
    
    238  | 
     | 
     | 
    	y  = n;  | 
    
    
    239  | 
     | 
     | 
    	n <<= 2;  | 
    
    
    240  | 
     | 
     | 
          }  | 
    
    
    241  | 
     | 
     | 
        }  | 
    
    
    242  | 
     | 
     | 
     | 
    
    
    243  | 
     | 
     | 
      switch (n)  | 
    
    
    244  | 
     | 
     | 
        { | 
    
    
    245  | 
     | 
     | 
        case 0:  | 
    
    
    246  | 
     | 
     | 
          y = sinl (pi * y);  | 
    
    
    247  | 
     | 
     | 
          break;  | 
    
    
    248  | 
     | 
     | 
        case 1:  | 
    
    
    249  | 
     | 
     | 
        case 2:  | 
    
    
    250  | 
     | 
     | 
          y = cosl (pi * (half - y));  | 
    
    
    251  | 
     | 
     | 
          break;  | 
    
    
    252  | 
     | 
     | 
        case 3:  | 
    
    
    253  | 
     | 
     | 
        case 4:  | 
    
    
    254  | 
     | 
     | 
          y = sinl (pi * (one - y));  | 
    
    
    255  | 
     | 
     | 
          break;  | 
    
    
    256  | 
     | 
     | 
        case 5:  | 
    
    
    257  | 
     | 
     | 
        case 6:  | 
    
    
    258  | 
     | 
     | 
          y = -cosl (pi * (y - 1.5));  | 
    
    
    259  | 
     | 
     | 
          break;  | 
    
    
    260  | 
     | 
     | 
        default:  | 
    
    
    261  | 
     | 
     | 
          y = sinl (pi * (y - 2.0));  | 
    
    
    262  | 
     | 
     | 
          break;  | 
    
    
    263  | 
     | 
     | 
        }  | 
    
    
    264  | 
     | 
     | 
      return -y;  | 
    
    
    265  | 
     | 
     | 
    }  | 
    
    
    266  | 
     | 
     | 
     | 
    
    
    267  | 
     | 
     | 
     | 
    
    
    268  | 
     | 
     | 
    long double  | 
    
    
    269  | 
     | 
     | 
    lgammal(long double x)  | 
    
    
    270  | 
     | 
     | 
    { | 
    
    
    271  | 
     | 
     | 
      long double t, y, z, nadj, p, p1, p2, q, r, w;  | 
    
    
    272  | 
     | 
     | 
      int i, ix;  | 
    
    
    273  | 
     | 
     | 
      u_int32_t se, i0, i1;  | 
    
    
    274  | 
     | 
     | 
     | 
    
    
    275  | 
     | 
    60  | 
      signgam = 1;  | 
    
    
    276  | 
     | 
    30  | 
      GET_LDOUBLE_WORDS (se, i0, i1, x);  | 
    
    
    277  | 
     | 
    30  | 
      ix = se & 0x7fff;  | 
    
    
    278  | 
     | 
     | 
     | 
    
    
    279  | 
    ✓✓ | 
    30  | 
      if ((ix | i0 | i1) == 0)  | 
    
    
    280  | 
     | 
     | 
        { | 
    
    
    281  | 
    ✓✓ | 
    10  | 
          if (se & 0x8000)  | 
    
    
    282  | 
     | 
    5  | 
    	signgam = -1;  | 
    
    
    283  | 
     | 
    10  | 
          return one / fabsl (x);  | 
    
    
    284  | 
     | 
     | 
        }  | 
    
    
    285  | 
     | 
     | 
     | 
    
    
    286  | 
     | 
    20  | 
      ix = (ix << 16) | (i0 >> 16);  | 
    
    
    287  | 
     | 
     | 
     | 
    
    
    288  | 
     | 
     | 
      /* purge off +-inf, NaN, +-0, and negative arguments */  | 
    
    
    289  | 
    ✓✓ | 
    20  | 
      if (ix >= 0x7fff0000)  | 
    
    
    290  | 
     | 
    10  | 
        return x * x;  | 
    
    
    291  | 
     | 
     | 
     | 
    
    
    292  | 
    ✗✓ | 
    10  | 
      if (ix < 0x3fc08000) /* 2^-63 */  | 
    
    
    293  | 
     | 
     | 
        {				/* |x|<2**-63, return -log(|x|) */ | 
    
    
    294  | 
     | 
     | 
          if (se & 0x8000)  | 
    
    
    295  | 
     | 
     | 
    	{ | 
    
    
    296  | 
     | 
     | 
    	  signgam = -1;  | 
    
    
    297  | 
     | 
     | 
    	  return -logl (-x);  | 
    
    
    298  | 
     | 
     | 
    	}  | 
    
    
    299  | 
     | 
     | 
          else  | 
    
    
    300  | 
     | 
     | 
    	return -logl (x);  | 
    
    
    301  | 
     | 
     | 
        }  | 
    
    
    302  | 
    ✗✓ | 
    10  | 
      if (se & 0x8000)  | 
    
    
    303  | 
     | 
     | 
        { | 
    
    
    304  | 
     | 
     | 
          t = sin_pi (x);  | 
    
    
    305  | 
     | 
     | 
          if (t == zero)  | 
    
    
    306  | 
     | 
     | 
    	return one / fabsl (t);	/* -integer */  | 
    
    
    307  | 
     | 
     | 
          nadj = logl (pi / fabsl (t * x));  | 
    
    
    308  | 
     | 
     | 
          if (t < zero)  | 
    
    
    309  | 
     | 
     | 
    	signgam = -1;  | 
    
    
    310  | 
     | 
     | 
          x = -x;  | 
    
    
    311  | 
     | 
     | 
        }  | 
    
    
    312  | 
     | 
     | 
     | 
    
    
    313  | 
     | 
     | 
      /* purge off 1 and 2 */  | 
    
    
    314  | 
    ✗✓ | 
    20  | 
      if ((((ix - 0x3fff8000) | i0 | i1) == 0)  | 
    
    
    315  | 
    ✓✗ | 
    20  | 
          || (((ix - 0x40008000) | i0 | i1) == 0))  | 
    
    
    316  | 
     | 
     | 
        r = 0;  | 
    
    
    317  | 
    ✓✓ | 
    10  | 
      else if (ix < 0x40008000) /* 2.0 */  | 
    
    
    318  | 
     | 
     | 
        { | 
    
    
    319  | 
     | 
     | 
          /* x < 2.0 */  | 
    
    
    320  | 
    ✗✓ | 
    5  | 
          if (ix <= 0x3ffee666) /* 8.99993896484375e-1 */  | 
    
    
    321  | 
     | 
     | 
    	{ | 
    
    
    322  | 
     | 
     | 
    	  /* lgamma(x) = lgamma(x+1) - log(x) */  | 
    
    
    323  | 
     | 
     | 
    	  r = -logl (x);  | 
    
    
    324  | 
     | 
     | 
    	  if (ix >= 0x3ffebb4a) /* 7.31597900390625e-1 */  | 
    
    
    325  | 
     | 
     | 
    	    { | 
    
    
    326  | 
     | 
     | 
    	      y = x - one;  | 
    
    
    327  | 
     | 
     | 
    	      i = 0;  | 
    
    
    328  | 
     | 
     | 
    	    }  | 
    
    
    329  | 
     | 
     | 
    	  else if (ix >= 0x3ffced33)/* 2.31639862060546875e-1 */  | 
    
    
    330  | 
     | 
     | 
    	    { | 
    
    
    331  | 
     | 
     | 
    	      y = x - (tc - one);  | 
    
    
    332  | 
     | 
     | 
    	      i = 1;  | 
    
    
    333  | 
     | 
     | 
    	    }  | 
    
    
    334  | 
     | 
     | 
    	  else  | 
    
    
    335  | 
     | 
     | 
    	    { | 
    
    
    336  | 
     | 
     | 
    	      /* x < 0.23 */  | 
    
    
    337  | 
     | 
     | 
    	      y = x;  | 
    
    
    338  | 
     | 
     | 
    	      i = 2;  | 
    
    
    339  | 
     | 
     | 
    	    }  | 
    
    
    340  | 
     | 
     | 
    	}  | 
    
    
    341  | 
     | 
     | 
          else  | 
    
    
    342  | 
     | 
     | 
    	{ | 
    
    
    343  | 
     | 
     | 
    	  r = zero;  | 
    
    
    344  | 
    ✗✓ | 
    5  | 
    	  if (ix >= 0x3fffdda6) /* 1.73162841796875 */  | 
    
    
    345  | 
     | 
     | 
    	    { | 
    
    
    346  | 
     | 
     | 
    	      /* [1.7316,2] */  | 
    
    
    347  | 
     | 
     | 
    	      y = x - 2.0;  | 
    
    
    348  | 
     | 
     | 
    	      i = 0;  | 
    
    
    349  | 
     | 
     | 
    	    }  | 
    
    
    350  | 
    ✗✓ | 
    5  | 
    	  else if (ix >= 0x3fff9da6)/* 1.23162841796875 */  | 
    
    
    351  | 
     | 
     | 
    	    { | 
    
    
    352  | 
     | 
     | 
    	      /* [1.23,1.73] */  | 
    
    
    353  | 
     | 
     | 
    	      y = x - tc;  | 
    
    
    354  | 
     | 
     | 
    	      i = 1;  | 
    
    
    355  | 
     | 
     | 
    	    }  | 
    
    
    356  | 
     | 
     | 
    	  else  | 
    
    
    357  | 
     | 
     | 
    	    { | 
    
    
    358  | 
     | 
     | 
    	      /* [0.9, 1.23] */  | 
    
    
    359  | 
     | 
    5  | 
    	      y = x - one;  | 
    
    
    360  | 
     | 
     | 
    	      i = 2;  | 
    
    
    361  | 
     | 
     | 
    	    }  | 
    
    
    362  | 
     | 
     | 
    	}  | 
    
    
    363  | 
    ✗✗✓✓
  | 
    10  | 
          switch (i)  | 
    
    
    364  | 
     | 
     | 
    	{ | 
    
    
    365  | 
     | 
     | 
    	case 0:  | 
    
    
    366  | 
     | 
     | 
    	  p1 = a0 + y * (a1 + y * (a2 + y * (a3 + y * (a4 + y * a5))));  | 
    
    
    367  | 
     | 
     | 
    	  p2 = b0 + y * (b1 + y * (b2 + y * (b3 + y * (b4 + y))));  | 
    
    
    368  | 
     | 
     | 
    	  r += half * y + y * p1/p2;  | 
    
    
    369  | 
     | 
     | 
    	  break;  | 
    
    
    370  | 
     | 
     | 
    	case 1:  | 
    
    
    371  | 
     | 
     | 
        p1 = g0 + y * (g1 + y * (g2 + y * (g3 + y * (g4 + y * (g5 + y * g6)))));  | 
    
    
    372  | 
     | 
     | 
        p2 = h0 + y * (h1 + y * (h2 + y * (h3 + y * (h4 + y * (h5 + y)))));  | 
    
    
    373  | 
     | 
     | 
        p = tt + y * p1/p2;  | 
    
    
    374  | 
     | 
     | 
    	  r += (tf + p);  | 
    
    
    375  | 
     | 
     | 
    	  break;  | 
    
    
    376  | 
     | 
     | 
    	case 2:  | 
    
    
    377  | 
     | 
    5  | 
     p1 = y * (u0 + y * (u1 + y * (u2 + y * (u3 + y * (u4 + y * (u5 + y * u6))))));  | 
    
    
    378  | 
     | 
    5  | 
          p2 = v0 + y * (v1 + y * (v2 + y * (v3 + y * (v4 + y * (v5 + y)))));  | 
    
    
    379  | 
     | 
    5  | 
    	  r += (-half * y + p1 / p2);  | 
    
    
    380  | 
     | 
    5  | 
    	}  | 
    
    
    381  | 
     | 
     | 
        }  | 
    
    
    382  | 
    ✓✗ | 
    5  | 
      else if (ix < 0x40028000) /* 8.0 */  | 
    
    
    383  | 
     | 
     | 
        { | 
    
    
    384  | 
     | 
     | 
          /* x < 8.0 */  | 
    
    
    385  | 
     | 
    10  | 
          i = (int) x;  | 
    
    
    386  | 
     | 
     | 
          t = zero;  | 
    
    
    387  | 
     | 
    10  | 
          y = x - (double) i;  | 
    
    
    388  | 
     | 
    10  | 
      p = y *  | 
    
    
    389  | 
     | 
    10  | 
         (s0 + y * (s1 + y * (s2 + y * (s3 + y * (s4 + y * (s5 + y * s6))))));  | 
    
    
    390  | 
     | 
    10  | 
      q = r0 + y * (r1 + y * (r2 + y * (r3 + y * (r4 + y * (r5 + y * (r6 + y))))));  | 
    
    
    391  | 
     | 
    10  | 
          r = half * y + p / q;  | 
    
    
    392  | 
     | 
     | 
          z = one;			/* lgamma(1+s) = log(s) + lgamma(s) */  | 
    
    
    393  | 
    ✗✗✗✗ ✓✓ | 
    10  | 
          switch (i)  | 
    
    
    394  | 
     | 
     | 
    	{ | 
    
    
    395  | 
     | 
     | 
    	case 7:  | 
    
    
    396  | 
     | 
     | 
    	  z *= (y + 6.0);	/* FALLTHRU */  | 
    
    
    397  | 
     | 
     | 
    	case 6:  | 
    
    
    398  | 
     | 
     | 
    	  z *= (y + 5.0);	/* FALLTHRU */  | 
    
    
    399  | 
     | 
     | 
    	case 5:  | 
    
    
    400  | 
     | 
     | 
    	  z *= (y + 4.0);	/* FALLTHRU */  | 
    
    
    401  | 
     | 
     | 
    	case 4:  | 
    
    
    402  | 
     | 
     | 
    	  z *= (y + 3.0);	/* FALLTHRU */  | 
    
    
    403  | 
     | 
     | 
    	case 3:  | 
    
    
    404  | 
     | 
    5  | 
    	  z *= (y + 2.0);	/* FALLTHRU */  | 
    
    
    405  | 
     | 
    5  | 
    	  r += logl (z);  | 
    
    
    406  | 
     | 
    5  | 
    	  break;  | 
    
    
    407  | 
     | 
     | 
    	}  | 
    
    
    408  | 
     | 
     | 
        }  | 
    
    
    409  | 
     | 
     | 
      else if (ix < 0x40418000) /* 2^66 */  | 
    
    
    410  | 
     | 
     | 
        { | 
    
    
    411  | 
     | 
     | 
          /* 8.0 <= x < 2**66 */  | 
    
    
    412  | 
     | 
     | 
          t = logl (x);  | 
    
    
    413  | 
     | 
     | 
          z = one / x;  | 
    
    
    414  | 
     | 
     | 
          y = z * z;  | 
    
    
    415  | 
     | 
     | 
          w = w0 + z * (w1  | 
    
    
    416  | 
     | 
     | 
    	  + y * (w2 + y * (w3 + y * (w4 + y * (w5 + y * (w6 + y * w7))))));  | 
    
    
    417  | 
     | 
     | 
          r = (x - half) * (t - one) + w;  | 
    
    
    418  | 
     | 
     | 
        }  | 
    
    
    419  | 
     | 
     | 
      else  | 
    
    
    420  | 
     | 
     | 
        /* 2**66 <= x <= inf */  | 
    
    
    421  | 
     | 
     | 
        r = x * (logl (x) - one);  | 
    
    
    422  | 
    ✗✓ | 
    10  | 
      if (se & 0x8000)  | 
    
    
    423  | 
     | 
     | 
        r = nadj - r;  | 
    
    
    424  | 
     | 
    10  | 
      return r;  | 
    
    
    425  | 
     | 
    30  | 
    }  | 
    
    
    426  | 
     | 
     | 
    DEF_STD(lgammal);  |