Files
piscal/dataassim/math/numrec/f77_sources/poidev.for
T
2016-02-03 18:52:05 +00:00

36 lines
849 B
Fortran

FUNCTION poidev(xm,idum)
INTEGER idum
REAL poidev,xm,PI
PARAMETER (PI=3.141592654)
CU USES gammln,ran1
REAL alxm,em,g,oldm,sq,t,y,gammln,ran1
SAVE alxm,g,oldm,sq
DATA oldm /-1./
if (xm.lt.12.)then
if (xm.ne.oldm) then
oldm=xm
g=exp(-xm)
endif
em=-1
t=1.
2 em=em+1.
t=t*ran1(idum)
if (t.gt.g) goto 2
else
if (xm.ne.oldm) then
oldm=xm
sq=sqrt(2.*xm)
alxm=log(xm)
g=xm*alxm-gammln(xm+1.)
endif
1 y=tan(PI*ran1(idum))
em=sq*y+xm
if (em.lt.0.) goto 1
em=int(em)
t=0.9*(1.+y**2)*exp(em*alxm-gammln(em+1.)-g)
if (ran1(idum).gt.t) goto 1
endif
poidev=em
return
END