From 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 Mon Sep 17 00:00:00 2001 From: Joe Hunkeler Date: Tue, 11 Aug 2015 16:51:37 -0400 Subject: Repatch (from linux) of OSX IRAF --- noao/artdata/numrecipes.x | 121 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 121 insertions(+) create mode 100644 noao/artdata/numrecipes.x (limited to 'noao/artdata/numrecipes.x') diff --git a/noao/artdata/numrecipes.x b/noao/artdata/numrecipes.x new file mode 100644 index 00000000..fa0f56b6 --- /dev/null +++ b/noao/artdata/numrecipes.x @@ -0,0 +1,121 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include + +# GAMMLN -- Return natural log of gamma function. +# POIDEV -- Returns Poisson deviates for a given mean. +# GASDEV -- Return a normally distributed deviate of zero mean and unit var. + + +# GAMMLN -- Return natural log of gamma function. +# Argument must greater than 0. Full accuracy is obtained for values +# greater than 1. For 0 g; t = t * urand (seed)) + em = em + 1 + } else if (xm < 100) { + if (xm != oldm) { + oldm = xm + sq = sqrt (2. * xm) + ymin = -xm / sq + ymax = (1000 - xm) / sq + alxm = log (xm) + g = xm * alxm - gammln (xm+1.) + } + repeat { + repeat { + y = tan (PI * urand(seed)) + } until (y >= ymin) + em = int (sq * min (y, ymax) + xm) + t = 0.9 * (1 + y**2) * exp (em * alxm - gammln (em+1) - g) + } until (urand(seed) <= t) + } else + em = xm + sqrt (xm) * gasdev (seed) + return (em) +end + + +# GASDEV -- Return a normally distributed deviate with zero mean and unit +# variance. The method computes two deviates simultaneously. +# +# Based on Numerical Recipes by Press, Flannery, Teukolsky, and Vetterling. +# Used by permission of the authors. +# Copyright(c) 1986 Numerical Recipes Software. + +real procedure gasdev (seed) + +long seed # Seed for random numbers + +real urand() +double v1, v2, r, fac +int iset +data iset/0/ + +begin + if (iset == 0) { + repeat { + v1 = 2 * urand (seed) - 1. + v2 = 2 * urand (seed) - 1. + r = v1 ** 2 + v2 ** 2 + } until ((r > 0) && (r < 1)) + fac = sqrt (-2. * log (r) / r) + + iset = 1 + return (v1 * fac) + } else { + iset = 0 + return (v2 * fac) + } +end -- cgit