SUBROUTINE cppowell(p,xi,n,np,ftol,fret,pmin,pmax,
     &   funkmin,f1dim,ITMAX)
! fret must be given on entry
      implicit none
      INTEGER iter,n,np,NMAX,ITMAX
      double precision fret,ftol,p(np),xi(np,np),TINY,
     &        pmin(np),pmax(np),f1dim
      PARAMETER (NMAX=1000,TINY=1.0d-25)
CU    USES funkmin,linmin
      INTEGER i,ibig,j
      double precision del,fp,fptt,t,pt(NMAX),
     &    ptt(NMAX),xit(NMAX)
      external funkmin,f1dim           
      do 11 j=1,n
        pt(j)=p(j)
11    continue
      iter=0
1     iter=iter+1
      fp=fret
      ibig=0
      del=0.0d0
      do 13 i=1,n
        do 12 j=1,n
          xit(j)=xi(j,i)
12      continue
        fptt=fret
        call cplinmin(p,pmin,pmax,xit,n,f1dim,fret)
        if(fptt-fret.gt.del)then
          del=fptt-fret
          ibig=i
        endif
13    continue
      if(2.0d0*(fp-fret).le.ftol*(dabs(fp)+dabs(fret))+TINY)return
      if(iter.eq.ITMAX)then
!        write(*,*)'powell exceeding maximum iterations'
        return
      endif
      do 14 j=1,n
        ptt(j)=2.0d0*p(j)-pt(j)
        xit(j)=p(j)-pt(j)
        pt(j)=p(j)
14    continue
      call funkmin(n,ptt,fptt)
      if(fptt.ge.fp)goto 1
      t=2.0d0*(fp-2.0d0*fret+fptt)*(fp-fret-del)**2-
     &    del*(fp-fptt)**2
      if(t.ge.0.0d0)goto 1      
      call cplinmin(p,pmin,pmax,xit,n,f1dim,fret)
      do 15 j=1,n
        xi(j,ibig)=xi(j,n)
        xi(j,n)=xit(j)
15    continue
      goto 1
      END
C  (C) Copr. 1986-92 Numerical Recipes Software v%1jw#<0(9p#3.

      SUBROUTINE cplinmin(p,pmin,pmax,xi,n,f1dim,fret)
      implicit none
      INTEGER n
      double precision fret,p(n),xi(n),TOL,pmin(n),pmax(n),f1dim
      PARAMETER (TOL=1.0d-8)
CU    USES brent,f1dim,mnbrak
      INTEGER j,k,ierr
      double precision ax,bx,fa,fb,fx,xmin,xx,cpbrent,xxmin,xxmax
!((((((((((((((((((((((((((((((((((((((((((((((((((((
      integer NMAX,ncom
      parameter(NMAX=1000)
      double precision pcom(NMAX),xicom(NMAX)
      COMMON /cpf1com/ pcom,xicom,ncom
      save /cpf1com/
!))))))))))))))))))))))))))))))))))))))))))))))))))))
      EXTERNAL f1dim
      ncom=n
      do j=1,n
        pcom(j)=p(j)
        xicom(j)=xi(j)
      enddo
      xxmax=1.0d+100
      xxmin=-1.0d+100
      do j=1,n
        if(xicom(j).gt.1.0d-100)then
!        if(xicom(j).gt.0.0d0)then
          xx=(pmax(j)-pcom(j))/xicom(j)
          ax=(pmin(j)-pcom(j))/xicom(j)
        else
          if(xicom(j).lt.(-1.0d-100))then
!          if(xicom(j).lt.0.0d0)then
            ax=(pmax(j)-pcom(j))/xicom(j)
            xx=(pmin(j)-pcom(j))/xicom(j)
          else
            xx=1.0d+100
            ax=-1.0d+100
          endif
        endif
        if(xxmax.gt.xx)then
          xxmax=xx
        endif
        if(xxmin.lt.ax)then
          xxmin=ax
        endif
      enddo
      ax=0.0d0
      if(dabs(xxmax).gt.dabs(xxmin))then
        xx=0.25d0*xxmax
      else
        xx=0.25d0*xxmin  
      endif
      call cpmnbrak(ax,xx,bx,fa,fx,fb,
     &   xxmin,xxmax,ierr,f1dim)
      if(ierr.eq.0)then
        fret=cpbrent(ax,xx,bx,f1dim,TOL,xmin)
      else
        xmin=xx
        fret=fx
      endif
      do 12 j=1,n
        xi(j)=xmin*xi(j)
        p(j)=p(j)+xi(j)
12    continue
      return
      END
C  (C) Copr. 1986-92 Numerical Recipes Software v%1jw#<0(9p#3.
!
      double precision function cpbrent(ax,bx,cx,f,tol,xmin)
      implicit none
      INTEGER ITMAX
      double precision ax,bx,cx,tol,xmin,f,CGOLD,ZEPS
      EXTERNAL f
      PARAMETER (ITMAX=10000,CGOLD=.381966d0,ZEPS=1.0d-10)
      INTEGER iter
      double precision a,b,d,e,etemp,fu,fv,fw,fx,p,q,r,tol1,
     &    tol2,u,v,w,x,xm
      a=dmin1(ax,cx)
      b=dmax1(ax,cx)
      v=bx
      w=v
      x=v
      e=0.0d0
      fx=f(x)
      fv=fx
      fw=fx
      do 11 iter=1,ITMAX
        xm=0.5d0*(a+b)
        tol1=tol*dabs(x)+ZEPS
        tol2=2.0d0*tol1
        if(dabs(x-xm).le.(tol2-.5d0*(b-a))) goto 3
        if(dabs(e).gt.tol1) then
          r=(x-w)*(fx-fv)
          q=(x-v)*(fx-fw)
          p=(x-v)*q-(x-w)*r
          q=2.0d0*(q-r)
          if(q.gt.0.0d0) p=-p
          q=dabs(q)
          etemp=e
          e=d
          if(dabs(p).ge.dabs(.5d0*q*etemp).or.
     &       p.le.q*(a-x).or.p.ge.q*(b-x))goto 1
          d=p/q
          u=x+d
          if(u-a.lt.tol2.or.b-u.lt.tol2)d=dsign(tol1,xm-x)
          goto 2
        endif
1       if(x.ge.xm)then
          e=a-x
        else
          e=b-x
        endif
        d=CGOLD*e
2       if(dabs(d).ge.tol1) then
          u=x+d
        else
          u=x+dsign(tol1,d)
        endif
        fu=f(u)
        if(fu.le.fx)then
          if(u.ge.x)then
            a=x
          else
            b=x
          endif
          v=w
          fv=fw
          w=x
          fw=fx
          x=u
          fx=fu
        else
          if(u.lt.x) then
            a=u
          else
            b=u
          endif
          if(fu.le.fw.or.w.eq.x)then
            v=w
            fv=fw
            w=u
            fw=fu
          else if(fu.le.fv.or.v.eq.x.or.v.eq.w)then
            v=u
            fv=fu
          endif
        endif
11    continue
!      write(*,*) 'brent exceed maximum iterations'
3     xmin=x
      cpbrent=fx
      return
      END
C  (C) Copr. 1986-92 Numerical Recipes Software v%1jw#<0(9p#3.
                                                   
!      double precision function f1dim(x)
!      implicit none
!      double precision x
!CU    USES funkmin
!      INTEGER j
!((((((((((((((((((((((((((((((((((((((((((((((((((((
!      integer NMAX,ncom
!      parameter(NMAX=1000)
!      double precision pcom(NMAX),xicom(NMAX)
!      COMMON /cpf1com/ pcom,xicom,ncom
!      save /cpf1com/
!))))))))))))))))))))))))))))))))))))))))))))))))))))
!      double precision xt(NMAX)
!      do 11 j=1,ncom
!        xt(j)=pcom(j)+x*xicom(j)
!11    continue
!      call funkmin(ncom,xt,f1dim)
!      return
!      END
!C  (C) Copr. 1986-92 Numerical Recipes Software v%1jw#<0(9p#3.

      SUBROUTINE cpmnbrak(ax,bx,cx,fa,fb,fc,xxmin,xxmax,
     &                  ierr,func)
      implicit none
      double precision ax,bx,cx,fa,fb,fc,
     &   func,GOLD,GLIMIT,TINY
      EXTERNAL func
      PARAMETER(GOLD=1.618034d0,GLIMIT=100.0d0,TINY=1.0d-20)
      double precision dum,fu,q,r,u,ulim,xxmin,xxmax
      integer ierr
      ierr=0
      fa=func(ax)
      fb=func(bx)
      if(fb.gt.fa)then
        dum=ax
        ax=bx
        bx=dum
        dum=fb
        fb=fa
        fa=dum
      endif
      if(fa.eq.fb)then
        cx=(bx+ax)/2.0d0
        fc=func(cx)
        if(fc.le.fa)return
      endif
      cx=bx+GOLD*(bx-ax)
      if(cx.le.xxmin)then
        cx=0.5d0*(dmin1(ax,bx)+xxmin)
      endif
      if(cx.ge.xxmax)then
        cx=0.5d0*(dmax1(ax,bx)+xxmax)
      endif      
      fc=func(cx)
      
1     if(fb.ge.fc)then
        r=(bx-ax)*(fb-fc)
        q=(bx-cx)*(fb-fa)
        u=bx-((bx-cx)*q-(bx-ax)*r)/
     &    (2.0d0*dsign(dmax1(dabs(q-r),TINY),q-r))
        ulim=bx+GLIMIT*(cx-bx)
        if(ulim.ge.xxmax)then
          ulim=xxmax-tiny
        endif
        if(ulim.le.xxmin)then
          ulim=xxmin+tiny
        endif
        if((bx-u)*(u-cx).gt.0.0d0)then
          fu=func(u)
          if(fu.lt.fc)then
            ax=bx
            fa=fb
            bx=u
            fb=fu
            return
          elseif(fu.gt.fb)then
            cx=u
            fc=fu
            return
          endif
          u=cx+GOLD*(cx-bx)
          if(u.gt.xxmax)then
            u=cx+0.5d0*(xxmax-cx)
          endif
          if(u.lt.xxmin)then
            u=cx+0.5d0*(xxmin-cx)
          endif
          fu=func(u)
        elseif((cx-u)*(u-ulim).gt.0.0d0)then
          fu=func(u)
          if(fu.lt.fc)then
            bx=cx
            cx=u
            u=cx+GOLD*(cx-bx)
            if(u.gt.xxmax)then
              u=cx+0.5d0*(xxmax-cx)
            endif
            if(u.lt.xxmin)then
              u=cx+0.5d0*(xxmin-cx)
            endif
            fb=fc
            fc=fu
            fu=func(u)
          endif
        else if((u-ulim)*(ulim-cx).ge.0.0d0)then
          u=ulim
          fu=func(u)
        else
          u=cx+GOLD*(cx-bx)
          if(u.gt.xxmax)then
            u=cx+0.5d0*(xxmax-cx)
          endif
          if(u.lt.xxmin)then
            u=cx+0.5d0*(xxmin-cx)
          endif
          fu=func(u)
        endif
        ax=bx
        bx=cx
        cx=u
        fa=fb
        fb=fc
        fc=fu
        r=dmin1(dabs(ax-bx),dabs(ax-cx))
        r=dmin1(r,dabs(bx-cx))
        if(r.lt.tiny)then
! bracketing failed
          ierr=1
          return
        endif
        goto 1
      endif
      return
      END
C  (C) Copr. 1986-92 Numerical Recipes Software v%1jw#<0(9p#3.