*----------------------------------------------------------- * Date created: July 24, 1996 * * Averick, B.M., Carter, R.G., Moré, J.J., * The MINPACK-2 test problem collection. * Technical Memorandum No.150, Argonne National Laboratory, * Argonne, Illinois, May 1991, pp.7. * * The Human Heart Dipole. * * Dr. Neculai Andrei, * Research Institute for Informatics - Bucharest * 8-10, Averescu Avenue, * 71316 Bucharest - Romania * E-mail: nandrei@u3.ici.ro * web: http://www.ici.ro/camo/neculai/nandrei.htm *----------------------------------------------------------- * subroutine ini(n,m,mb,me,sb,x,icgc,ipgc,icge,ipge, 1 nszc,nsze,nb) * double precision x(n) integer sb(mb) integer icgc(nszc),ipgc(n+1) integer icge(nsze),ipge(n+1) integer probv ! Variant of the problem * * Information about the problem. * write(1,10) 10 format(5x,'Example of nonlinear programming.') write(1,11) 11 format(5x,'The Human Heart Dipole Problem') write(1,12) 12 format(5x,'B.M. Averick, R.G. Carter, J.J. More') write(1,13) 13 format(5x,'The MINPACK-2 Test Problem Collection.') write(1,14) 14 format(5x,'Argonne National Laboratory,') write(1,15) 15 format(5x,'Technical Memorandum No. 150, May 1991, pp.7.') * * Dimension of the problem: * n=8 ! No. of variables. m=0 ! No. of inequality constraints. me=8 ! No. of equality constraints. mb=16 ! No. of simple bounds on variables. nszc=0 ! No. of non-zeros in Jacobian of c(x)>=0. nsze=52 ! No. of non-zeros in Jacobian of e(x) =0. probv=1 * * Initial point: * * Compute the standard point if (probv .eq. 1) then x(1) = 0.299d0 x(2) = 0.186d0 x(3) = -0.0273d0 x(4) = 0.0254d0 x(5) = -0.474d0 x(6) = 0.474d0 x(7) = -0.0892d0 x(8) = 0.0892d0 else if (probv .eq. 2) then x(1) = -0.3d0 x(2) = -0.39d0 x(3) = 0.3d0 x(4) = -0.344d0 x(5) = -1.2d0 x(6) = 2.69d0 x(7) = 1.59d0 x(8) = -1.5d0 else if (probv .eq. 3) then x(1) = -0.041d0 x(2) = -0.775d0 x(3) = 0.03d0 x(4) = -.047d0 x(5) = -2.565d0 x(6) = 2.565d0 x(7) = -0.754d0 x(8) = 0.754d0 else if (probv .eq. 4) then x(1) = -0.056d0 x(2) = -0.753d0 x(3) = 0.026d0 x(4) = -0.047d0 x(5) = -2.991d0 x(6) = 2.991d0 x(7) = -0.568d0 x(8) = 0.568d0 else if (probv .eq. 5) then x(1) = -0.074d0 x(2) = -0.733d0 x(3) = 0.013d0 x(4) = -0.034d0 x(5) = -3.632d0 x(6) = 3.632d0 x(7) = -0.289d0 x(8) = 0.289d0 end if * * * Index vector for simple bounds: cb >= 0. * j=1 do i=1,n sb(j)=i sb(j+1)=-i j=j+2 end do * Rows indices of the nonzeros of the Jacobian of the Inequalities * * Starting address of columns of the Jacobian of the Inequalities * * Rows indices of the nonzeros of the Jacobian of the Equalities * icge(1)=1 icge(2)=3 icge(3)=4 icge(4)=5 icge(5)=6 icge(6)=7 icge(7)=8 icge(8)=1 icge(9)=3 icge(10)=4 icge(11)=5 icge(12)=6 icge(13)=7 icge(14)=8 icge(15)=2 icge(16)=3 icge(17)=4 icge(18)=5 icge(19)=6 icge(20)=7 icge(21)=8 icge(22)=2 icge(23)=3 icge(24)=4 icge(25)=5 icge(26)=6 icge(27)=7 icge(28)=8 icge(29)=3 icge(30)=4 icge(31)=5 icge(32)=6 icge(33)=7 icge(34)=8 icge(35)=3 icge(36)=4 icge(37)=5 icge(38)=6 icge(39)=7 icge(40)=8 icge(41)=3 icge(42)=4 icge(43)=5 icge(44)=6 icge(45)=7 icge(46)=8 icge(47)=3 icge(48)=4 icge(49)=5 icge(50)=6 icge(51)=7 icge(52)=8 * * Starting address of columns of the Jacobian of the Equalities * ipge(1)=1 ipge(2)=8 ipge(3)=15 ipge(4)=22 ipge(5)=29 ipge(6)=35 ipge(7)=41 ipge(8)=47 ipge(9)=53 return end * *-------------------------------------------------------------- * Date created: July,24 1996 * The Human Heart Dipole Problem. *-------------------------------------------------------------- * subroutine prob(n,m,mb,me,sb,x,objf,gobj,c,gc,cb,e,ge, 1 nszc,nsze,nb) * * Calculate problem function at iterate x. * double precision x(n),objf,gobj(n),c(m),gc(nszc) double precision cb(mb),e(me),ge(nsze) double precision fjac(8,8) * Variant of the problem after probv: integer probv double precision one, three, twenty, two, zero parameter (zero=0.0d0,one=1.0d0,two=2.0d0,three=3.0d0, + twenty=2.0d1) double precision a, b, cc, d, suma, sumb, sumc, sumd, sume, sumf, + summx, summy, t, ts3vs, tsvs, tt, tv, u, + us3ws, usws, uu, uw, v, vs3ts, vv, w, ws3us, ww * * Objective function and its gradient: * objf=1.d0 * do i=1,n gobj(1)=zero end do * * Bounds on variables: * j=1 do i=1,n cb(j)=x(i)+twenty cb(j+1)=twenty-x(i) j=j+2 end do c----------------------------------------- Initialization. probv=1 if (probv .eq. 1) then summx = 0.485d0 summy = -0.0019d0 suma = -0.0581d0 sumb = 0.015d0 sumc = 0.105d0 sumd = 0.0406d0 sume = 0.167d0 sumf = -0.399d0 else if (probv .eq. 2) then summx = -0.69d0 summy = -0.044d0 suma = -1.57d0 sumb = -1.31d0 sumc = -2.65d0 sumd = 2.0d0 sume = -12.6d0 sumf = 9.48d0 else if (probv .eq. 3) then summx = -0.816d0 summy = -0.017d0 suma = -1.826d0 sumb = -0.754d0 sumc = -4.839d0 sumd = -3.259d0 sume = -14.023d0 sumf = 15.467d0 else if (probv .eq. 4) then summx = -0.809d0 summy = -0.021d0 suma = -2.04d0 sumb = -0.614d0 sumc = -6.903d0 sumd = -2.934d0 sume = -26.328d0 sumf = 18.639d0 else if (probv .eq. 5) then summx = -0.807d0 summy = -0.021d0 suma = -2.379d0 sumb = -0.364d0 sumc = -10.541d0 sumd = -1.961d0 sume = -51.551d0 sumf = 21.053d0 end if *--------------------------------------------------------------- a = x(1) b = x(2) cc = x(3) d = x(4) t = x(5) u = x(6) v = x(7) w = x(8) tv = t*v tt = t*t vv = v*v tsvs = tt - vv ts3vs = tt - three*vv vs3ts = vv - three*tt uw = u*w uu = u*u ww = w*w usws = uu - ww us3ws = uu - three*ww ws3us = ww - three*uu * * Constraints. (Inequalities): * * Jacobian of the inequalities constraints: * * Constraints. (Equalities): * e(1) = a + b - summx e(2) = cc + d - summy e(3) = t*a + u*b - v*cc - w*d - suma e(4) = v*a + w*b + t*cc + u*d - sumb e(5) = a*tsvs - two*cc*t*v + b*usws - two*d*u*w - sumc e(6) = cc*tsvs + two*a*t*v + d*usws + two*b*u*w - sumd e(7) = a*t*ts3vs + cc*v*vs3ts + b*u*us3ws + d*w*ws3us - sume e(8) = cc*t*ts3vs - a*v*vs3ts + d*u*us3ws - b*w*ws3us - sumf * * Jacobian of the equalities constraints: * fjac(1,1) = one fjac(1,2) = one fjac(1,3) = zero fjac(1,4) = zero fjac(1,5) = zero fjac(1,6) = zero fjac(1,7) = zero fjac(1,8) = zero fjac(2,1) = zero fjac(2,2) = zero fjac(2,3) = one fjac(2,4) = one fjac(2,5) = zero fjac(2,6) = zero fjac(2,7) = zero fjac(2,8) = zero fjac(3,1) = t fjac(3,2) = u fjac(3,3) = -v fjac(3,4) = -w fjac(3,5) = a fjac(3,6) = b fjac(3,7) = -cc fjac(3,8) = -d fjac(4,1) = v fjac(4,2) = w fjac(4,3) = t fjac(4,4) = u fjac(4,5) = cc fjac(4,6) = d fjac(4,7) = a fjac(4,8) = b fjac(5,1) = tsvs fjac(5,2) = usws fjac(5,3) = -two*tv fjac(5,4) = -two*uw fjac(5,5) = two*(a*t-cc*v) fjac(5,6) = two*(b*u-d*w) fjac(5,7) = -two*(a*v+cc*t) fjac(5,8) = -two*(b*w+d*u) fjac(6,1) = two*tv fjac(6,2) = two*uw fjac(6,3) = tsvs fjac(6,4) = usws fjac(6,5) = two*(cc*t+a*v) fjac(6,6) = two*(d*u+b*w) fjac(6,7) = two*(a*t-cc*v) fjac(6,8) = two*(b*u-d*w) fjac(7,1) = t*ts3vs fjac(7,2) = u*us3ws fjac(7,3) = v*vs3ts fjac(7,4) = w*ws3us fjac(7,5) = three*(a*tsvs-two*cc*tv) fjac(7,6) = three*(b*usws-two*d*uw) fjac(7,7) = -three*(cc*tsvs+two*a*tv) fjac(7,8) = -three*(d*usws+two*b*uw) fjac(8,1) = -v*vs3ts fjac(8,2) = -w*ws3us fjac(8,3) = t*ts3vs fjac(8,4) = u*us3ws fjac(8,5) = three*(cc*tsvs+two*a*tv) fjac(8,6) = three*(d*usws+two*b*uw) fjac(8,7) = three*(a*tsvs-two*cc*tv) fjac(8,8) = three*(b*usws-two*d*uw) * ij=0 do j=1,n do i=1,n if(fjac(i,j) .ne. zero) then ij=ij+1 ge(ij)=fjac(i,j) end if end do end do * return end *------------------------------------------------------HHD.for