NLSL: brent.f90 Source File

NLSL

- Main Page
- Modules
- Data Types List
- Files

- File List
- File Members

brent.f90
Go to the documentation of this file.
1 function brent(ax,bx,cx,fb0,f,tol,ftol,xmin,iflag)
2 implicit none
3 c
4 integer iflag,iter
5 double precision brent,ax,bx,cx,f,tol,ftol,xmin
6 double precision a,b,d,e,etemp,fu,fv,fw,fx,r,q,p,tol1,tol2,u,v,w,
7 # x,xm,fdmy,fb0
8 c
9 external f
10 c
11 integer ITMAX
12 double precision CGOLD,ZEPS
13 parameter(itmax=100,cgold=.3819660d0,zeps=1.0d-10)
14 c
15 c a is lower bound
16 c b is upper bound
17 c x is function minimum so far
18 c w is second-least function value
19 c v is previous w
20 c u is most recent function eval
21 c
22 iflag=1
23 c
24 a=min(ax,cx)
25 b=max(ax,cx)
26 v=bx
27 w=v
28 x=v
29 e=0.
30 c
31 c Use initial function value from mnbrak
32 c
33 fx = fb0
34 c
35 fv=fx
36 fw=fx
37 do 11 iter=1,itmax
38 tol1=tol
39 tol2=2.*tol1
40 xm=0.5*(a+b)
41 c
42 c Check for parameter convergence
43 c
44 if(abs(x-xm).le.(tol2-.5d0*(b-a)))goto 3
45 c
46 if(abs(e).gt.tol1) then
47 c
48 r=(x-w)*(fx-fv)
49 q=(x-v)*(fx-fw)
50 p=(x-v)*q-(x-w)*r
51 q=2.*(q-r)
52 if(q.gt.0.) p=-p
53 q=abs(q)
54 etemp=e
55 e=d
56 if(abs(p).ge.abs(.5*q*etemp).or.p.le.q*(a-x).or.
57 * p.ge.q*(b-x)) goto 1
58 c
59 c Take parabolic step
60 c
61 d=p/q
62 u=x+d
63 if(u-a.lt.tol2 .or. b-u.lt.tol2) d=sign(tol1,xm-x)
64 goto 2
65 endif
66 c
67 c Take golden section step into larger of [a,x], [x,b]
68 c
69 1 if(x.ge.xm) then
70 e=a-x
71 else
72 e=b-x
73 endif
74 d=cgold*e
75 c
76 c Evaluate function at new point if it is at least
77 c tol away from existing minimum
78 c
79 2 if(abs(d).ge.tol1) then
80 u=x+d
81 else
82 u=x+sign(tol1,d)
83 endif
84 c
85 fu=f(u,iflag)
86 if (iflag.lt.0) go to 3
87 c
88 c New step is the new minimum: old minimum is now a bracket
89 c
90 if(fu.le.fx) then
91 if(u.ge.x) then
92 a=x
93 else
94 b=x
95 endif
96 c
97 v=w
98 fv=fw
99 w=x
100 fw=fx
101 x=u
102 fx=fu
103 c
104 c New step increased function: found a new bracket
105 c
106 else
107 if(u.lt.x) then
108 a=u
109 else
110 b=u
111 endif
112 if(fu.le.fw .or. w.eq.x) then
113 v=w
114 fv=fw
115 w=u
116 fw=fu
117 else if(fu.le.fv .or. v.eq.x .or. v.eq.w) then
118 v=u
119 fv=fu
120 endif
121 endif
122 c
123 c Check for function convergence
124 c
125 if (abs(fx-fw).lt.ftol) goto 3
126 c
127 11 continue
128 c
129 print *, 'Brent exceed maximum iterations.'
130 print *, '[execution paused, press enter to continue]'
131 read (*,*)
132 c
133 3 xmin=x
134 brent=fx
135 return
136 end
brent
double precision function brent(ax, bx, cx, fb0, f, tol, ftol, xmin, iflag)
Definition: brent.f90:2