# HG changeset patch # User jwe # Date 1033412889 0 # Node ID c0532bbaefd74938e1e2db642e46de0c6273c0fd # Parent bd51df637cb3fb7fc9cfcdd7cdcaa397e1193f86 [project @ 2002-09-30 19:08:09 by jwe] diff --git a/libcruft/ChangeLog b/libcruft/ChangeLog --- a/libcruft/ChangeLog +++ b/libcruft/ChangeLog @@ -1,3 +1,16 @@ +2002-09-30 Paul Kienzle + + * slatec-fn/xdacosh.f: Mark external functions as external. + * slatec-fn/xdasinh.f: Ditto. + * slatec-fn/xdatanh.f: Ditto. + * slatec-fn/xdbetai.f: Ditto. + * slatec-fn/xderf.f: Ditto. + * slatec-fn/xderfc.f: Ditto. + * slatec-fn/xdgami.f: Ditto. + * slatec-fn/xdgamit.f: Ditto. + * slatec-fn/xdgamma.f: Ditto. + * slatec-fn/xgmainc.f: Ditto. + 2002-08-14 John W. Eaton * odessa/odessa.f (ODESSA): Use XERRWD instead of XERR. diff --git a/libcruft/slatec-fn/xdacosh.f b/libcruft/slatec-fn/xdacosh.f --- a/libcruft/slatec-fn/xdacosh.f +++ b/libcruft/slatec-fn/xdacosh.f @@ -1,4 +1,5 @@ subroutine xdacosh (x, result) + external dacosh double precision x, result, dacosh result = dacosh (x) return diff --git a/libcruft/slatec-fn/xdasinh.f b/libcruft/slatec-fn/xdasinh.f --- a/libcruft/slatec-fn/xdasinh.f +++ b/libcruft/slatec-fn/xdasinh.f @@ -1,4 +1,5 @@ subroutine xdasinh (x, result) + external dasinh double precision x, result, dasinh result = dasinh (x) return diff --git a/libcruft/slatec-fn/xdatanh.f b/libcruft/slatec-fn/xdatanh.f --- a/libcruft/slatec-fn/xdatanh.f +++ b/libcruft/slatec-fn/xdatanh.f @@ -1,4 +1,5 @@ subroutine xdatanh (x, result) + external datanh double precision x, result, datanh result = datanh (x) return diff --git a/libcruft/slatec-fn/xdbetai.f b/libcruft/slatec-fn/xdbetai.f --- a/libcruft/slatec-fn/xdbetai.f +++ b/libcruft/slatec-fn/xdbetai.f @@ -1,4 +1,5 @@ subroutine xdbetai (x, a, b, result) + external dbetai double precision x, a, b, result, dbetai result = dbetai (x, a, b) return diff --git a/libcruft/slatec-fn/xderf.f b/libcruft/slatec-fn/xderf.f --- a/libcruft/slatec-fn/xderf.f +++ b/libcruft/slatec-fn/xderf.f @@ -1,4 +1,5 @@ subroutine xderf (x, result) + external derf double precision x, result, derf result = derf (x) return diff --git a/libcruft/slatec-fn/xderfc.f b/libcruft/slatec-fn/xderfc.f --- a/libcruft/slatec-fn/xderfc.f +++ b/libcruft/slatec-fn/xderfc.f @@ -1,4 +1,5 @@ subroutine xderfc (x, result) + external derfc double precision x, result, derfc result = derfc (x) return diff --git a/libcruft/slatec-fn/xdgami.f b/libcruft/slatec-fn/xdgami.f --- a/libcruft/slatec-fn/xdgami.f +++ b/libcruft/slatec-fn/xdgami.f @@ -1,4 +1,5 @@ subroutine xdgami (a, x, result) + external dgami double precision a, x, result, dgami result = dgami (a, x) return diff --git a/libcruft/slatec-fn/xdgamit.f b/libcruft/slatec-fn/xdgamit.f --- a/libcruft/slatec-fn/xdgamit.f +++ b/libcruft/slatec-fn/xdgamit.f @@ -1,4 +1,5 @@ subroutine xdgamit (a, x, result) + external dgamit double precision a, x, result, dgamit result = dgamit (a, x) return diff --git a/libcruft/slatec-fn/xdgamma.f b/libcruft/slatec-fn/xdgamma.f --- a/libcruft/slatec-fn/xdgamma.f +++ b/libcruft/slatec-fn/xdgamma.f @@ -1,4 +1,5 @@ subroutine xdgamma (x, result) + external dgamma double precision x, result, dgamma result = dgamma (x) return diff --git a/libcruft/slatec-fn/xgmainc.f b/libcruft/slatec-fn/xgmainc.f --- a/libcruft/slatec-fn/xgmainc.f +++ b/libcruft/slatec-fn/xgmainc.f @@ -6,9 +6,13 @@ double precision a, x, result intrinsic exp, log, sqrt, sign, aint + external dgami, dlngam, d9lgit, d9lgic, d9gmit + +C external dgamr +C DOUBLE PRECISION DGAMR DOUBLE PRECISION AEPS, AINTA, ALGAP1, ALNEPS, ALNG, ALX, - $ BOT, H, SGA, SGNGAM, SQEPS, T, D1MACH, DGAMR, D9GMIT, + $ BOT, H, SGA, SGNGAM, SQEPS, T, D1MACH, D9GMIT, $ D9LGIC, D9LGIT, DLNGAM, DGAMI LOGICAL FIRST diff --git a/scripts/ChangeLog b/scripts/ChangeLog --- a/scripts/ChangeLog +++ b/scripts/ChangeLog @@ -1,3 +1,9 @@ +2002-09-27 Paul Kienzle + + * statistics/distributions/normal_cdf.m: Handle variance == 0. + * statistics/distributions/normal_pdf.m: Likewise. + * statistics/distributions/normal_inv.m: Likewise. + 2002-09-27 Paul Kienzle * specfun/erfinv.m: Return NaN for NaN inputs. diff --git a/scripts/statistics/distributions/normal_cdf.m b/scripts/statistics/distributions/normal_cdf.m --- a/scripts/statistics/distributions/normal_cdf.m +++ b/scripts/statistics/distributions/normal_cdf.m @@ -57,11 +57,13 @@ cdf(k) = NaN * ones (1, length (k)); endif - k = find (!isinf (m) & !isnan (m) & (v > 0) & (v < Inf)); + k = find (!isinf (m) & !isnan (m) & (v >= 0) & (v < Inf)); if (any (k)) cdf(k) = stdnormal_cdf ((x(k) - m(k)) ./ sqrt (v(k))); endif + cdf((v == 0) & (x == m)) = 0.5; + cdf = reshape (cdf, r, c); endfunction diff --git a/scripts/statistics/distributions/normal_inv.m b/scripts/statistics/distributions/normal_inv.m --- a/scripts/statistics/distributions/normal_inv.m +++ b/scripts/statistics/distributions/normal_inv.m @@ -52,7 +52,7 @@ v = reshape (v, 1, s); inv = zeros (1, s); - k = find (isinf (m) | isnan (m) | !(v >= 0) | !(v < Inf)); + k = find (isinf (m) | isnan (m) | !(v > 0) | !(v < Inf)); if (any (k)) inv(k) = NaN * ones (1, length (k)); endif @@ -62,6 +62,14 @@ inv(k) = m(k) + sqrt (v(k)) .* stdnormal_inv (x(k)); endif + k = find ((v == 0) & (x > 0) & (x < 1)); + if (any (k)) + inv(k) = m(k); + endif + + inv((v == 0) & (x == 0)) = -Inf; + inv((v == 0) & (x == 1)) = Inf; + inv = reshape (inv, r, c); endfunction diff --git a/scripts/statistics/distributions/normal_pdf.m b/scripts/statistics/distributions/normal_pdf.m --- a/scripts/statistics/distributions/normal_pdf.m +++ b/scripts/statistics/distributions/normal_pdf.m @@ -57,11 +57,14 @@ pdf(k) = NaN * ones (1, length (k)); endif - k = find (!isinf (m) & !isnan (m) & (v > 0) & (v < Inf)); + k = find (!isinf (m) & !isnan (m) & (v >= 0) & (v < Inf)); if (any (k)) pdf(k) = stdnormal_pdf ((x(k) - m(k)) ./ sqrt (v(k))) ./ sqrt (v(k)); endif + pdf((v == 0) & (x == m)) = Inf; + pdf((v == 0) & ((x < m) | (x > m))) = 0; + pdf = reshape (pdf, r, c); endfunction