Mercurial > hg > octave-nkf
view libcruft/fsqp/sampl2.for @ 2764:2c0f259cf83d
[project @ 1997-03-01 02:30:26 by jwe]
author | jwe |
---|---|
date | Sat, 01 Mar 1997 02:30:29 +0000 |
parents | 12ff450cbb1f |
children |
line wrap: on
line source
c c problem description c program sampl2 c integer nwsize,iwsize,nparam,nf,nineq,neq parameter (iwsize=1029, nwsize=7693) parameter (nparam=6, nf=163, nineq=7, neq=0) integer nineqn,neqn,mode,iprint,miter,inform, * iw(iwsize) double precision bigbnd,eps,epsneq,delta double precision x(nparam),bl(nparam),bu(nparam),w(nwsize), * f(nf+1),g(nineq+neq+1) external objmad,cnmad,grobfd,grcnfd c mode=111 iprint=1 miter=500 bigbnd=1.d+10 eps=1.d-08 epsneq=0.d0 delta=0.d0 c c nparam=6 c nf=163 nineqn=0 neqn=0 c nineq=7 c neq=0 c bl(1)=-bigbnd bl(2)=-bigbnd bl(3)=-bigbnd bl(4)=-bigbnd bl(5)=-bigbnd bl(6)=-bigbnd bu(1)=bigbnd bu(2)=bigbnd bu(3)=bigbnd bu(4)=bigbnd bu(5)=bigbnd bu(6)=bigbnd c c give the initial value of x c x(1) = 0.5d0 x(2) = 1.d0 x(3) = 1.5d0 x(4) = 2.d0 x(5) = 2.5d0 x(6) = 3.d0 c call FSQPD(nparam,nf,nineqn,nineq,neqn,neq,mode,iprint, * miter,inform,bigbnd,eps,epsneq,delta,bl,bu,x,f, * g,iw,iwsize,w,nwsize,objmad,cnmad,grobfd,grcnfd) end c subroutine objmad(nparam,j,x,fj) integer nparam,j,i double precision x(nparam),theta,pi,fj c pi=3.14159265358979d0 theta=pi*(8.5d0+dble(j)*0.5d0)/180.d0 fj=0.d0 do 10 i=1,6 10 fj=fj+dcos(2.d0*pi*x(i)*dsin(theta)) fj=2.d0*(fj+dcos(2.d0*pi*3.5d0*dsin(theta)))/15.d0+1.d0/15.d0 return end c subroutine cnmad(nparam,j,x,gj) integer nparam,j double precision x(nparam),ss,gj c ss=0.425d0 goto(10,20,30,40,50,60,70),j 10 gj=ss-x(1) return 20 gj=ss+x(1)-x(2) return 30 gj=ss+x(2)-x(3) return 40 gj=ss+x(3)-x(4) return 50 gj=ss+x(4)-x(5) return 60 gj=ss+x(5)-x(6) return 70 gj=ss+x(6)-3.5d0 return end