65 lines
1.5 KiB
Fortran
65 lines
1.5 KiB
Fortran
SUBROUTINE mnbrak(ax,bx,cx,fa,fb,fc,func)
|
|
REAL ax,bx,cx,fa,fb,fc,func,GOLD,GLIMIT,TINY
|
|
EXTERNAL func
|
|
PARAMETER (GOLD=1.618034, GLIMIT=100., TINY=1.e-20)
|
|
REAL dum,fu,q,r,u,ulim
|
|
fa=func(ax)
|
|
fb=func(bx)
|
|
if(fb.gt.fa)then
|
|
dum=ax
|
|
ax=bx
|
|
bx=dum
|
|
dum=fb
|
|
fb=fa
|
|
fa=dum
|
|
endif
|
|
cx=bx+GOLD*(bx-ax)
|
|
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.*sign(max(abs(q-r),TINY),q-r))
|
|
ulim=bx+GLIMIT*(cx-bx)
|
|
if((bx-u)*(u-cx).gt.0.)then
|
|
fu=func(u)
|
|
if(fu.lt.fc)then
|
|
ax=bx
|
|
fa=fb
|
|
bx=u
|
|
fb=fu
|
|
return
|
|
else if(fu.gt.fb)then
|
|
cx=u
|
|
fc=fu
|
|
return
|
|
endif
|
|
u=cx+GOLD*(cx-bx)
|
|
fu=func(u)
|
|
else if((cx-u)*(u-ulim).gt.0.)then
|
|
fu=func(u)
|
|
if(fu.lt.fc)then
|
|
bx=cx
|
|
cx=u
|
|
u=cx+GOLD*(cx-bx)
|
|
fb=fc
|
|
fc=fu
|
|
fu=func(u)
|
|
endif
|
|
else if((u-ulim)*(ulim-cx).ge.0.)then
|
|
u=ulim
|
|
fu=func(u)
|
|
else
|
|
u=cx+GOLD*(cx-bx)
|
|
fu=func(u)
|
|
endif
|
|
ax=bx
|
|
bx=cx
|
|
cx=u
|
|
fa=fb
|
|
fb=fc
|
|
fc=fu
|
|
goto 1
|
|
endif
|
|
return
|
|
END
|