view liboctave/external/ranlib/ignnbn.f @ 23434:f4d4d83f15c5

maint: rename cruft/ directory to external/ * liboctave/external: Renamed from liboctave/cruft. * * configure.ac: Rename XTRA_CRUFT_SH_LDFLAGS to XTRA_EXTERNAL_SH_LDFLAGS. Rename CRUFT_DLL_DEFS to EXTERNAL_DLL_DEFS. * install.txi: Update documentation to refer to liboctave/external. * HACKING: Update explanation of directory tree. * liboctave/module.mk: Update build system to include liboctave/external * liboctave/numeric/module.mk: Update CPPFLAGS to find Faddeeva in external/ directory. * lo-blas-proto.h, lo-lapack-proto.h: Update comments which referred to cruft directory.
author Rik <rik@octave.org>
date Mon, 24 Apr 2017 21:03:38 -0700
parents liboctave/cruft/ranlib/ignnbn.f@648dabbb4c6b
children 32671b14ed7b
line wrap: on
line source

      INTEGER FUNCTION ignnbn(n,p)
C**********************************************************************
C
C     INTEGER FUNCTION IGNNBN( N, P )
C
C                GENerate Negative BiNomial random deviate
C
C
C                              Function
C
C
C     Generates a single random deviate from a negative binomial
C     distribution.
C
C
C                              Arguments
C
C
C     N  --> Required number of events.
C                              INTEGER N
C     JJV                      (N > 0)
C
C     P  --> The probability of an event during a Bernoulli trial.
C                              REAL P
C     JJV                      (0.0 < P < 1.0)
C
C
C
C                              Method
C
C
C     Algorithm from page 480 of
C
C     Devroye, Luc
C
C     Non-Uniform Random Variate Generation.  Springer-Verlag,
C     New York, 1986.
C
C**********************************************************************
C     ..
C     .. Scalar Arguments ..
      REAL p
      INTEGER n
C     ..
C     .. Local Scalars ..
      REAL y,a,r
C     ..
C     .. External Functions ..
C     JJV changed to call SGAMMA directly
C     REAL gengam
      REAL sgamma
      INTEGER ignpoi
C      EXTERNAL gengam,ignpoi
      EXTERNAL sgamma,ignpoi
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC real
C     ..
C     .. Executable Statements ..
C     Check Arguments
C     JJV changed argumnet checker to abort if N <= 0
      IF (n.LE.0) CALL XSTOPX ('N <= 0 in IGNNBN')
      IF (p.LE.0.0) CALL XSTOPX ('P <= 0.0 in IGNNBN')
      IF (p.GE.1.0) CALL XSTOPX ('P >= 1.0 in IGNNBN')

C     Generate Y, a random gamma (n,(1-p)/p) variable
C     JJV Note: the above parametrization is consistent with Devroye,
C     JJV       but gamma (p/(1-p),n) is the equivalent in our code
 10   r = real(n)
      a = p/ (1.0-p)
C      y = gengam(a,r)
      y = sgamma(r)/a

C     Generate a random Poisson(y) variable
      ignnbn = ignpoi(y)
      RETURN

      END