/src/r-source/src/nmath/gammalims.c
Line | Count | Source |
1 | | /* |
2 | | * Mathlib : A C Library of Special Functions |
3 | | * Copyright (C) 1998 Ross Ihaka |
4 | | * Copyright (C) 1999-2025 The R Core Team |
5 | | * |
6 | | * This program is free software; you can redistribute it and/or modify |
7 | | * it under the terms of the GNU General Public License as published by |
8 | | * the Free Software Foundation; either version 2 of the License, or |
9 | | * (at your option) any later version. |
10 | | * |
11 | | * This program is distributed in the hope that it will be useful, |
12 | | * but WITHOUT ANY WARRANTY; without even the implied warranty of |
13 | | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
14 | | * GNU General Public License for more details. |
15 | | * |
16 | | * You should have received a copy of the GNU General Public License |
17 | | * along with this program; if not, a copy is available at |
18 | | * https://www.R-project.org/Licenses/ |
19 | | * |
20 | | * SYNOPSIS |
21 | | * |
22 | | * #include <Rmath.h> |
23 | | * void gammalims(double *xmin, double *xmax); |
24 | | * |
25 | | * DESCRIPTION |
26 | | * |
27 | | * This function calculates the minimum and maximum legal bounds |
28 | | * for x in gammafn(x). These are not the only bounds, but they |
29 | | * are the only non-trivial ones to calculate. |
30 | | * |
31 | | * NOTES |
32 | | * |
33 | | * This routine is a translation into C of a Fortran subroutine |
34 | | * by W. Fullerton of Los Alamos Scientific Laboratory. |
35 | | */ |
36 | | |
37 | | #include "nmath.h" |
38 | | |
39 | | attribute_hidden void gammalims(double *xmin, double *xmax) |
40 | 0 | { |
41 | | /* FIXME: Even better: If IEEE, #define these in nmath.h |
42 | | and don't call gammalims() at all |
43 | | */ |
44 | 0 | #ifdef IEEE_754 |
45 | 0 | *xmin = -170.5674972726612; |
46 | 0 | *xmax = 171.61447887182298;/*(3 Intel/Sparc architectures)*/ |
47 | | #else |
48 | | double alnbig, alnsml, xln, xold; |
49 | | int i; |
50 | | |
51 | | alnsml = log(d1mach(1)); |
52 | | *xmin = -alnsml; |
53 | | for (i=1; i<=10; ++i) { |
54 | | xold = *xmin; |
55 | | xln = log(*xmin); |
56 | | *xmin -= *xmin * ((*xmin + .5) * xln - *xmin - .2258 + alnsml) / |
57 | | (*xmin * xln + .5); |
58 | | if (fabs(*xmin - xold) < .005) { |
59 | | *xmin = -(*xmin) + .01; |
60 | | goto find_xmax; |
61 | | } |
62 | | } |
63 | | |
64 | | /* unable to find xmin */ |
65 | | |
66 | | ML_WARNING(ME_NOCONV, "gammalims"); |
67 | | *xmin = *xmax = ML_NAN; |
68 | | |
69 | | find_xmax: |
70 | | |
71 | | alnbig = log(d1mach(2)); |
72 | | *xmax = alnbig; |
73 | | for (i=1; i<=10; ++i) { |
74 | | xold = *xmax; |
75 | | xln = log(*xmax); |
76 | | *xmax -= *xmax * ((*xmax - .5) * xln - *xmax + .9189 - alnbig) / |
77 | | (*xmax * xln - .5); |
78 | | if (fabs(*xmax - xold) < .005) { |
79 | | *xmax += -.01; |
80 | | goto done; |
81 | | } |
82 | | } |
83 | | |
84 | | /* unable to find xmax */ |
85 | | |
86 | | ML_WARNING(ME_NOCONV, "gammalims"); |
87 | | *xmin = *xmax = ML_NAN; |
88 | | |
89 | | done: |
90 | | *xmin = fmax2(*xmin, -(*xmax) + 1); |
91 | | #endif |
92 | 0 | } |
93 | | |