double lcgf(double a, double x) { int i; const double EPS=std::numeric_limits<double>::epsilon(); const double FPMIN=std::numeric_limits<double>::min()/EPS; double an,b,c,d,del,h,gln=gammln(a); // assert(x>=(a+1)); BOINCASSERT(x>=(a+1)); b=x+1.0-a; c=1.0f/FPMIN; d=1.0/b; h=d; for (i=1;i<=ITMAX;i++) { an = -i*(i-a); b += 2.0; d=an*d+b; if (fabs(d)<FPMIN) d=FPMIN; c=b+an/c; if (fabs(c)<FPMIN) c=FPMIN; d=1.0/d; del=d*c; h*=del; if (fabs(del-1.0)<EPS) break; } // assert(i<ITMAX); BOINCASSERT(i<ITMAX); return (float)(log(h)-x+a*log(x)-gln); }
int gser(double *gamser, double a, double x, double *gln) { double gammln(double xx); int n; double sum,del,ap; *gln=gammln(a); if (x <= 0.0) { if (x < 0.0) { fprintf ( stderr, "x less than 0 in routine gser\n"); return 1; } *gamser=0.0; return 0; } else { ap=a; del=sum=1.0/a; for (n=1;n<=ITMAX;n++) { ++ap; del *= x/ap; sum += del; if (fabs(del) < fabs(sum)*EPS) { *gamser=sum*exp(-x+a*log(x)-(*gln)); return 0; } } fprintf( stderr, "a too large, ITMAX too small in routine gser\n"); return 1; } }
void Statistics::gser(double *gamser, double a, double x, double *gln) { int n; double sum, del, ap; *gln = gammln(a); if(x <= 0.0){ *gamser=0.0; return; } else { ap = a; del = sum = 1.0/a; for(n = 1; n <= Statistics::ITMAX(); n++){ ap += 1.0; del *= x/ap; sum += del; if(fabs(del) < fabs(sum)*Statistics::EPS()){ *gamser=sum*exp(-x+a*log(x)-(*gln)); return; } } throw GammaFxnFailureException(); return; } }
void Statistics::gcf(double *gammcf, double a, double x, double *gln) { int n; double gold = 0.0, g, fac = 1.0, b1 = 1.0; double b0= 0.0, anf, ana, an, a1, a0 = 1.0; *gln = gammln(a); a1 = x; for(n = 1 ; n <= Statistics::ITMAX() ; n++){ an = static_cast<double>(n); ana = an - a; a0 = (a1 + a0 * ana) * fac; b0 = (b1 + b0 * ana) * fac; anf = an * fac; a1 = x * a0 + anf * a1; b1 = x * b0 + anf * b1; if(a1 > pow(Statistics::EPS(),3)){ // CHANGED BY RTG to avoid f.p. compare. fac = 1.0/a1; g= b1 * fac; if(fabs((g - gold)/g) < Statistics::EPS()){ *gammcf = exp(-x + a * log(x) - (*gln)) * g; return; } gold = g; } } throw GammaFxnFailureException(); }
void Test::gcf(float *gammcf, float a, float x, float *gln) { int i; float an, b, c, d, del, h; *gln = gammln(a); b = x + 1.0 - a; c = 1.0/FPMIN; d = 1.0/b; h = d; for(i = 1; i <= ITMAX; i++) //iterate to convergence { an = -i*(i - a); b += 2.0; //Set up for evaluating continued d = an*d + b; //fraction by modified Lentz's method with b_0 = 0. if(fabs(d) < FPMIN) d = FPMIN; c = b + an/c; if(fabs(c) < FPMIN) c = FPMIN; d = 1.0/d; del = d*c; h *= del; if(fabs(del - 1.0) < EPS) break; } if (i > ITMAX) nerror("a too large, ITMAX too small in continued fraction gamma function"); *gammcf = exp(-x + a*log(x) - (*gln))*h; //Put factors in front return; }
void gcf(float *gammcf, float a, float x, float *gln) { int i; float an,b,c,d,del,h; *gln=gammln(a); b=x+1.0-a; c=1.0/FPMIN; d=1.0/b; h=d; for (i=1;i<=ITMAX;i++) { an = -i*(i-a); b += 2.0; d=an*d+b; if (fabs(d) < FPMIN) d=FPMIN; c=b+an/c; if (fabs(c) < FPMIN) c=FPMIN; d=1.0/d; del=d*c; h *= del; if (fabs(del-1.0) < EPS) break; } if (i > ITMAX) nrerror("a too large, ITMAX too small in gcf"); *gammcf=exp(-x+a*log(x)-(*gln))*h; }
//gser --- Returns the incomplete gamma function P(a,x) //evaluated by its series representation. Also returns //natural log of gamma(a) void Test::gser(float *gamser, float a, float x, float *gln) { int n; float sum, del, ap; *gln = gammln(a); if(x <= 0.0) { if(x < 0.0) nerror("x less than zero in series expansion gamma function"); *gamser = 0.0; return; } else { ap = a; del = sum = 1.0/a; for(n = 1; n <= ITMAX; n++) { ++ap; del *= x/ap; sum += del; if(fabs(del) < (fabs(sum)*EPS)) { *gamser = sum*exp(-x + (a*log(x)) - (*gln)); return; } } nerror("a is too large, ITMAX is too small, in series expansion gamma function"); return; } }
float gammln(float xx) { double x,y,tmp,ser,sinus; static double cof[6]={76.18009172947146,-86.50532032941677, 24.01409824083091,-1.231739572450155, 0.1208650973866179e-2,-0.5395239384953e-5}; int j; /* Different Cases */ nr_gamm_sign = 1; if (xx <= 0) { sinus = sin(M_PI*xx); if (sinus == 0.) nrerror("The gamma function is not defined for <= integers"); tmp = log(M_PI) - gammln(1.-xx) - log(fabs(sinus)); if (sinus < 0) nr_gamm_sign = -1; return (float) tmp; } y=x=xx; tmp=x+5.5; tmp -= (x+0.5)*log(tmp); ser=1.000000000190015; for (j=0;j<=5;j++) ser += cof[j]/++y; return -tmp+log(2.5066282746310005*ser/x); }
void gser(float *gamser, float a, float x, float *gln) { int n; float sum,del,ap; *gln=gammln(a); if (x <= 0.0) { if (x < 0.0) nrerror("x less than 0 in routine gser"); *gamser=0.0; return; } else { ap=a; del=sum=1.0/a; for (n=1;n<=ITMAX;n++) { ++ap; del *= x/ap; sum += del; if (fabs(del) < fabs(sum)*EPS) { *gamser=sum*exp(-x+a*log(x)-(*gln)); return; } } nrerror("a too large, ITMAX too small in routine gser"); return; } }
void _poidev(float *xmv, long n) /* all floats -> doubles on June 2010 to avoid SIGFPE for too large input values */ { double gammln(double xx); /* float ran1(long *idum);*/ static double sq,alxm,g,oldm=(-1.0); double xm,em,t,y,y1; long i; for (i=0;i<n;i++) { xm = (double)xmv[i]; if (xm == 0.0f) continue; if (xm < 20.0) { /* Use direct method. */ if (xm != oldm) { oldm=xm; g=exp(-xm); /* If xm is new, compute the exponential. */ } em = -1; t=1.0; do { ++em; t *= ran1(); } while (t > g); } else { /* Use rejection method. */ if (xm != oldm) { oldm=xm; sq=sqrt(2.0*xm); alxm=log(xm); // printf("xm+1.0 = %.f gammln(xm+1.0) = %.f\n",xm+1.0,gammln(xm+1.0)); g=xm*alxm-gammln(xm+1.0); } do { do { y=tan(3.1415926535897932384626433832*ran1()); em=sq*y+xm; } while (em < 0.0); em=floor(em); // printf("em+1.0 = %.f gammln(em+1.0) = %.f\n",em+1.0,gammln(em+1.0)); // printf("exp(em*alxm-gammln(em+1.0)-g) = %.f\n",exp(em*alxm-gammln(em+1.0)-g)); t=0.9*(1.0+y*y)*exp(em*alxm-gammln(em+1.0)-g); } while (ran1() > t); } xmv[i] = (float)em; } }
/************************************************************************************************************* Procedure: bico From Numerical Recipes: calculates binomial coefficients ************************************************************************************************************/ float bico(int n, int k) { float lnfactn, lnfactk, lnfactnk, bin; if (k > n) bin = 0.0; else if (k < 0) bin = 0.0; else if (k == 0) bin = 1.0; else { lnfactn = gammln((float)(n+1)); lnfactk = gammln((float)(k+1)); lnfactnk = gammln((float)(n-k+1)); bin = floor(0.5+exp(lnfactn - lnfactk - lnfactnk)); } return (bin); }
/* Incomplete beta function * ------------------------ * Numerical Recipes pg 227 */ REAL_TYPE betai(REAL_TYPE a, REAL_TYPE b, REAL_TYPE x) throw(std::invalid_argument) { REAL_TYPE bt; if(x<0.00||x>1.00) throw(std::invalid_argument(std::string("betai():x must be between 0.0 and 1.0"))); if(x==0.0 || x==1.0) bt=0.0; else bt=std::exp(gammln(a+b)-gammln(a)-gammln(b)+a*std::log(x)+b*std::log(1.0-x)); if(x< (a+1.0)/(a+b+2.0)) { return (bt*betacf(a,b,x)/a); } else { return(1.0-bt*betacf(b,a,1.0-x)/b); } }
bool_t getBarklemcross(Barklemstruct *bs, RLK_Line *rlk) { const char routineName[] = "getBarklemcross"; int index; double Z, neff1, neff2, findex1, findex2, reducedmass, meanvelocity, crossmean, E_Rydberg, deltaEi, deltaEj; Element *element; element = &atmos.elements[rlk->pt_index - 1]; /* --- Note: ABO tabulations are valid only for neutral atoms -- -- */ if (rlk->stage > 0) return FALSE; if ((deltaEi = element->ionpot[rlk->stage] - rlk->Ei) <= 0.0) return FALSE; if ((deltaEj = element->ionpot[rlk->stage] - rlk->Ej) <= 0.0) return FALSE; Z = (double) (rlk->stage + 1); E_Rydberg = E_RYDBERG / (1.0 + M_ELECTRON / (element->weight * AMU)); neff1 = Z * sqrt(E_Rydberg / deltaEi); neff2 = Z * sqrt(E_Rydberg / deltaEj); if (rlk->Li > rlk->Lj) SWAPDOUBLE(neff1, neff2); if (neff1 < bs->neff1[0] || neff1 > bs->neff1[bs->N1-1]) return FALSE; Locate(bs->N1, bs->neff1, neff1, &index); findex1 = (double) index + (neff1 - bs->neff1[index]) / BARKLEM_DELTA_NEFF; if (neff2 < bs->neff2[0] || neff2 > bs->neff2[bs->N2-1]) return FALSE; Locate(bs->N2, bs->neff2, neff2, &index); findex2 = (double) index + (neff2 - bs->neff2[index]) / BARKLEM_DELTA_NEFF; /* --- Find interpolation in table -- -------------- */ rlk->cross = cubeconvol(bs->N2, bs->N1, bs->cross[0], findex2, findex1); rlk->alpha = cubeconvol(bs->N2, bs->N1, bs->alpha[0], findex2, findex1); reducedmass = AMU / (1.0/atmos.H->weight + 1.0/element->weight); meanvelocity = sqrt(8.0 * KBOLTZMANN / (PI * reducedmass)); crossmean = SQ(RBOHR) * pow(meanvelocity / 1.0E4, -rlk->alpha); rlk->cross *= 2.0 * pow(4.0/PI, rlk->alpha/2.0) * exp(gammln((4.0 - rlk->alpha)/2.0)) * meanvelocity * crossmean; rlk->vdwaals = BARKLEM; return TRUE; }
int bnlrnd(double pp, int n) { int j; static int nold=(-1); double am,em,g,angle,p,bnl,sq,t,y; static double pold=(-1.0),pc,plog,pclog,en,oldg; p=(pp <= 0.5 ? pp : 1.0-pp); am=n*p; //This is the mean of the deviate to be produced. if (n < 25) { bnl = 0.0; for (j=1;j<=n;j++) if (ran2() < p) ++bnl; } else if (am < 1.0) { g=exp(-am); t=1.0; for (j=0;j<=n;j++) { t *= ran2(); if (t < g) break; } bnl=(j <= n ? j : n); } else { if (n != nold) { en=n; oldg=gammln(en+1.0); nold=n; } if (p != pold) { pc=1.0-p; plog=log(p); pclog=log(pc); pold=p; } sq=sqrt(2.0*am*pc); do { do { angle=PI*ran2(); y=tan(angle); em=sq*y+am; } while (em < 0.0 || em >= (en+1.0)); em=floor(em); t=1.2*sq*(1.0+y*y)*exp(oldg-gammln(em+1.0)-gammln(en-em+1.0)+em*plog+(en-em)*pclog); } while (ran2() > t); bnl=em; } if (p != pp) bnl=n-bnl; return (int)bnl; }
dvariable dgamma(const prevariable& x, const double& a, const double& b) { //returns the gamma density with a & b as parameters RETURN_ARRAYS_INCREMENT(); dvariable t1 = 1./(pow(b,a)*mfexp(gammln(a))); dvariable t2 = (a-1.)*log(x)-x/b; RETURN_ARRAYS_DECREMENT(); return(t1*mfexp(t2)); }
// Returns the density of a gamma pdf at x double log_gamma_pdf(double alpha, double beta, double x) { if (x < 0) return 0; double out; out = (alpha - 1.0) * log(x) - alpha*log(beta) - gammln(alpha) - (x / beta); return out; }
//Input: alf = the alpha parameter of the Laguerre polynomials // pointsNum = the polynom order //Output: the abscissas and weights are stored in the vecotrs x and w, respectively. //Discreption: given alf, the alpha parameter of the Laguerre polynomials, the function returns the abscissas and weights // of the n-point Guass-Laguerre quadrature formula. // The smallest abscissa is stored in x[0], the largest in x[pointsNum - 1]. void GLaguer::gaulag(Vdouble &x, Vdouble &w, const MDOUBLE alf, const int pointsNum) { x.resize(pointsNum, 0.0); w.resize(pointsNum, 0.0); const int MAXIT=10000; const MDOUBLE EPS=1.0e-6; int i,its,j; MDOUBLE ai,p1,p2,p3,pp,z=0.0,z1; int n= x.size(); for (i=0;i<n;i++) { //loops over the desired roots if (i == 0) { //initial guess for the smallest root z=(1.0+alf)*(3.0+0.92*alf)/(1.0+2.4*n+1.8*alf); } else if (i == 1) {//initial guess for the second smallest root z += (15.0+6.25*alf)/(1.0+0.9*alf+2.5*n); } else { //initial guess for the other roots ai=i-1; z += ((1.0+2.55*ai)/(1.9*ai)+1.26*ai*alf/ (1.0+3.5*ai))*(z-x[i-2])/(1.0+0.3*alf); } for (its=0;its<MAXIT;its++) { //refinement by Newton's method p1=1.0; p2=0.0; for (j=0;j<n;j++) { //Loop up the recurrence relation to get the Laguerre polynomial evaluated at z. p3=p2; p2=p1; p1=((2*j+1+alf-z)*p2-(j+alf)*p3)/(j+1); } //p1 is now the desired Laguerre polynomial. We next compute pp, its derivative, //by a standard relation involving also p2, the polynomial of one lower order. pp=(n*p1-(n+alf)*p2)/z; z1=z; z=z1-p1/pp; //Newton's formula if (fabs(z-z1) <= EPS) break; } if (its >= MAXIT) errorMsg::reportError("too many iterations in gaulag"); x[i]=z; w[i] = -exp(gammln(alf+n)-gammln(MDOUBLE(n)))/(pp*n*p2); } }
/* poisson deviate, from numerical recipes in C pp. 294ff */ double poidev(double mean) { double gammln(double xx); static double sq, alxm, g, oldm=(-1.0); double em, t, y; if (mean < 12.0) { if (mean != oldm) { oldm = mean; g=exp(-mean); } em = -1; t=1.0; do { ++em; t *= unif_distn(); } while (t > g); } else { if (mean != oldm) { oldm=mean; sq=sqrt(2.0*mean); alxm=log(mean); g=mean*alxm-gammln(mean+1.0); } do { do { y = tan(M_PI*unif_distn()); em = sq*y+mean; } while (em < 0.0); em = floor(em); t=0.9 * (1.0 + y*y) * exp(em*alxm-gammln(em+1.0)-g); } while (unif_distn() > t); } return em; }
int main(void) { double gam1,gam2,gampl,gammi,x,xgam1,xgam2,xgampl,xgammi; for (;;) { printf("Enter x:\n"); if (scanf("%lf",&x) == EOF) break; beschb(x,&xgam1,&xgam2,&xgampl,&xgammi); printf("%5s\n%17s %16s %17s %15s\n%17s %16s %17s %15s\n", "x","gam1","gam2","gampl","gammi","xgam1","xgam2","xgampl","xgammi"); gampl=1/exp(gammln((float)(1+x))); gammi=1/exp(gammln((float)(1-x))); gam1=(gammi-gampl)/(2*x); gam2=(gammi+gampl)/2; printf("%5.2f\n\t%16.6e %16.6e %16.6e %16.6e\n",x,gam1,gam2,gampl,gammi); printf("\t%16.6e %16.6e %16.6e %16.6e\n",xgam1,xgam2,xgampl,xgammi); } return 0; }
double bkgd_t_dist_gamma(double t, void *v) { BkgdParam *p = v; double k = p->gamma_shape; double m = p->gamma_scale; double tgamma; tgamma = exp(gammln(k)); return (p->gamma_c * pow(t, k-1.0) * exp(-t/m)) / (tgamma * pow(m,k)); }
// Returns a factorial double factorial(int n) { static int ntop=4; static double a[33]={1.0,1.0,2.0,6.0,24.0}; int j; if (n < 0) nrerror("Negative factorial in routine factrl"); if (n > 32) return exp(gammln(n+1.0)); while (ntop<n) { j=ntop++; a[ntop]=a[j]*ntop; } return a[n]; }
df1b2variable log_negbinomial_density(double x,const df1b2variable& _xmu, const df1b2variable& _xtau) { ADUNCONST(df1b2variable,xmu) ADUNCONST(df1b2variable,xtau) init_df3_two_variable mu(xmu); init_df3_two_variable tau(xtau); *mu.get_u_x()=1.0; *tau.get_u_y()=1.0; if (value(tau)-1.0<0.0) { cerr << "tau <=1 in log_negbinomial_density " << endl; ad_exit(1); } df3_two_variable r=mu/(1.e-120+(tau-1.0)); df3_two_variable tmp; tmp=gammln(x+r)-gammln(r) -gammln(x+1) +r*log(r)+x*log(mu)-(r+x)*log(r+mu); df1b2variable tmp1; tmp1=tmp; return tmp1; }
/* Returns the incomplete beta function Ix (a, b). */ double betai(double a, double b, double x) { double gammln(double xx); double bt; if (x < 0.0 || x > 1.0){ fprintf( StdErr, "Bad x==%s in routine betai\n", d2str(x, NULL, NULL) ); } if( x== 0.0 || x== 1.0 ){ bt=0.0; } else{ /* Factors in front of the continued fraction. */ bt= exp( gammln(a+b)- gammln(a)- gammln(b)+ a* log(x)+ b* log(1.0-x) ); } if( x< (a+1.0)/(a+b+2.0) ){ /* Use continued fraction directly. */ return( bt* betacf(a,b,x)/ a ); } else{ /* Use continued fraction after making the symmetry transformation. */ return( 1.0- bt* betacf( b,a,1.0-x )/ b ); } }
int sample_lambda_prior_COST(Data_COST *i_D_COST) { int i,h,T,num; double sumLambda,sumLogLambda; double c_new,c_old,log_new,log_old,accProb,u; double e = 0.001; double f = 0.001; double fac = 0.01; sumLambda = G_ZERO; sumLogLambda = G_ZERO; for(h=0;h<i_D_COST->mland->n_trip;h++) { sumLambda += i_D_COST->mland->lambda[h]; sumLogLambda += log(i_D_COST->mland->lambda[h]); } T = i_D_COST->mland->n_trip; num=1000; c_old = i_D_COST->mland->c; for(i=0;i<num;i++) { c_new = scale_proposal(c_old,fac,NULL); log_new = -T*log(exp(gammln(c_new))) + (c_new-1)*sumLogLambda +log(exp(gammln(e+c_new*T))) - (e+c_new*T)*log(f+sumLambda); log_old = -T*log(exp(gammln(c_old))) + (c_old-1)*sumLogLambda +log(exp(gammln(e+c_old*T))) - (e+c_old*T)*log(f+sumLambda); accProb = log_new - log_old; u = genunf(G_ZERO,G_ONE); if(accProb > -1.0e32 && accProb < 1.0e32 && log(u) < accProb) c_old = c_new; } i_D_COST->mland->c = c_old; i_D_COST->mland->d = gengam(f+sumLambda,e+i_D_COST->mland->c*T); return(0); } /* end of sample_lambda_prior_COST */
double logddirichlet(double *x,double *alpha,int len) { //logD <- sum(lgamma(alpha)) - lgamma(sum(alpha)) //s <- sum((alpha - 1) * log(x)) //sum(s) - logD) // This function calculates the log dirichlet density double logD=0.0,logdens,sumalpha=0.0,s=0.0; int k; for(k=0;k<len;k++) { s += (alpha[k]-1)*log(x[k]); sumalpha += alpha[k]; logD += gammln(alpha[k]); } logD -= gammln(sumalpha); logdens = s-logD; return(logdens); }
double factrl(int n){ //void nrerror(char error_text[]); static int ntop = 4; static double a[33] = {1.0, 1.0, 2.0, 6.0, 24.0}; int j; if (n < 0) printf("Negative factorial in routine factrl"); if (n > 32) return (exp(gammln(n + 1.0))); while (ntop < n){ j = ntop++; a[ntop] = a[j]*ntop; } return(a[n]); }
/** \author Steven James Dean Martell UBC Fisheries Centre \date 2011-06-24 \param k vector of observed numbers \param lambda vector of epected means of the distribution \return returns the negative loglikelihood \f$\sum_i -k_i \ln( \lambda_i ) - \lambda_i + \ln(k_i!) \f$ \sa **/ dvariable dpois(const dvector& k, const dvar_vector& lambda) { RETURN_ARRAYS_INCREMENT(); int i; int n = size_count(k); dvariable nll=0; for(i = 1; i <= n; i++) { // nll -= k(i)*log(lambda(i))+lambda(i)+gammln(k(i)+1.); nll += -k(i)*log(lambda(i))+lambda(i)+gammln(k(i)+1.); } RETURN_ARRAYS_DECREMENT(); return nll; }
/* function: factrl(int n) * ------------------------ * Numerical Recipes p. 214 */ REAL_TYPE factrl(int n) { static int ntop=4; static REAL_TYPE a[33]={1.0,1.0,2.0,6.0,24.0}; int j; if(n<0) throw std::invalid_argument("negative factorial in routine factrl"); if(n>32) return std::exp(gammln(n+1.0)); while(ntop<n) { j=ntop++; a[ntop]=a[j]*ntop; } return a[n]; }
dvariable mult_likelihood(const dmatrix &o, const dvar_matrix &p, dvar_matrix &nu, const dvariable &log_vn) { // kludge to ensure observed and predicted matrixes are the same size if(o.colsize()!=p.colsize() || o.rowsize()!=p.rowsize()) { cerr<<"Error in multivariate_t_likelihood, observed and predicted matrixes" " are not the same size\n"; ad_exit(1); } dvariable vn = mfexp(log_vn); dvariable ff = 0.0; int r1 = o.rowmin(); int r2 = o.rowmax(); int c1 = o.colmin(); int c2 = o.colmax(); for(int i = r1; i <= r2; i++ ) { dvar_vector sobs = vn * o(i)/sum(o(i)); //scale observed numbers by effective sample size. ff -= gammln(vn); for(int j = c1; j <= c2; j++ ) { if( value(sobs(j)) > 0.0 ) ff += gammln(sobs(j)); } ff -= sobs * log(TINY + p(i)); dvar_vector o1=o(i)/sum(o(i)); dvar_vector p1=p(i)/sum(p(i)); nu(i) = elem_div(o1-p1,sqrt(elem_prod(p1,1.-p1)/vn)); } // exit(1); return ff; }
/* *---------------------------------------------------------------- * Returns as a floating point number an integer value that is * a random deviate drawn from a Poisson distribution of mean * "xm", using ran1(idum) as a source of uniform random deviates * Pg. 294 from the book *---------------------------------------------------------------- */ float poidev(float xm, int *idum) { /* oldm is a flag for whether "xm" has changed since last call */ static float sq, alxm, g, oldm=(-1); float em,t,y; float gammln(float xx); if(xm < 12.0){ if(xm != oldm){ oldm = xm; g = exp(-xm); } em = -1; t=1.0; do{ ++em; t *= ran1(idum); } while (t>g); } else{ if (xm != oldm){ oldm = xm; sq = sqrt(2.0*xm); alxm = log(xm); g = xm*alxm - gammln(xm+1.0); } do{ do{ y = tan(M_PI*ran1(idum)); em = sq * y + xm; } while( em < 0.0); em = floor(em); t = 0.9*(1.0+y*y)*exp(em*alxm-gammln(em+1.0)-g); } while( ran1(idum) > t); } return em; }