109 lines
2.9 KiB
FortranFixed
109 lines
2.9 KiB
FortranFixed
! program main
|
|
! implicit none
|
|
! double precision gasdev2,x(2000),std1,fmean1,
|
|
! & std2,fmean2,gasdev
|
|
! integer idum,i,n
|
|
! idum=-1
|
|
! do i=5,2000
|
|
! do n=1,i
|
|
! x(n)=gasdev2()
|
|
! enddo
|
|
! call stdmean(i,x,std1,fmean1)
|
|
! do n=1,i
|
|
! x(n)=gasdev(idum)
|
|
! enddo
|
|
! call stdmean(i,x,std2,fmean2)
|
|
! write(2,310)i,std1,fmean1,std2,fmean2
|
|
! enddo
|
|
!310 format(1x,i8,4f15.10)
|
|
! end
|
|
!
|
|
double precision function gasdev2()
|
|
implicit none
|
|
!
|
|
! Return a normally distributed deviate with zero mean and unit variance,
|
|
!
|
|
integer iset
|
|
double precision fac,gset,rsq,v1,v2,ran2
|
|
save iset,gset
|
|
data iset/0/
|
|
|
|
if(iset.eq.0)then
|
|
1 v1=2.0d0*ran2()-1.0d0
|
|
v2=2.0d0*ran2()-1.0d0
|
|
rsq=v1*v1+v2*v2
|
|
if(rsq.ge.1.0d0.or.rsq.eq.0.0d0)goto 1
|
|
fac=dsqrt(-2.0d0*dlog(rsq)/rsq)
|
|
gset=v1*fac
|
|
gasdev2=v2*fac
|
|
iset=1
|
|
else
|
|
gasdev2=gset
|
|
iset=0
|
|
endif
|
|
return
|
|
end
|
|
|
|
double precision function gasdev(idum)
|
|
implicit none
|
|
integer idum
|
|
!
|
|
! Return a normally distributed deviate with zero mean and unit variance,
|
|
! using ran1(idum) as the source of uniform deviates
|
|
integer iset
|
|
double precision fac,gset,rsq,v1,v2,ran1
|
|
save iset,gset
|
|
data iset/0/
|
|
if(idum.lt.0)iset=0
|
|
if(iset.eq.0)then
|
|
1 v1=2.0d0*ran1(idum)-1.0d0
|
|
v2=2.0d0*ran1(idum)-1.0d0
|
|
rsq=v1*v1+v2*v2
|
|
if(rsq.ge.1.0d0.or.rsq.eq.0.0d0)goto 1
|
|
fac=dsqrt(-2.0d0*dlog(rsq)/rsq)
|
|
gset=v1*fac
|
|
gasdev=v2*fac
|
|
iset=1
|
|
else
|
|
gasdev=gset
|
|
iset=0
|
|
endif
|
|
return
|
|
end
|
|
|
|
double precision function ran1(idum)
|
|
implicit none
|
|
integer idum,IA,IM,IQ,IR,NTAB,NDIV
|
|
double precision AM,EPS,RNMX
|
|
PARAMETER(IA=16807,IM=2147483647,AM=1.0d0/IM,IQ=127773,
|
|
& IR=2836,NTAB=32,NDIV=1+(IM-1)/NTAB,EPS=1.2d-15,
|
|
& RNMX=1.0d0-EPS)
|
|
!
|
|
! Minimal random number generator of Park and Miller with Bays-Durham shuffle and
|
|
! added safegaurds. Return a uniform random deviate between 0.0 and 1.0, exclusive
|
|
! of the endpoint values. Call with idum a negative integer to initilize;
|
|
! thereafter, do not alter idum between successive deviates in a sequence. RNMX
|
|
! should approximate the largest floating value that is less than 1.
|
|
!
|
|
integer j,k,iv(NTAB),iy
|
|
save iv,iy
|
|
data iv /NTAB*0/,iy /0/
|
|
if(idum.le.0.or.iy.eq.0)then
|
|
idum=max(-idum,1)
|
|
do j=NTAB+8,1,-1
|
|
k=idum/IQ
|
|
idum=IA*(idum-k*IQ)-IR*k
|
|
if(idum.lt.0)idum=idum+IM
|
|
if(j.le.NTAB)iv(j)=idum
|
|
enddo
|
|
iy=iv(1)
|
|
endif
|
|
k=idum/IQ
|
|
idum=IA*(idum-k*IQ)-IR*k
|
|
if(idum.lt.0)idum=idum+IM
|
|
j=1+iy/NDIV
|
|
iy=iv(j)
|
|
iv(j)=idum
|
|
ran1=dmin1(AM*iy,RNMX)
|
|
return
|
|
end |