subroutine dbfgsl (n,d,m,nys,jmin,jmax,ybar,sbar,rho,size, 6 & izs,rzs,dzs) c integer n,m,nys,jmin,jmax,izs(1) real rzs(1) double precision d(n),ybar(n,m),sbar(n,m),rho(m),size,dzs(1) c c---- c c compute the product H u, where c . H is the matrix that could be obtained from the m pairs c (ybar,sbar) using the inverse BFGS formula from the diagonal c matrix (size) * (Identity matrix), c . u is a vector of dimension n. c c The vector d contains c c u (on entry), H u (on output). c c rho(m) is a working zone. c c Input: c c---- c c --- local variables c integer i,j,jfin,jp double precision r c c --- return if there is no pair (y,s) in ybar and sbar c if (nys.eq.0) return c c --- set jfin c jfin=jmax if (jfin.lt.jmin) jfin=jmax+m c c --- backward sweep c do j=jfin,jmin,-1 jp=j if (jp.gt.m) jp=jp-m call deuclid (n,d,sbar(1,jp),r,izs,rzs,dzs) rho(jp)=r do i=1,n d(i)=d(i)-r*ybar(i,jp) enddo enddo c c -- preconditioning c r=size do i=1,n d(i)=d(i)*r enddo c c --- forward sweep c do j=jmin,jfin jp=j if (jp.gt.m) jp=jp-m call deuclid (n,d,ybar(1,jp),r,izs,rzs,dzs) r=rho(jp)-r do i=1,n d(i)=d(i)+r*sbar(i,jp) enddo enddo return end c c--------0---------0---------0---------0---------0---------0---------0-- c