1
subroutine dcsrch(stp,f,g,ftol,gtol,xtol,task,stpmin,stpmax,
5
double precision f, g, stp, ftol, gtol, xtol, stpmin, stpmax
6
double precision dsave(13)
11
c This subroutine finds a step that satisfies a sufficient
12
c decrease condition and a curvature condition.
14
c Each call of the subroutine updates an interval with
15
c endpoints stx and sty. The interval is initially chosen
16
c so that it contains a minimizer of the modified function
18
c psi(stp) = f(stp) - f(0) - ftol*stp*f'(0).
20
c If psi(stp) <= 0 and f'(stp) >= 0 for some step, then the
21
c interval is chosen so that it contains a minimizer of f.
23
c The algorithm is designed to find a step that satisfies
24
c the sufficient decrease condition
26
c f(stp) <= f(0) + ftol*stp*f'(0),
28
c and the curvature condition
30
c abs(f'(stp)) <= gtol*abs(f'(0)).
32
c If ftol is less than gtol and if, for example, the function
33
c is bounded below, then there is always a step which satisfies
36
c If no step can be found that satisfies both conditions, then
37
c the algorithm stops with a warning. In this case stp only
38
c satisfies the sufficient decrease condition.
40
c A typical invocation of dcsrch has the following outline:
42
c Evaluate the function at stp = 0.0d0; store in f.
43
c Evaluate the gradient at stp = 0.0d0; store in g.
44
c Choose a starting step stp.
48
c call dcsrch(stp,f,g,ftol,gtol,xtol,task,stpmin,stpmax,
50
c if (task .eq. 'FG') then
51
c Evaluate the function and the gradient at stp
55
c NOTE: The user must not alter work arrays between calls.
57
c The subroutine statement is
59
c subroutine dcsrch(f,g,stp,ftol,gtol,xtol,stpmin,stpmax,
63
c stp is a double precision variable.
64
c On entry stp is the current estimate of a satisfactory
65
c step. On initial entry, a positive initial estimate
67
c On exit stp is the current estimate of a satisfactory step
68
c if task = 'FG'. If task = 'CONV' then stp satisfies
69
c the sufficient decrease and curvature condition.
71
c f is a double precision variable.
72
c On initial entry f is the value of the function at 0.
73
c On subsequent entries f is the value of the
75
c On exit f is the value of the function at stp.
77
c g is a double precision variable.
78
c On initial entry g is the derivative of the function at 0.
79
c On subsequent entries g is the derivative of the
81
c On exit g is the derivative of the function at stp.
83
c ftol is a double precision variable.
84
c On entry ftol specifies a nonnegative tolerance for the
85
c sufficient decrease condition.
86
c On exit ftol is unchanged.
88
c gtol is a double precision variable.
89
c On entry gtol specifies a nonnegative tolerance for the
90
c curvature condition.
91
c On exit gtol is unchanged.
93
c xtol is a double precision variable.
94
c On entry xtol specifies a nonnegative relative tolerance
95
c for an acceptable step. The subroutine exits with a
96
c warning if the relative difference between sty and stx
98
c On exit xtol is unchanged.
100
c task is a character variable of length at least 60.
101
c On initial entry task must be set to 'START'.
102
c On exit task indicates the required action:
104
c If task(1:2) = 'FG' then evaluate the function and
105
c derivative at stp and call dcsrch again.
107
c If task(1:4) = 'CONV' then the search is successful.
109
c If task(1:4) = 'WARN' then the subroutine is not able
110
c to satisfy the convergence conditions. The exit value of
111
c stp contains the best point found during the search.
113
c If task(1:5) = 'ERROR' then there is an error in the
116
c On exit with convergence, a warning or an error, the
117
c variable task contains additional information.
119
c stpmin is a double precision variable.
120
c On entry stpmin is a nonnegative lower bound for the step.
121
c On exit stpmin is unchanged.
123
c stpmax is a double precision variable.
124
c On entry stpmax is a nonnegative upper bound for the step.
125
c On exit stpmax is unchanged.
127
c isave is an integer work array of dimension 2.
129
c dsave is a double precision work array of dimension 13.
133
c MINPACK-2 ... dcstep
135
c MINPACK-1 Project. June 1983.
136
c Argonne National Laboratory.
137
c Jorge J. More' and David J. Thuente.
139
c MINPACK-2 Project. November 1993.
140
c Argonne National Laboratory and University of Minnesota.
141
c Brett M. Averick, Richard G. Carter, and Jorge J. More'.
144
double precision zero, p5, p66
145
parameter (zero=0.0d0,p5=0.5d0,p66=0.66d0)
146
double precision xtrapl, xtrapu
147
parameter (xtrapl=1.1d0,xtrapu=4.0d0)
151
double precision finit, ftest, fm, fx, fxm, fy, fym, ginit, gtest,
152
+ gm, gx, gxm, gy, gym, stx, sty, stmin, stmax,
157
c Initialization block.
159
if (task(1:5) .eq. 'START') then
161
c Check the input arguments for errors.
163
if (stp .lt. stpmin) task = 'ERROR: STP .LT. STPMIN'
164
if (stp .gt. stpmax) task = 'ERROR: STP .GT. STPMAX'
165
if (g .ge. zero) task = 'ERROR: INITIAL G .GE. ZERO'
166
if (ftol .lt. zero) task = 'ERROR: FTOL .LT. ZERO'
167
if (gtol .lt. zero) task = 'ERROR: GTOL .LT. ZERO'
168
if (xtol .lt. zero) task = 'ERROR: XTOL .LT. ZERO'
169
if (stpmin .lt. zero) task = 'ERROR: STPMIN .LT. ZERO'
170
if (stpmax .lt. stpmin) task = 'ERROR: STPMAX .LT. STPMIN'
172
c Exit if there are errors on input.
174
if (task(1:5) .eq. 'ERROR') return
176
c Initialize local variables.
183
width = stpmax - stpmin
186
c The variables stx, fx, gx contain the values of the step,
187
c function, and derivative at the best step.
188
c The variables sty, fy, gy contain the value of the step,
189
c function, and derivative at sty.
190
c The variables stp, f, g contain the values of the step,
191
c function, and derivative at stp.
200
stmax = stp + xtrapu*stp
207
c Restore local variables.
209
if (isave(1) .eq. 1) then
231
c If psi(stp) <= 0 and f'(stp) >= 0 for some step, then the
232
c algorithm enters the second stage.
234
ftest = finit + stp*gtest
235
if (stage .eq. 1 .and. f .le. ftest .and. g .ge. zero) stage = 2
239
if (brackt .and. (stp .le. stmin .or. stp .ge. stmax))
240
+ task = 'WARNING: ROUNDING ERRORS PREVENT PROGRESS'
241
if (brackt .and. stmax-stmin .le. xtol*stmax)
242
+ task = 'WARNING: XTOL TEST SATISFIED'
243
if (stp .eq. stpmax .and. f .le. ftest .and. g .le. gtest)
244
+ task = 'WARNING: STP = STPMAX'
245
if (stp .eq. stpmin .and. (f .gt. ftest .or. g .ge. gtest))
246
+ task = 'WARNING: STP = STPMIN'
248
c Test for convergence.
250
if (f .le. ftest .and. abs(g) .le. gtol*(-ginit))
251
+ task = 'CONVERGENCE'
253
c Test for termination.
255
if (task(1:4) .eq. 'WARN' .or. task(1:4) .eq. 'CONV') go to 10
257
c A modified function is used to predict the step during the
258
c first stage if a lower function value has been obtained but
259
c the decrease is not sufficient.
261
if (stage .eq. 1 .and. f .le. fx .and. f .gt. ftest) then
263
c Define the modified function and derivative values.
272
c Call dcstep to update stx, sty, and to compute the new step.
274
call dcstep(stx,fxm,gxm,sty,fym,gym,stp,fm,gm,brackt,stmin,
277
c Reset the function and derivative values for f.
286
c Call dcstep to update stx, sty, and to compute the new step.
288
call dcstep(stx,fx,gx,sty,fy,gy,stp,f,g,brackt,stmin,stmax)
292
c Decide if a bisection step is needed.
295
if (abs(sty-stx) .ge. p66*width1) stp = stx + p5*(sty-stx)
300
c Set the minimum and maximum steps allowed for stp.
306
stmin = stp + xtrapl*(stp-stx)
307
stmax = stp + xtrapu*(stp-stx)
310
c Force the step to be within the bounds stpmax and stpmin.
312
stp = max(stp,stpmin)
313
stp = min(stp,stpmax)
315
c If further progress is not possible, let stp be the best
316
c point obtained during the search.
318
if (brackt .and. (stp .le. stmin .or. stp .ge. stmax) .or.
319
+ (brackt .and. stmax-stmin .le. xtol*stmax)) stp = stx
321
c Obtain another function and derivative.
327
c Save local variables.