subroutine nongradopt(ndim,funkmin,f1dim,beta,
     &      bmin,bmax,ftol,fatbeta)
      implicit none
! This subroutine minimizes function funkmin to estimate ndim parameters
! using non-gradient based methods
!
      integer ndim
      double precision beta(1:ndim),bmin(1:ndim),
     &bmax(1:ndim),ftol,fatbeta,f1dim
!
! ------------------ Inputs -----------------------------
! ndim:  the total number of parameters to be estimated
! bmax:  the maximum possible value of beta, used to determine the distance scaling factor
! bmin:  the minimum possible value of beta, used to determine the distance scaling factor
! beta: initial guess, overwritten upon return
! ftol: tolerance for convergence
! fatbeta: the cost function valuate at beta, overwritten upon return 
! funkmin is the name of the subroutine that computes the cost function
! f1dim: the one dimensional cost function

! ------------------ Outputs ----------------------------
! beta:  The best parameters obtained
! fatbeta: the cost function value at beta

      integer n,nn,mpamoeba,npamoeba,iredo,maxredo,ITMAX,
     &   icycle
      parameter(maxredo=5,ITMAX=50000)
      double precision fbest,xbest(1:ndim),term,
     &    xinidir(1:ndim,1:ndim),xbest0(1:ndim),
     &    pamoeba(1:ndim+1,1:ndim),famoeba(1:ndim+1)
      external funkmin,f1dim
! End of declaration of variables
!---------------------------------------------------------------
      icycle=0
1     iredo=0
3     do n=1,ndim
        xbest(n)=beta(n)
        do nn=1,ndim
          xinidir(n,nn)=0.0d0
        enddo
        xinidir(n,n)=1.0d0
      enddo
      fbest=fatbeta
      call powell(beta,xinidir(1:ndim,1:ndim),ndim,ndim,
     &     ftol,fatbeta,bmin,bmax,funkmin,f1dim,ITMAX)
      if(fatbeta.gt.fbest)then
        do n=1,ndim
          beta(n)=xbest(n)
        enddo
        fatbeta=fbest
        goto 10
      endif
      if((fbest-fatbeta).gt.100.0d0*ftol)then
        if(iredo.gt.maxredo)goto 10
        iredo=iredo+1
        goto 3
      endif
10    iredo=0
20    do n=1,ndim
        xbest(n)=beta(n)
      enddo
      fbest=fatbeta
      do nn=1,ndim
        pamoeba(1,nn)=beta(nn)
      enddo
      famoeba(1)=fatbeta
      do n=2,ndim+1
        do nn=1,ndim
          pamoeba(n,nn)=beta(nn)
        enddo
        if((bmax(n-1)-pamoeba(n,n-1))
     &     .gt.(pamoeba(n,n-1)-bmin(n-1)))then
          pamoeba(n,n-1)=pamoeba(n,n-1)+
     &           (bmax(n-1)-pamoeba(n,n-1))*0.1d0
        else
          pamoeba(n,n-1)=pamoeba(n,n-1)-
     &           (pamoeba(n,n-1)-bmin(n-1))*0.1d0
        endif
        do nn=1,ndim
          xbest0(nn)=pamoeba(n,nn)
        enddo
        call funkmin(ndim,xbest0,famoeba(n))
      enddo
      mpamoeba=ndim+1
      npamoeba=ndim
      fatbeta=1.0d+100
      term=1.0d0
30    nn=ITMAX/20
      call amebsa(pamoeba(1:ndim+1,1:ndim),famoeba(1:ndim+1),
     &mpamoeba,npamoeba,ndim,beta,fatbeta,ftol,funkmin,nn,term)
      if(fatbeta.lt.fbest)then
        if((fbest-fatbeta).gt.ftol*100.0d0.and.term.gt.1.0d-2)then
          term=term/3.0d0
          fbest=fatbeta
          do n=1,ndim
            xbest(n)=beta(n)
          enddo
          goto 30
        endif
        do n=1,ndim
          xbest(n)=beta(n)
        enddo
        fbest=fatbeta
      else
        do n=1,ndim
          beta(n)=xbest(n)
        enddo
        fatbeta=fbest
      endif
      do nn=1,ndim
        pamoeba(1,nn)=beta(nn)
      enddo
      famoeba(1)=fatbeta
      do n=2,ndim+1
        do nn=1,ndim
          pamoeba(n,nn)=beta(nn)
        enddo
        if((bmax(n-1)-pamoeba(n,n-1))
     &     .gt.(pamoeba(n,n-1)-bmin(n-1)))then
          pamoeba(n,n-1)=pamoeba(n,n-1)+
     &           (bmax(n-1)-pamoeba(n,n-1))*0.1d0
        else
          pamoeba(n,n-1)=pamoeba(n,n-1)-
     &           (pamoeba(n,n-1)-bmin(n-1))*0.1d0
        endif
        do nn=1,ndim
          xbest0(nn)=pamoeba(n,nn)
        enddo
        call funkmin(ndim,xbest0,famoeba(n))
      enddo
      mpamoeba=ndim+1
      npamoeba=ndim
      call guamoeba(pamoeba(1:ndim+1,1:ndim),famoeba(1:ndim+1),
     &mpamoeba,npamoeba,ndim,ftol,funkmin,ITMAX/20)  
      nn=1
      do n=2,ndim+1
        if(famoeba(n).lt.famoeba(nn))nn=n
      enddo
      fatbeta=famoeba(nn)         
      do n=1,ndim
        beta(n)=pamoeba(nn,n)
        if(beta(n).lt.bmin(n).or.beta(n).gt.bmax(n))then
          do nn=1,ndim
            beta(nn)=xbest(nn)
          enddo
          fatbeta=fbest
          return
        endif
      enddo
      if((fbest-fatbeta).gt.ftol*100.0d0)then
        if(iredo.gt.maxredo)then
          if(icycle.lt.maxredo)then
            icycle=icycle+1
            goto 1
          else
            return
          endif
        endif
        iredo=iredo+1
        goto 20
      endif
      return
      end subroutine nongradopt
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
      SUBROUTINE guamoeba(p,y,mp,np,ndim,ftol,funkmin,ITMAX)
      implicit none
      INTEGER iter,mp,ndim,np,NMAX,ITMAX
      double precision ftol,p(mp,np),y(mp),TINY
      PARAMETER (TINY=1.0d-10)
      external funkmin
CU    USES guamotry,funkmin
      INTEGER i,ihi,ilo,inhi,j,m,n
      double precision rtol,cumx,swap,ysave,ytry,pcumx(ndim),
     &  guamotry,degen
      iter=0
1     do 12 n=1,ndim
        cumx=0.0d0
        do 11 m=1,ndim+1
          cumx=cumx+p(m,n)
11      continue
        pcumx(n)=cumx
12    continue
2     ilo=1
      if (y(1).gt.y(2)) then
        ihi=1
        inhi=2
      else
        ihi=2
        inhi=1
      endif
      do 13 i=1,ndim+1
        if(y(i).le.y(ilo)) ilo=i
        if(y(i).gt.y(ihi)) then
          inhi=ihi
          ihi=i
        else if(y(i).gt.y(inhi)) then
          if(i.ne.ihi) inhi=i
        endif
13    continue
      rtol=2.0d0*dabs(y(ihi)-y(ilo))/
     &     (dabs(y(ihi))+dabs(y(ilo))+TINY)
      if (rtol.lt.ftol) then
        swap=y(1)
        y(1)=y(ilo)
        y(ilo)=swap
        do 14 n=1,ndim
          swap=p(1,n)
          p(1,n)=p(ilo,n)
          p(ilo,n)=swap
14      continue
        return
      endif

! check to see if the simplex is degenerate; if so, stop
      degen=0.0d0
      do i=1,mp
        do m=i+1,mp
          do n=1,np
            if(dabs(p(m,n)-p(i,n)).gt.degen)then
              degen=dabs(p(m,n)-p(i,n))         
            endif
          enddo
        enddo
      enddo      
      if(degen.lt.ftol*ftol)then
        swap=y(1)
        y(1)=y(ilo)
        y(ilo)=swap
        do n=1,ndim
          swap=p(1,n)
          p(1,n)=p(ilo,n)
          p(ilo,n)=swap
        enddo
        return   
      endif
      if(iter.ge.ITMAX)return
      iter=iter+2
      ytry=guamotry(p,y,pcumx,mp,np,ndim,funkmin,ihi,-1.0d0)
      if (ytry.le.y(ilo))then
        ytry=guamotry(p,y,pcumx,mp,np,ndim,funkmin,ihi,2.0d0)
      else if (ytry.ge.y(inhi)) then
        ysave=y(ihi)
        ytry=guamotry(p,y,pcumx,mp,np,ndim,funkmin,ihi,0.5d0)
        if (ytry.ge.ysave) then
          do 16 i=1,ndim+1
            if(i.ne.ilo)then
              do 15 j=1,ndim
                pcumx(j)=0.5d0*(p(i,j)+p(ilo,j))
                p(i,j)=pcumx(j)
15            continue
              call funkmin(ndim,pcumx,y(i))
            endif
16        continue
          iter=iter+ndim
          goto 1
        endif
      else
        iter=iter-1
      endif
      goto 2
      END
C  (C) Copr. 1986-92 Numerical Recipes Software v%1jw#<0(9p#3.

      DOUBLE PRECISION FUNCTION guamotry(p,y,psum,
     &   mp,np,ndim,funkmin,ihi,fac)
      implicit none
      INTEGER ihi,mp,ndim,np
      double precision fac,p(mp,np),psum(np),y(mp)
      EXTERNAL funkmin
CU    USES funkmin
      INTEGER j
      double precision fac1,fac2,ytry,ptry(ndim)
      fac1=(1.0d0-fac)/dble(ndim)
      fac2=fac1-fac
      do 11 j=1,ndim
        ptry(j)=psum(j)*fac1-p(ihi,j)*fac2
11    continue
      call funkmin(ndim,ptry,ytry)
      if (ytry.lt.y(ihi)) then
        y(ihi)=ytry
        do 12 j=1,ndim
          psum(j)=psum(j)-p(ihi,j)+ptry(j)
          p(ihi,j)=ptry(j)
12      continue
      endif
      guamotry=ytry
      return
      END
C  (C) Copr. 1986-92 Numerical Recipes Software v%1jw#<0(9p#3.

c#######################################################################

      SUBROUTINE amebsa(p,y,mp,np,ndim,pb,yb,ftol,funkmin,iter,temptr)
      implicit none
      INTEGER iter,mp,ndim,np
      double precision ftol,temptr,yb,p(mp,np),pb(np),y(mp)
      EXTERNAL funkmin
CU    USES amotsa,funkmin,ran1
      INTEGER i,idum,ihi,ilo,inhi,j,m,n
      double precision rtol,sum,swap,tt,yhi,ylo,ynhi,ysave,yt,ytry,
     &psum(ndim),amotsa,ran1
      COMMON /ambsa/ tt,idum
      tt=-temptr
1     do 12 n=1,ndim
        sum=0.0d0
        do 11 m=1,ndim+1
          sum=sum+p(m,n)
11      continue
        psum(n)=sum
12    continue
2     ilo=1
      inhi=1
      ihi=2
      ylo=y(1)+tt*dlog(ran1(idum))
      ynhi=ylo
      yhi=y(2)+tt*dlog(ran1(idum))
      if (ylo.gt.yhi) then
        ihi=1
        inhi=2
        ilo=2
        ynhi=yhi
        yhi=ylo
        ylo=ynhi
      endif
      do 13 i=3,ndim+1
        yt=y(i)+tt*dlog(ran1(idum))
        if(yt.le.ylo) then
          ilo=i
          ylo=yt
        endif
        if(yt.gt.yhi) then
          inhi=ihi
          ynhi=yhi
          ihi=i
          yhi=yt
        else if(yt.gt.ynhi) then
          inhi=i
          ynhi=yt
        endif
13    continue
      rtol=2.0d0*dabs(yhi-ylo)/(dabs(yhi)+dabs(ylo))
      if(rtol.lt.ftol.or.iter.lt.0) then
        swap=y(1)
        y(1)=y(ilo)
        y(ilo)=swap
        do 14 n=1,ndim
          swap=p(1,n)
          p(1,n)=p(ilo,n)
          p(ilo,n)=swap
14      continue
        return
      endif
      iter=iter-2
      ytry=amotsa(p(1:mp,1:np),
     &y,psum,mp,np,ndim,pb,yb,funkmin,ihi,yhi,-1.0d0)
      if (ytry.le.ylo) then
        ytry=amotsa(p(1:mp,1:np),
     &y,psum,mp,np,ndim,pb,yb,funkmin,ihi,yhi,2.0d0)
      else if (ytry.ge.ynhi) then
        ysave=yhi
        ytry=amotsa(p(1:mp,1:np),
     &y,psum,mp,np,ndim,pb,yb,funkmin,ihi,yhi,0.5d0)
        if (ytry.ge.ysave) then
          do 16 i=1,ndim+1
            if(i.ne.ilo)then
              do 15 j=1,ndim
                psum(j)=0.5d0*(p(i,j)+p(ilo,j))
                p(i,j)=psum(j)
15            continue
              call funkmin(ndim,psum,y(i))
            endif
16        continue
          iter=iter-ndim
          goto 1
        endif
      else
        iter=iter+1
      endif
      goto 2
      END

      double precision FUNCTION amotsa
     &(p,y,psum,mp,np,ndim,pb,yb,funkmin,ihi,yhi,fac)
      implicit none
      INTEGER ihi,mp,ndim,np
      double precision fac,yb,yhi,p(mp,np),pb(np),psum(ndim),y(mp)
      EXTERNAL funkmin
CU    USES funkmin,ran1
      INTEGER idum,j
      double precision fac1,fac2,tt,yflu,ytry,ptry(ndim),ran1
      COMMON /ambsa/ tt,idum
      fac1=(1.0d0-fac)/dble(ndim)
      fac2=fac1-fac
      do 11 j=1,ndim
        ptry(j)=psum(j)*fac1-p(ihi,j)*fac2
11    continue
      call funkmin(ndim,ptry,ytry)
      if (ytry.le.yb) then
        do 12 j=1,ndim
          pb(j)=ptry(j)
12      continue
        yb=ytry
      endif
      yflu=ytry-tt*log(ran1(idum))
      if (yflu.lt.yhi) then
        y(ihi)=ytry
        yhi=yflu
        do 13 j=1,ndim
          psum(j)=psum(j)-p(ihi,j)+ptry(j)
          p(ihi,j)=ptry(j)
13      continue
      endif
      amotsa=yflu
      return
      END