c program to illustrate the colored Gaussian Noise generator CGAUSS        
c The routine must be initialized with CGAUS0 and calls a flat distribution
c random number generator available with most compilers or you can write your
c own. Here we used the routine RAN1 from Numerical Recipes 2nd Edition, by
c Press, Teukolsky, Vetterling, and Flannery.

! It now uses the F90 intrinsic subroutine RANDOM_NUMBER.

c The White Guassian noise generator GASDEV from Numerical Recipes was 
c adapted to produce Colored Gaussian noise. The basic equations for this
c computation are presented in the article by 
c Fox et al., Physical Review A vol.38(1988) page 5938. 
c This code was [originally] compiled and tested with Microsoft Powerstation.

! It was modified by Walt Brainerd to be standard Fortran and
! compiled on NAGWare F90.

        real, allocatable :: eps(:,:)
        real smean
        double precision std,mean,cgauss,dt
        
c get input parameters (typical values shown)        
        open(1,file='cnoise.dat')
        read(1,*)nreal             !number of realizations=1000
        read(1,*)nstep             !max delay in corr. func=10
        read(1,*)dt                !time step size=.5
        read(1,*)cortim            !corr. time in the same units as DT=5
        allocate(eps(nreal,-1:nstep*2))
        
c initialize 
         call cgaus0(dt,cortim)              
        
c store several series of Gaussian noise values in array EPS.
        do i=1,nreal             !realizations
         do j=0,nstep*2          !time delays
          eps(i,j)=cgauss()
         enddo
        enddo

c calculate the autocorrelation function in variable MEAN.        
        npts=nstep*nreal
        do idly=0,nstep
         mean=0.
         std=0.
         do i=1,nreal
           do j=0,nstep
            mean=mean+dble(eps(i,j)*eps(i,j+idly))
           enddo
         enddo
         mean=mean/dble(npts)
         smean=sngl(mean)          !single precision speeds up calculations

c calculate the error in autocorrelation function in variable STD.        
         do i=1,nreal
           do j=0,nstep
            std=std+dble((eps(i,j)*eps(i,j+idly)-smean)**2.)
           enddo
         enddo
         std=sqrt(std)/dble(npts-1.)
         write(1,*)idly,mean,std            !output results
        enddo

        close(1)
        deallocate(eps)
        end

c==========================================================================
c initialize the RNG's        
c and set the color of gaussian noise
c DT is the time step used in whatever process the colored Gaussian noise
c   is used.
c CORTIM is correlation time in the same units as time step DT.
c WHITE=.true. means generate white gaussian noise which happens when
c   CORTIM=0. This flag is used in CGAUSS.
c Here we use the flat distribution RAN1 also taken from Numerical Recipe
c but any other good flat distribution random number generator will do.

        subroutine cgaus0(dt,cortim)
!        double precision ran1,cape,dt,l1me2,cgauss
        double precision cape,dt,l1me2,cgauss
        real cortim,x
        logical white
        common /color/l1me2,cape,white
        if(cortim.eq.0.)then
         white=.true.
         l1me2=-2.000                        !white noise
         cape=0.0
        else
         white=.false.
         cape=dexp(-dt/dble(cortim))
         !parameter needed in CGAUSS
         l1me2=-(dble(1.)-cape*cape)*dble(2./cortim)
        endif
!        idum=-1
!        x=ran1(idum)            !initialize flat rng
        x=cgauss()            !initialize CGAUSS value
      return
      END

c==========================================================================
c Program to produce exponentially correlated colored (Gaussian) noise.
c based on Fox et al Physical Review A vol.38(1988)5938 and 
c modification of GASDEV from Numerical Recipes for Fortran(2nd ed.pg279)

c CAPE is capital E in the article by Fox et. al.
c PREV is the previous value of CGAUSS used in the next iteration
c L1ME2 is the main parameters causing colored noise in Fox et al
c       and represents (lamda*(1-E)^2). Ditto for H in that article.

c routine is illustrated in Double Precision in case it is needed in this
c mode, otherwise all Double Precision variables maybe changed to REAL
c but the corresponding changes must be made to CGAUS0 and the calling
c programs.


      double precision FUNCTION cgauss()
!      INTEGER idum,iset
      INTEGER iset
      logical white
!      double precision  fac,gset,rsq,v1,v2,ran1,l1me2,h,cape
      double precision  fac,gset,rsq,v1,v2,l1me2,h,cape
      common /color/l1me2,cape,white
      
      SAVE iset,gset,prev
      DATA iset/0/
      DATA prev/0.0d0/

      if (iset.eq.0) then
!1       v1=2.*ran1(idum)-1.
1       call random_number(v1)
        v1=2.*v1-1
!        v2=2.*ran1(idum)-1.
        call random_number(v2)
        v2=2.*v2-1
        rsq=v1**2.+v2**2.
        if(rsq.ge.1..or.rsq.eq.0.)goto 1
        !took out sqrt(2) vs eq(28) Fox etal
        fac=dsqrt(l1me2*dlog(rsq)/rsq)
        gset=v1*fac
        h=v2*fac
        iset=1
      else
        h=gset
        iset=0
      endif
      
      if(white)then  !please note that the time step vs its sqrt
       cgauss=h      !in integration is previously set in PARAM
      else
       cgauss=prev*cape+h
       prev=cgauss
      endif
      
      return
      END