Mercurial > hg > octave-nkf
view libcruft/fsqp/sampl3.for @ 2512:fda09c1e787e
[project @ 1996-11-14 08:39:41 by jwe]
author | jwe |
---|---|
date | Thu, 14 Nov 1996 08:39:47 +0000 |
parents | 12ff450cbb1f |
children |
line wrap: on
line source
c c problem description c integer iwsize,nwsize,nparam,nf,nineq,neq parameter (iwsize=33, nwsize=284) parameter (nparam=4, nf=1) parameter (nineq=1, neq=1) integer iw(iwsize) double precision x(nparam),bl(nparam),bu(nparam),f(nf+1), * g(nineq+neq+1),w(nwsize) external obj,cntr,gradob,gradcn c integer mode,iprint,miter,neqn,nineqn,inform double precision bigbnd,eps,epsneq,udelta c mode=100 iprint=1 miter=500 bigbnd=1.d+10 eps=1.d-07 epsneq=7.d-6 udelta=0.d0 c neqn=1 nineqn=1 bl(1)=1.d0 bl(2)=1.d0 bl(3)=1.d0 bl(4)=1.d0 bu(1)=5.d0 bu(2)=5.d0 bu(3)=5.d0 bu(4)=5.d0 c c give the initial value of x c x(1)=1.d0 x(2)=5.d0 x(3)=5.d0 x(4)=1.d0 c call FSQPD(nparam,nf,nineqn,nineq,neqn,neq,mode,iprint, * miter,inform,bigbnd,eps,epsneq,udelta,bl,bu,x,f,g, * iw,iwsize,w,nwsize,obj,cntr,gradob,gradcn) end c subroutine obj(nparam,j,x,fj) integer nparam,j double precision x(nparam),fj c fj=x(1)*x(4)*(x(1)+x(2)+x(3))+x(3) return end c subroutine gradob(nparam,j,x,gradfj,dummy) integer nparam,j double precision dummy,x(nparam),gradfj(nparam) external dummy c gradfj(1)=x(4)*(x(1)+x(2)+x(3))+x(1)*x(4) gradfj(2)=x(1)*x(4) gradfj(3)=x(1)*x(4)+1.d0 gradfj(4)=x(1)*(x(1)+x(2)+x(3)) return end c subroutine cntr(nparam,j,x,gj) integer nparam,j double precision x(nparam),gj c goto (10,20),j 10 gj=25.d0-x(1)*x(2)*x(3)*x(4) return 20 gj=x(1)**2+x(2)**2+x(3)**2+x(4)**2-40.d0 return end c subroutine gradcn(nparam,j,x,gradgj,dummy) integer nparam,j double precision dummy,x(nparam),gradgj(nparam) external dummy c goto (10,20),j 10 gradgj(1)=-x(2)*x(3)*x(4) gradgj(2)=-x(1)*x(3)*x(4) gradgj(3)=-x(1)*x(2)*x(4) gradgj(4)=-x(1)*x(2)*x(3) return 20 gradgj(1)=2.d0*x(1) gradgj(2)=2.d0*x(2) gradgj(3)=2.d0*x(3) gradgj(4)=2.d0*x(4) return end