111 lines
2.5 KiB
Fortran
111 lines
2.5 KiB
Fortran
FUNCTION dbrent(ax,bx,cx,f,df,tol,xmin)
|
|
INTEGER ITMAX
|
|
REAL dbrent,ax,bx,cx,tol,xmin,df,f,ZEPS
|
|
EXTERNAL df,f
|
|
PARAMETER (ITMAX=100,ZEPS=1.0e-10)
|
|
INTEGER iter
|
|
REAL a,b,d,d1,d2,du,dv,dw,dx,e,fu,fv,fw,fx,olde,tol1,tol2,u,u1,u2,
|
|
*v,w,x,xm
|
|
LOGICAL ok1,ok2
|
|
a=min(ax,cx)
|
|
b=max(ax,cx)
|
|
v=bx
|
|
w=v
|
|
x=v
|
|
e=0.
|
|
fx=f(x)
|
|
fv=fx
|
|
fw=fx
|
|
dx=df(x)
|
|
dv=dx
|
|
dw=dx
|
|
do 11 iter=1,ITMAX
|
|
xm=0.5*(a+b)
|
|
tol1=tol*abs(x)+ZEPS
|
|
tol2=2.*tol1
|
|
if(abs(x-xm).le.(tol2-.5*(b-a))) goto 3
|
|
if(abs(e).gt.tol1) then
|
|
d1=2.*(b-a)
|
|
d2=d1
|
|
if(dw.ne.dx) d1=(w-x)*dx/(dx-dw)
|
|
if(dv.ne.dx) d2=(v-x)*dx/(dx-dv)
|
|
u1=x+d1
|
|
u2=x+d2
|
|
ok1=((a-u1)*(u1-b).gt.0.).and.(dx*d1.le.0.)
|
|
ok2=((a-u2)*(u2-b).gt.0.).and.(dx*d2.le.0.)
|
|
olde=e
|
|
e=d
|
|
if(.not.(ok1.or.ok2))then
|
|
goto 1
|
|
else if (ok1.and.ok2)then
|
|
if(abs(d1).lt.abs(d2))then
|
|
d=d1
|
|
else
|
|
d=d2
|
|
endif
|
|
else if (ok1)then
|
|
d=d1
|
|
else
|
|
d=d2
|
|
endif
|
|
if(abs(d).gt.abs(0.5*olde))goto 1
|
|
u=x+d
|
|
if(u-a.lt.tol2 .or. b-u.lt.tol2) d=sign(tol1,xm-x)
|
|
goto 2
|
|
endif
|
|
1 if(dx.ge.0.) then
|
|
e=a-x
|
|
else
|
|
e=b-x
|
|
endif
|
|
d=0.5*e
|
|
2 if(abs(d).ge.tol1) then
|
|
u=x+d
|
|
fu=f(u)
|
|
else
|
|
u=x+sign(tol1,d)
|
|
fu=f(u)
|
|
if(fu.gt.fx)goto 3
|
|
endif
|
|
du=df(u)
|
|
if(fu.le.fx) then
|
|
if(u.ge.x) then
|
|
a=x
|
|
else
|
|
b=x
|
|
endif
|
|
v=w
|
|
fv=fw
|
|
dv=dw
|
|
w=x
|
|
fw=fx
|
|
dw=dx
|
|
x=u
|
|
fx=fu
|
|
dx=du
|
|
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
|
|
dv=dw
|
|
w=u
|
|
fw=fu
|
|
dw=du
|
|
else if(fu.le.fv .or. v.eq.x .or. v.eq.w) then
|
|
v=u
|
|
fv=fu
|
|
dv=du
|
|
endif
|
|
endif
|
|
11 continue
|
|
pause 'dbrent exceeded maximum iterations'
|
|
3 xmin=x
|
|
dbrent=fx
|
|
return
|
|
END
|