68 integer,
parameter :: n = 1000, m = 10, iprint = -1
69 integer,
parameter :: dp = kind(1.0d0)
70 real(dp),
parameter :: factr = 0.0d0, pgtol = 0.0d0, &
73 character(len=60) :: task, csave
78 integer,
allocatable :: nbd(:), iwa(:)
79 real(dp),
allocatable :: x(:), l(:), u(:), g(:), wa(:)
81 real(dp) :: t1, t2, time1, time2
84 allocate ( nbd(n), x(n), l(n), u(n), g(n) )
86 allocate ( wa(2*m*n + 5*n + 11*m*m + 8*m) )
125 16
format(/,5x,
'Solving sample problem.',&
126 /,5x,
' (f = 0.0 at the optimal solution.)',/)
138 do while( task(1:2).eq.
'FG'.or.task.eq.
'NEW_X'.or. &
143 call setulb(n,m,x,l,u,nbd,f,g,factr,pgtol,wa,iwa, &
144 task,iprint, csave,lsave,isave,dsave)
146 if (task(1:2) .eq.
'FG')
then
153 if (time2-time1 .gt. tlimit)
then
154 task=
'STOP: CPU EXCEEDING THE TIME LIMIT.'
173 j = 3*n+2*m*n+11*m**2
174 write (6,*)
'Latest iterate X ='
175 write (6,
'((1x,1p, 6(1x,d11.4)))') (wa(i),i = j+1,j+n)
181 write (6,
'(a,1p,d12.5,4x,a,1p,d12.5)') &
182 'At latest iterate f =',dsave(2),
'|proj g| =',dsave(13)
188 f=.25d0*(x(1)-1.d0)**2
190 f=f+(x(i)-x(i-1)**2)**2
197 g(1) = 2.d0*(x(1)-1.d0)-1.6d1*x(1)*t1
201 g(i)=8.d0*t2-1.6d1*x(i)*t1
209 if (task(1:5) .eq.
'NEW_X')
then
218 if (isave(34) .ge. 900) &
219 task=
'STOP: TOTAL NO. of f AND g EVALUATIONS EXCEEDS LIMIT'
223 if (dsave(13) .le. 1.d-10*(1.0d0 + abs(f))) &
224 task=
'STOP: THE PROJECTED GRADIENT IS SUFFICIENTLY SMALL'
235 write (6,
'(2(a,i5,4x),a,1p,d12.5,4x,a,1p,d12.5)')
'Iterate' &
236 ,isave(30),
'nfg =',isave(34),
'f =',f,
'|proj g| =',dsave(13)
241 if (task(1:4) .eq.
'STOP')
then
243 write (6,*)
'Final X='
244 write (6,
'((1x,1p, 6(1x,d11.4)))') (x(i),i = 1,n)