/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:31:57 */
/*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */
#include <math.h>
#include "fcrt.h"
#include "idranp.h"
#include <float.h>
#include <stdlib.h>
		/* PARAMETER translations */
#define	M	97
#define	NMAX	84
#define	TWO	2.0e0
#define	ZERO	0.0e0
		/* end of PARAMETER translations */
 
	/* COMMON translations */
struct t_rancd2 {
	double dnums[M];
	}	rancd2;
struct t_rancd1 {
	long int dptr;
	LOGICAL32 dgflag;
	}	rancd1;
	/* end of COMMON translations */
long /*FUNCTION*/ idranp(
double xmean)
{
	long int _l0, idranp_v, n;
	static long int last, nmid;
	double s, sprev, term, u;
	static double sum[NMAX-(0)+1], tlast;
	static LOGICAL32 first = TRUE;
	static double elimit = ZERO;
	static double xmsave = 0.e0;
		/* OFFSET Vectors w/subscript range: 1 to dimension */
	double *const Dnums = &rancd2.dnums[0] - 1;
		/* end of OFFSET VECTORS */
 
	/* Copyright (c) 1996 California Institute of Technology, Pasadena, CA.
	 * ALL RIGHTS RESERVED.
	 * Based on Government Sponsored Research NAS7-03001.
	 *>> 2000-12-01 IDRANP Krogh  Removed unused parameter MONE.
	 *>> 1996-03-30 IDRANP Krogh  Added external statement, rem. F90 comment.
	 *>> 1995-11-16 IDRANP Krogh  Converted from SFTRAN to Fortran 77.
	 *>> 1994-10-19 IDRANP Krogh  Changes to use M77CON
	 *>> 1994-06-24 IDRANP CLL Changed common to use RANC[D/S]1 & RANC[D/S]2.
	 *>> 1994-06-23 CLL Changed name to I[D/S]RANP.
	 *>> 1992-03-16 CLL
	 *>> 1991-11-26 CLL Reorganized common. Using RANCM[A/D/S].
	 *>> 1991-11-22 CLL Added call to RAN0, and DGFLAG in common.
	 *>> 1991-01-15 CLL Reordered common contents for efficiency.
	 *>> 1990-01-23 CLL  Making names in common same in all subprogams.
	 *>> 1987-04-23 IRANP  Lawson  Initial code.
	 *        Returns one pseudorandom integer from the Poisson distribution
	 *     with mean and variance = XMEAN.
	 *        The probability of occurrence of the nonnegative integer k in
	 *     the Poisson distribution with mean XMEAN is */
	/*                P(k) = exp(-XMEAN) * XMEAN**k / k! */
	/*        Let SUM(n) denote the sum for k = 0 to n of P(k).
	 *     Let U be a random sample from a uniform
	 *     distribution on [0.0, 1.0].  The returned value of IDRANP will be
	 *     the smallest integer such that S(IDRANP) .ge. U.
	 *     This variable has mean and variance = XMEAN.
	 *     Reference: Richard H. Snow, Algorithm 342, Comm ACM, V. 11,
	 *     Dec 1968, p. 819.
	 *     Code based on subprogram written for JPL by Stephen L. Ritchie,
	 *     Heliodyne Corp. and Wiley R. Bunton, JPL, 1969.
	 *     Adapted to Fortran 77 for the JPL MATH77 library by C. L. Lawson &
	 *     S. Y. Chiu, JPL, Apr 1987.
	 *     ------------------------------------------------------------------
	 *                    Subprogram argument and result
	 *
	 *     XMEAN [in]  Mean value for the desired distribution.
	 *           Must be positive and not so large that exp(-XMEAN)
	 *           will underflow.  For example, on a machine with underflow
	 *           limit 0.14D-38, XMEAN must not exceed 88.
	 *
	 *     IDRANP [Returned function value]  Will be set to a nonnegative
	 *           integer value if computation is successful.
	 *           Will be set to -1 if XMEAN is out of range.
	 *     ------------------------------------------------------------------
	 *--D replaces "?": I?RANP, ?ERM1, ?ERV1, ?RANUA
	 *--&                 RANC?1, RANC?2, ?PTR, ?NUMS, ?GFLAG
	 *     Generic intrinsic functions referenced: EXP, LOG, MIN, NINT
	 *     Other MATH77 subprogram referenced: RAN0
	 *     Other MATH77 subprograms needed: ERMSG, ERFIN, AMACH
	 *     Common referenced: /RANCD1/, /RANCD2/
	 *     ------------------------------------------------------------------ */
 
 
	/*     ------------------------------------------------------------------ */
	if (first || (xmean != xmsave))
	{
		/*                                      Set for new XMEAN
		 *     D1MACH(1) gives the underflow limit.
		 *     ELIMIT gives a limit for arguments to the exponential function
		 *     such that if XMEAN .le. ELIMIT,  exp(-XMEAN) should not
		 *     underflow.
		 * */
		if (elimit == ZERO)
			elimit = -log( DBL_MIN*TWO );
		if (xmean <= ZERO || xmean > elimit)
		{
			derm1( "IDRANP", 1, 0, "Require 0 .lt. XMEAN .le. ELIMIT"
			 , "XMEAN", xmean, ',' );
			derv1( "ELIMIT", elimit, '.' );
			idranp_v = -1;
		}
		else
		{
			last = 0;
			tlast = exp( -xmean );
			sum[0] = tlast;
			xmsave = xmean;
			nmid = nint( xmean );
		}
		if (first)
		{
			first = FALSE;
			ran0();
		}
	}
	/*               SET U = UNIFORM RANDOM NUMBER */
	rancd1.dptr -= 1;
	if (rancd1.dptr == 0)
	{
		dranua( rancd2.dnums, M );
		rancd1.dptr = M;
	}
	u = Dnums[rancd1.dptr];
 
	if (u > sum[last])
	{
		/*                          COMPUTE MORE SUMS */
		n = last;
		sprev = sum[last];
		term = tlast;
L_50:
		;
		n += 1;
		term = term*xmean/(double)( n );
		s = sprev + term;
		if (s == sprev)
		{
			idranp_v = n;
			return( idranp_v );
		}
		if (n <= NMAX)
		{
			last = n;
			sum[last] = s;
			tlast = term;
		}
		if (u <= s)
		{
			idranp_v = n;
			return( idranp_v );
		}
		sprev = s;
		goto L_50;
	}
	else
	{
		/*                            SEARCH THROUGH STORED SUMS
		 *     Here we already know that U .le. SUM(LAST).
		 *     It is most likely that U will be near SUM(NMID).
		 * */
		if (nmid < last)
		{
			if (u > sum[nmid])
			{
				for (n = nmid + 1; n <= last; n++)
				{
					if (u <= sum[n])
					{
						idranp_v = n;
						return( idranp_v );
					}
				}
			}
		}
 
		for (n = min( nmid, last ) - 1; n >= 0; n--)
		{
			if (u > sum[n])
			{
				idranp_v = n + 1;
				return( idranp_v );
			}
		}
		idranp_v = 0;
	}
	return( idranp_v );
} /* end of function */