1 subroutine nelmin ( fn, n, start, xmin, ynewlo, reqmin, step,
2 & konvge, kcount, icount, numres, ifault )
97 integer ( kind = 4 ) n
99 real ( kind = 8 ), parameter :: ccoeff = 0.5d+00
100 real ( kind = 8 ) del
101 real ( kind = 8 ), parameter :: ecoeff = 2.0d+00
102 real ( kind = 8 ), parameter :: eps = 0.001d+00
103 real ( kind = 8 ), external :: fn
104 integer ( kind = 4 ) i
105 integer ( kind = 4 ) icount
106 integer ( kind = 4 ) ifault
107 integer ( kind = 4 ) ihi
108 integer ( kind = 4 ) ilo
109 integer ( kind = 4 ) j
110 integer ( kind = 4 ) jcount
111 integer ( kind = 4 ) kcount
112 integer ( kind = 4 ) konvge
113 integer ( kind = 4 ) l
114 integer ( kind = 4 ) numres
115 real ( kind = 8 ) p(n,n+1)
116 real ( kind = 8 ) p2star(n)
117 real ( kind = 8 ) pbar(n)
118 real ( kind = 8 ) pstar(n)
119 real ( kind = 8 ), parameter :: rcoeff = 1.0d+00
120 real ( kind = 8 ) reqmin
122 real ( kind = 8 ) start(n)
123 real ( kind = 8 ) step(n)
125 real ( kind = 8 ) xmin(n)
126 real ( kind = 8 ) y(n+1)
127 real ( kind = 8 ) y2star
128 real ( kind = 8 ) ylo
129 real ( kind = 8 ) ynewlo
130 real ( kind = 8 ) ystar
135 if ( reqmin <= 0.0d+00 )
then
145 if ( konvge < 1 )
then
156 rq = reqmin * real( n, kind = 8 )
162 p(1:n,n+1) = start(1:n)
170 start(j) = start(j) + step(j) * del
171 p(1:n,j) = start(1:n)
180 ilo = minloc( y(1:n+1), 1 )
185 do while ( icount < kcount )
189 ihi = maxloc( y(1:n+1), 1 )
196 pbar(i) = (sum( p(i,1:n+1) ) - p(i,ihi)) / real(n, kind = 8)
201 pstar(1:n) = pbar(1:n) + rcoeff * ( pbar(1:n) - p(1:n,ihi) )
207 if ( ystar < ylo )
then
209 p2star(1:n) = pbar(1:n) + ecoeff * ( pstar(1:n) - pbar(1:n) )
210 y2star = fn( p2star )
215 if ( ystar < y2star )
then
216 p(1:n,ihi) = pstar(1:n)
219 p(1:n,ihi) = p2star(1:n)
229 if ( ystar < y(i) )
then
236 p(1:n,ihi) = pstar(1:n)
241 else if ( l == 0 )
then
243 p2star(1:n) = pbar(1:n) + ccoeff * ( p(1:n,ihi) - pbar(1:n) )
244 y2star = fn( p2star )
249 if ( y(ihi) < y2star )
then
252 p(1:n,j) = ( p(1:n,j) + p(1:n,ilo) ) * 0.5d+00
258 ilo = minloc( y(1:n+1), 1 )
266 p(1:n,ihi) = p2star(1:n)
272 else if ( l == 1 )
then
274 p2star(1:n) = pbar(1:n) + ccoeff * ( pstar(1:n) - pbar(1:n) )
275 y2star = fn( p2star )
280 if ( y2star <= ystar )
then
281 p(1:n,ihi) = p2star(1:n)
284 p(1:n,ihi) = pstar(1:n)
294 if ( y(ihi) < ylo )
then
301 if ( 0 < jcount )
then
307 if ( icount <= kcount )
then
311 x = sum( y(1:n+1) ) / real( n + 1, kind = 8 )
312 z = sum( ( y(1:n+1) - x )**2 )
324 xmin(1:n) = p(1:n,ilo)
327 if ( kcount < icount )
then
336 xmin(i) = xmin(i) + del
339 if ( z < ynewlo )
then
343 xmin(i) = xmin(i) - del - del
346 if ( z < ynewlo )
then
350 xmin(i) = xmin(i) + del
353 if ( ifault == 0 )
then
359 start(1:n) = xmin(1:n)