Initial commit

2016-02-03 18:52:05 +00:00
commit d40505e161
507 changed files with 91383 additions and 0 deletions
@@ -0,0 +1,109 @@
+!      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