63 integer,
parameter :: n = 25, m = 5, iprint = -1
64 integer,
parameter :: dp = kind(1.0d0)
65 real(dp),
parameter :: factr = 0.0d0, pgtol = 0.0d0
67 character(len=60) :: task, csave
72 integer,
allocatable :: nbd(:), iwa(:)
73 real(dp),
allocatable :: x(:), l(:), u(:), g(:), wa(:)
78 allocate ( nbd(n), x(n), l(n), u(n), g(n) )
80 allocate ( wa(2*m*n + 5*n + 11*m*m + 8*m) )
117 16
format(/,5x,
'Solving sample problem.', &
118 /,5x,
' (f = 0.0 at the optimal solution.)',/)
127 do while( task(1:2).eq.
'FG'.or.task.eq.
'NEW_X'.or. &
132 call setulb(n,m,x,l,u,nbd,f,g,factr,pgtol,wa,iwa,task,iprint, &
133 csave,lsave,isave,dsave)
135 if (task(1:2) .eq.
'FG')
then
142 f =.25d0*(x(1) - 1.d0)**2
144 f = f + (x(i) - x(i-1)**2)**2
151 g(1) = 2.d0*(x(1) - 1.d0) - 1.6d1*x(1)*t1
154 t1 = x(i+1) - x(i)**2
155 g(i) = 8.d0*t2 - 1.6d1*x(i)*t1
161 if (task(1:5) .eq.
'NEW_X')
then
177 if (isave(34) .ge. 99) &
178 task=
'STOP: TOTAL NO. of f AND g EVALUATIONS EXCEEDS LIMIT'
183 if (dsave(13) .le. 1.d-10*(1.0d0 + abs(f))) &
184 task=
'STOP: THE PROJECTED GRADIENT IS SUFFICIENTLY SMALL'
197 write (6,
'(2(a,i5,4x),a,1p,d12.5,4x,a,1p,d12.5)')
'Iterate' &
198 , isave(30),
'nfg =',isave(34),
'f =',f,
'|proj g| =',dsave(13)
203 if (task(1:4) .eq.
'STOP')
then
205 write (6,*)
'Final X='
206 write (6,
'((1x,1p, 6(1x,d11.4)))') (x(i),i = 1,n)