program cosexpdev implicit none integer :: i,Nhit,Nmiss double precision :: u,x,y ! Variables for collecting statistics integer, parameter :: N=1000000; integer, parameter :: NSTAT=2000; integer :: if,fstat(0:NSTAT) double precision :: dx double precision, external :: grnd call sgrnd(4324367) do if=0,NSTAT fstat(if)=0 enddo dx=0.1; Nhit=0; Nmiss=0; do i=1,N ! Generate 10000 cos-exponential deviates ! using the combined analytical-rejection method ! 1° Generate uniform number > 0 do u=grnd(); if (u>0.0d0) exit enddo ! 2° Generate number distributed as g(x) i.e. e^-x x=-log(u) ! 3° Generate a uniform number between 0 and e^-x y=grnd()*exp(-x) if (y < cos(x)**2*exp(-x)) then ! Hit, collect statistics of x ! nint returns nearest integer if=nint(x/dx) if (if > +NSTAT) if=+NSTAT fstat(if)=fstat(if)+1 Nhit=Nhit+1 else ! Calculate number of misses Nmiss=Nmiss+1 endif enddo ! Print statistics open(10,file="cosexpstat") ! Point 0 only has half interval, hence multiply by 2! write(10,*) 0,2.0*fstat(0)/dx/N,fstat(0) do if=1,NSTAT write(10,*) if*dx,1.0*fstat(if)/dx/N,fstat(if) enddo close(10) ! Also make analytical function for comparison open(10,file="cosexpanalytical") do if=0,NSTAT x=if*dx write(10,*) x,cos(x)**2*exp(-x) enddo close(10) print *,'Hits ',Nhit,' Misses ',Nmiss,' fraction ',1.0d0*Nhit/Nmiss end program cosexpdev !************************************************************************ ! Mersenne twister random number generator !************************************************************************ subroutine sgrnd(seed) ! implicit integer(a-z) ! ! Period parameters parameter(N = 624) ! dimension mt(0:N-1) ! the array for the state particle common /block/mti,mt save /block/ ! ! setting initial seeds to mt[N] using ! the generator Line 25 of Table 1 in ! [KNUTH 1981, The Art of Computer Programming ! Vol. 2 (2nd Ed.), pp102] ! mt(0)= iand(seed,-1) do 1000 mti=1,N-1 mt(mti) = iand(69069 * mt(mti-1),-1) 1000 continue ! return end !************************************************************************ double precision function grnd() ! implicit integer(a-z) ! ! Period parameters parameter(N = 624) parameter(N1 = N+1) parameter(M = 397) parameter(MATA = -1727483681) ! constant vector a parameter(UMASK = -2147483648) ! most significant w-r bits parameter(LMASK = 2147483647) ! least significant r bits ! Tempering parameters parameter(TMASKB= -1658038656) parameter(TMASKC= -272236544) ! dimension mt(0:N-1) ! the array for the state vector common /block/mti,mt save /block/ data mti/N1/ ! mti==N+1 means mt[N] is not initialized ! dimension mag01(0:1) data mag01/0, MATA/ save mag01 ! mag01(x) = x * MATA for x=0,1 ! TSHFTU(y)=ishft(y,-11) TSHFTS(y)=ishft(y,7) TSHFTT(y)=ishft(y,15) TSHFTL(y)=ishft(y,-18) ! if(mti.ge.N) then ! generate N words at one time if(mti.eq.N+1) then ! if sgrnd() has not been called, call sgrnd(4357) ! a default initial seed is used endif ! do 1000 kk=0,N-M-1 y=ior(iand(mt(kk),UMASK),iand(mt(kk+1),LMASK)) mt(kk)=ieor(ieor(mt(kk+M),ishft(y,-1)),mag01(iand(y,1))) 1000 continue do 1100 kk=N-M,N-2 y=ior(iand(mt(kk),UMASK),iand(mt(kk+1),LMASK)) mt(kk)=ieor(ieor(mt(kk+(M-N)),ishft(y,-1)),mag01(iand(y,1))) 1100 continue y=ior(iand(mt(N-1),UMASK),iand(mt(0),LMASK)) mt(N-1)=ieor(ieor(mt(M-1),ishft(y,-1)),mag01(iand(y,1))) mti = 0 endif ! y=mt(mti) mti=mti+1 y=ieor(y,TSHFTU(y)) y=ieor(y,iand(TSHFTS(y),TMASKB)) y=ieor(y,iand(TSHFTT(y),TMASKC)) y=ieor(y,TSHFTL(y)) ! if(y.lt.0) then grnd=(dble(y)+2.0d0**32)/(2.0d0**32-1.0d0) else grnd=dble(y)/(2.0d0**32-1.0d0) endif ! return end