subroutine RepeatCompassSearch(ndim,xbest,fbest,
     &  bmin,bmax,funkmin,f1dim,xtol)
      implicit none
      integer ndim
      double precision xbest(1:ndim),fbest,
     &   bmin(1:ndim),bmax(1:ndim),xtol,f1dim
      double precision fvalpre,dmax,xpre(1:ndim),ftol,direction(ndim)
      integer i,n
      logical resetran2
      common /ran2reset/resetran2
      external funkmin,f1dim
!
      ftol=xtol
      n=0
      resetran2=.true.
10    fvalpre=fbest
      do i=1,ndim
        xpre(i)=xbest(i)
      enddo
      call CompassSearch(ndim,xbest,fbest,
     &  bmin,bmax,funkmin,f1dim,xtol)
      n=n+1
      dmax=dabs(xbest(1)-xpre(1))
      do i=2,ndim
        if(dmax.lt.dabs(xbest(i)-xpre(i)))then
          dmax=dabs(xbest(i)-xpre(i))
        endif
      enddo
      if(dabs(fvalpre-fbest).gt.ftol.and.
     &   dmax.gt.xtol.and.n.lt.2)then
        do i=1,ndim
          direction(i)=xbest(i)-xpre(i)
        enddo
        call linmin(xbest,bmin,bmax,direction,
     &                ndim,f1dim,fbest)
        goto 10
      endif
      return
      end subroutine RepeatCompassSearch

      subroutine CompassSearch(ndim,xbest,fbest,
     &  bmin,bmax,funkmin,f1dim,xtol)
      implicit none

! This subroutine minimizes the function funkmin using the compass search method. The ! maximum number of function evaluations is maxiter. Once mexiter is reached, all 
! function evaluations are ranked and returned.
!
!------------------------------------- Inputs -----------------------------------------------------
! maxiter: the maximum number of function evaluations allowed
! xbest: the initial guess
! fbest: the cost function value at xinitial
! bmin: the lower bounds of the parameters to be optimized
! bmax: the upper bounds of the parameters to be optimized
! ndim: the number of parameters to optimize
! funkmin: the name of the function to minimize

!------------------------------------- Outputs ---------------------------------------------------
! xobs: points where the function is evaluated. Ranked from the best to worst with the 
! first point being the best point.
! fvalue: the function values at xobs
! ierr: =0 convergence criterion not reached
!       =1 convergence criterion reached (minimum found)
!        
      integer ndim
      double precision xbest(1:ndim),fbest,f1dim,
     &   bmin(1:ndim),bmax(1:ndim),xtol,dx1,dx2
      external funkmin,f1dim
!------------------------------- Locals -----------------------------------------------------------
      double precision diftol,delta,
     &  xcompass(1:2*ndim,1:ndim),fcompass(1:2*ndim),
     &  xvec(1:ndim),xcent(1:ndim),fcent,dif,shrink,
     &  direction(ndim),dmax,fcent0,ran2_reset,ran2
      integer i,j,k,iter
      parameter(shrink=0.95d0)      
!
      diftol=xtol
      delta=0.95d0
      do i=1,ndim
        xcent(i)=xbest(i)
      enddo
      fcent=fbest
      iter=0
10    continue
      do i=1,ndim
        do j=1,ndim
          xcompass(i,j)=xcent(j)
          xcompass(ndim+i,j)=xcent(j)
        enddo
        xcompass(i,i)=xcent(i)+delta*(bmax(i)-xcent(i))
        xcompass(ndim+i,i)=xcent(i)+delta*(bmin(i)-xcent(i))
      enddo
      do i=1,2*ndim
        do j=1,ndim
          xvec(j)=xcompass(i,j)
        enddo
        call funkmin(ndim,xvec,fcompass(i))
        if(dabs(fcompass(i)).gt.1.0d+90)then
          delta=delta*shrink
          if(delta.lt.diftol)goto 100
          goto 10
        endif
      enddo
      do i=1,ndim
        xbest(i)=xcompass(1,i)
      enddo
      fbest=fcompass(1)
      do i=2,2*ndim
        if(fcompass(i).lt.fbest)then
          fbest=fcompass(i)
          do j=1,ndim
            xbest(j)=xcompass(i,j)
          enddo
        endif
      enddo
      fcent0=fcent
      do i=1,ndim
        xvec(i)=xcent(i)
      enddo
      do i=1,ndim
        dx1=xcompass(i,i)-xcent(i)
        dx2=xcent(i)-xcompass(i+ndim,i)
        direction(i)=0.0d0
        if(dx1.ne.0.0d0)then
          direction(i)=(fcompass(i)-fcent)/dx1
        endif
        if(dx2.ne.0.0d0)then
          direction(i)=direction(i)+
     &      (fcent-fcompass(i+ndim))/dx2
        endif
        direction(i)=-0.5d0*direction(i)
        if(direction(i).eq.0.0d0)direction(i)=
     &    ran2_reset()-0.5d0
      enddo
      call linmin(xcent,bmin,bmax,direction,
     &                ndim,f1dim,fcent)
      if(fcent.gt.fcent0)then
        fcent=fcent0
        do i=1,ndim
          xcent(i)=xvec(i)
        enddo
      endif
      dif=fcent-fbest
      if(fbest.le.fcent)then
        fcent=fbest
        do i=1,ndim
          xcent(i)=xbest(i)
        enddo
      endif
      if(dif.ge.0.0d0)then
        if(dif.gt.diftol)then
          if(iter.lt.150)then
            iter=iter+1
            goto 10
          else
            iter=0
          endif
        endif
        if(delta.lt.diftol)goto 100
        delta=delta*shrink
        goto 10
      else
!no progress
        if(dabs(dif).gt.diftol)then
          if(delta.lt.diftol)goto 100
          delta=delta*shrink
          goto 10
        endif
        dmax=dabs(xcompass(1,1)-xcompass(ndim+1,1))
        do i=2,ndim
          if(dmax.lt.dabs(xcompass(i,i)-
     &       xcompass(ndim+i,i)))then
             dmax=dabs(xcompass(i,i)-
     &       xcompass(ndim+i,i))
          endif
        enddo
        if(dmax.gt.xtol)then
          if(delta.lt.diftol)goto 100
          delta=delta*shrink
          goto 10
        else
          goto 100
        endif
      endif
100   fbest=fcent
      do i=1,ndim
        xbest(i)=xcent(i)
        dx1=xcompass(i,i)-xcent(i)
        dx2=xcent(i)-xcompass(i+ndim,i)
        direction(i)=0.0d0
        if(dx1.ne.0.0d0)then
          direction(i)=(fcompass(i)-fcent)/dx1
        endif
        if(dx2.ne.0.0d0)then
          direction(i)=direction(i)+
     &                 (fcent-fcompass(i+ndim))/dx2
        endif
        direction(i)=-0.5d0*direction(i)
        if(direction(i).eq.0.0d0)direction(i)=
     &    ran2_reset()-0.5d0
      enddo
      call linmin(xcent,bmin,bmax,direction,
     &                ndim,f1dim,fcent)
      if(fcent.lt.fbest)then
        fbest=fcent
        do i=1,ndim
          xbest(i)=xcent(i)
        enddo
      endif
      return
      end subroutine CompassSearch