47 lines
1.2 KiB
Fortran
47 lines
1.2 KiB
Fortran
SUBROUTINE powell(p,xi,n,np,ftol,iter,fret)
|
|
INTEGER iter,n,np,NMAX,ITMAX
|
|
REAL fret,ftol,p(np),xi(np,np),func
|
|
EXTERNAL func
|
|
PARAMETER (NMAX=20,ITMAX=200)
|
|
CU USES func,linmin
|
|
INTEGER i,ibig,j
|
|
REAL del,fp,fptt,t,pt(NMAX),ptt(NMAX),xit(NMAX)
|
|
fret=func(p)
|
|
do 11 j=1,n
|
|
pt(j)=p(j)
|
|
11 continue
|
|
iter=0
|
|
1 iter=iter+1
|
|
fp=fret
|
|
ibig=0
|
|
del=0.
|
|
do 13 i=1,n
|
|
do 12 j=1,n
|
|
xit(j)=xi(j,i)
|
|
12 continue
|
|
fptt=fret
|
|
call linmin(p,xit,n,fret)
|
|
if(abs(fptt-fret).gt.del)then
|
|
del=abs(fptt-fret)
|
|
ibig=i
|
|
endif
|
|
13 continue
|
|
if(2.*abs(fp-fret).le.ftol*(abs(fp)+abs(fret)))return
|
|
if(iter.eq.ITMAX) pause 'powell exceeding maximum iterations'
|
|
do 14 j=1,n
|
|
ptt(j)=2.*p(j)-pt(j)
|
|
xit(j)=p(j)-pt(j)
|
|
pt(j)=p(j)
|
|
14 continue
|
|
fptt=func(ptt)
|
|
if(fptt.ge.fp)goto 1
|
|
t=2.*(fp-2.*fret+fptt)*(fp-fret-del)**2-del*(fp-fptt)**2
|
|
if(t.ge.0.)goto 1
|
|
call linmin(p,xit,n,fret)
|
|
do 15 j=1,n
|
|
xi(j,ibig)=xi(j,n)
|
|
xi(j,n)=xit(j)
|
|
15 continue
|
|
goto 1
|
|
END
|