********************************************************** Line 1 C C October 25, 2011 C ========================================== C C C Main Program DESCON C ========================== C C C DESCON is a subroutine dedicated to compute the minimizer of C a differentiable function with a large number of variables. C It is supposed that we have the algebraic expression of the C function and its gradient. C C DESCON implements an accelerated conjugate gradient algorithm C that at each iteration both the descent and the conjugacy C conditions are guaranteed. C C The algorithm introduces the modified Wolfe line search in which C the parameter in the second Wolfe condition is modified at C each iteration. C C The algorithm is described in: C N. Andrei, Another conjugate gradient algorithm with C guaranteed descent and conjugacy conditions for large-scale C unconstrained optimization. C ICI Technical Report, November 9, 2011. C------------------------------------------------------------------------- C C The algorithm is defined as: C C x(k+1) = x(k) + alpha*d(k) C C where alpha is computed by the Wolfe line search conditions. C C C The search direction of this algorithm is computed as: C C d(k+1) = -theta(k)*g(k+1) + beta(k)*s(k) C C where beta(k) is: C C y(k)Tg(k+1)-t(k)(s(k)Tg(k+1)) C beta(k) = ------------------------------- . C y(k)Ts(k) C C C The parameters theta(k) and t(k) are determined from the following two C conditions: C C 1) g(k+1)T*d(k+1) = -w*||g(k+1)||^2 (descent condition) C C 2) y(k)T*d(k+1) = -v*(s(k)T*g(k+1)) (conjugacy condition) C C where w and v are two positive parameters specified by the C user. Some suggested values are: w=7/8 and v=0.5. C The algorithm is not too much sensitive to these values. C------------------------------------------------------------------------- C C The solution of the above system given by 1) and 2) is as follows: C C / \ C a(k) | (y(k)Ts(k))||g(k+1)||^2 | b(k) C theta(k) = ------------- |1 + --------------------------| - ---------, C y(k)Tg(k+1) | delta(k) | delta(k) C \ / C C / \ C y(k)Tg(k+1) | b(k) | ||g(k+1||^2 C beta(k) = ------------- |1 - ----------| + a(k) ------------- , C y(k)Ts(k) | delta(k) | delta(k) C \ / C C where: C C a(k) = v*(s(k)T*g(k+1)) + (y(k)T*g(k+1)) C C b(k) = w*||g(k+1)||^2*(s(k)T*y(k)) + (y(k)T*g(k+1))*(s(k)T*g(k+1)) C C and C C delta(k) = (s(k)T*g(k+1))*(y(k)T*g(k+1)) - (y(k)T*s(k))*||g(k+1)||^2. C C C It is proved that the sequence delta(k) is uniformly bounded away C from zero. C C On the other hand, the steplength alpha is computed by the modified C Wolfe line search conditions: C C f(x(k)+alpha(k)*d(k))-f(x(k)) <= rho*alpha(k)*(g(k)*d(k)), C g(x(k)+alpha(k)*d(k))T*d(k) >= sigma(k)*(g(k)*d(k)). C C sigma(k) is computed as: C C ||g(k+1)||^2 C sigma(k) = -------------------------------. C |y(k)T*g(k+1)| + ||g(k+1)||^2 C C C w is a parameter for sufficient descent condition (w>0). C v is a parameter for conjugacy condition (v>0). C C------------------------------------------------------------------------ C Neculai Andrei C Research Institute for Informatics C Center for Advanced Modeling and Optimization C and C Academy of Romanian Scientists ************************************************************************* * * integer nexp,n,iter,irs, fgcnt,lscnt,maxiter,maxfg integer itert, irstot, fgtot,lstot, stoptest integer*4 gh,gm,gs,gc, ght,gmt,gst,gct, timpexp double precision epsg, dc,cc real*8 f, gnorm, timp, proc real*8 epsm integer*2 iyear, imonth, iday character*40 numef, fnumef(200) logical angle, powell common /acca/epsm * LOCAL ARRAYS double precision x(100000) * Input file: open(unit=7,file='funcname.txt',status='old') * Output files: open(unit=4,file='descon.out',status='unknown') open(unit=5,file='descon.rez',status='unknown') * Epsilon machine computation (Please see the common /acca/) epsm = 0.111e-30 * Name of the Problems do i=1,75 read(7,10) numef fnumef(i)=numef 10 format(a40) end do *-------------------------------------------------------------------- * Initial values of parameters: * dc - descent condition (w) * cc - conjucagy condition parameter (v) dc = 7.d0/8.d0 cc = 0.5d0 *------------------------------------------------------------------- * Restart parameters: angle or Powell angle = .false. powell = .true. *------------------------------------------------------------------- * Starting and Ending of the numerical experiments nexpini = 1 nexptot = 75 *------------------------------------------------------------------- * stoptest = option parameter for selection the * stopping criterion: * 1: if(ginf .lt. epsg) * 2: if(gnorm .le. epsg) * where: * ginf = infinite norm of gradient g(xk), * gnorm = norm 2 of gradient g(xk). * stoptest = 1 *------------------------------------------------------------------------- * * Maximum number of iterations * Maximum number of function and gradient evaluations maxiter = 10000 maxfg = 15000 * Some convergence constant epsg = (10.d0)**(-6) *------------------------------------------------------------------------- write(4,15) 15 format(4x,'***************************************************',/, * 4x,'* DESCON ***',/, * 4x,'* Another Accelerated Conjugate Gradient with ***',/, * 4x,'* Guaranteed Descent and Conjugacy conditions ***',/, * 4x,'* --------------------------------------------- ***',/, * 4x,'* Project: FCGA ***',/, * 4x,'* The Fastest Conjugate Gradient Algorithm ***',/, * 4x,'* ***',/, * 4x,'* Dr. Neculai Andrei ***',/, * 4x,'* Research Institute for Informatics ***',/, * 4x,'* Bucharest - Romania ***',/, * 4x,'***************************************************',/) write(4,20) dc, cc 20 format(4x,'Parameters: Descent=',e20.13,4x,'Conjugacy=',e20.13,/) call getdat(iyear, imonth, iday) write(4,21) imonth, iday, iyear 21 format(4x,'Date: --- Month:',i2,' Day:',i2,' Year: ',i4,/) if(powell) then write(4,22) 22 format(4x,'DESCON. Powell restart.') end if if(angle) then write(4,23) 23 format(4x,'DESCON. Angle restart.') end if write(4,24) 24 format(4x,'ib = number of iterations in which betha=0') write(4,25) 25 format(4x,'it = number of iterations in which theta=1') write(4,26) 26 format(1x,91('-')) * *------------------------* *--------------------------------------------- | Here Start Experiments | * *------------------------* do nexp = nexpini,nexptot numef = fnumef(nexp) write(4,101) nexp, numef, stoptest write(*,101) nexp, numef, stoptest 101 format(/,5x,i2,4x,'DESCON Algorithm. ','Function:',a40,/, * 11x,'stoptest=',i2,/) * *---------------------------------------------------------------- * write(4,102) 102 format(7x,'n',3x,'iter',3x,'irs',2x,'fgcnt',1x,'lscnt', * 3x,'time(c)',8x,'fxnew',14x,'gnorm',9x,'ib',3x,'it') write(4,26) * *---------------------------------------------------------------- * itert=0 irstot=0 fgtot=0 lstot=0 timp=0.d0 * *-------------------------------------- Dimension of the problem * do n = 1000, 10000, 1000 * Initial guess call inipoint(n,x, nexp) * Call the solver call gettim(gh,gm,gs,gc) call descon(n,x,epsg,maxiter,maxfg,f,gnorm,stoptest,dc,cc, * iter,irs,fgcnt,lscnt, angle, powell, * ibeta, itheta, nexp) call gettim(ght,gmt,gst,gct) call exetim(gh,gm,gs,gc, ght,gmt,gst,gct) *------------------------------------ Compute elapsed time in centeseconds timpexp = ght*360000 + gmt*6000 + gst*100 + gct * Write statistics * *---------------------------------------------------------- Write *.out write(4,201) n,iter,irs,fgcnt,lscnt,timpexp,f,gnorm,ibeta,itheta 201 format(1x,i7,1x,i6,1x,i5,1x,i6,1x,i5,1x, * i9,e20.13,e20.13,i3,2x,i3) *---------------------------------------------------------- Write *.rez if(n .eq. 1000) then write(5,301) nexp,n,iter,fgcnt,timpexp,f 301 format(i2,i6,2x,i6,2x,i6,2x,i6,2x,e20.13) else write(5,302) n,iter,fgcnt,timpexp,f 302 format(2x,i6,2x,i6,2x,i6,2x,i6,2x,e20.13) end if *------------------------------------------------------------------ itert = itert + iter irstot= irstot + irs fgtot = fgtot + fgcnt lstot = lstot + lscnt timp = timp + float(timpexp) write(*,401) n, iter, irs, fgcnt, lscnt,timpexp,f,gnorm 401 format(1x,i7,1x,i6,1x,i5,1x,i6,1x,i5,1x,i9,' c',e13.6,e13.6) c---------------------------------------------------------- End do n end do proc = float(irstot)*100.d0/float(itert) write(4,26) write(4,501) itert, irstot, fgtot, lstot, timp/100.d0, proc write(*,502) itert, irstot, fgtot, lstot, timp/100.d0, proc 501 format(3x,'TOTAL',1x,i6,1x,i5,1x,i6,1x,i5,3x,f7.2,' (seconds)', * 4x,'proc= ',f6.2,'%',/) 502 format(3x,'TOTAL',1x,i6,1x,i5,1x,i6,1x,i5,3x,f7.2,' (seconds)', * 4x,'proc= ',f6.2,'%',/) *---------------------------------------------------------- End do nexp end do * write(5,601) 601 format(1x,55('-')) write(5,602) 602 format(2x,' n',2x,' iter',' fgcnt time(c)',10x,'fx',/) write(5,20) dc, cc stop end ********************************************************** END main program * *** Conjugate Gradient Algorithms Project *** * =============================================== * * * * *------------------------------------------------------------------- * Subroutine DESCON * ===================== * * * Neculai Andrei * Research Institute for Informatics * Center for Advanced Modeling and Optimization * 8-10, Averescu Avenue, Bucharest 1, Romania * E-mail: nandrei@ici.ro * voice: 666.58.70 * and * Academy of Romanian Scientists * Science and Information Technology Section * 54, Splaiul Independentei, Bucharest 5, Romania * * * * /-----------------------------------------------------------------\ * | DESCON is a subroutine dedicated to compute the minimizer of | * | a differentiable function with a large number of variables. | * | | * | This subroutine is accompanied by subroutine "LineSearch" which | * | implements the Wolfe line search. Both these subroutines belong | * | to DESCON package. | * | | * | The user must provide a subroutine to evaluate the function | * | value and its gradient in a point. The name of this subroutine | * | is EVALFG. | * | The algebraic expression of the functions considered in this | * | program, as well as their Fortran code are presented into the | * | paper: | * | N. Andrei, "An unconstrained optimization test functions | * | collection", Advanced Modeling and Optimization, vol.10, No.1, | * | (2008) pp.147-161. | * | http://www.ici.ro/camo/journal/v10n1.htm | * | | * | There are some facilities for the user to specify: | * | 1) The termination criterion. | * | 2) Convergence tolerance for gradient. | * | 3) Convergence tolerance for function value. | * | 4) Maximum number of iterations in LineSearch subroutine. | * | 5) The parameter w from the descent condition. | * | 6) The parameter v from the conjugacy condition. | * | | * |-----------------------------------------------------------------| * | | * | The calling sequence of DESCON is: | * | | * | subroutine descon(n,x,epsg,maxiter,maxfg,f,gnorm,stoptest,dc,| * | cc,iter,irs,fgcnt,lscnt,angle, powell, | * | ibeta, itheta, nexp) | * | | * |Input parameters: | * |================= | * |n (integer) number of variables. | * |x (double) starting guess, length n. On output | * | contains the solution. | * |epsg (double) convergence tolerance for gradient. | * |maxiter (integer) maximum number of iterations. | * |maxfg (integer) maxumum number of function and its gradient | * | evaluations. | * |stoptest = option parameter for selection of | * | stopping criterion: | * | if stoptest = 1 then consider the following test: | * | if(ginf .le. epsg) | * | if stoptest = 2 then consider the following test: | * | if(gnorm .le. epsg) | * | where: | * | ginf = infinite norm of gradient g(xk), | * | gnorm = norm-2 of gradient g(xk). | * |dc (double) parameter for sufficient descent condition | * |cc (double) parameter for conjugacy condition | * |angle (logical) parameter specifying the angle criterion of | * | restart. | * |powell (logical) parameter specifying the Powell criterion of| * | restart. | * |nexp (integer) parameter specifying the number of the | * | problem considered in a train of experiments| * | | * | | * |Output parameters: | * |================== | * |f (double) function value in final (optimal) point. | * |gnorm (double) norm-2 of gradient in final point. | * |iter (integer) number of iterations to get the final point.| * |irs (integer) number of restart iterations. | * |fgcnt (integer) number of function evaluations. | * |lscnt (integer) number of line searches. | * |ibeta (integer) number of iterations in which beta is zero | * |itheta (integer) number of iterations in which theta is one | * |-----------------------------------------------------------------| * | | * | | * |Calling subroutines: | * |==================== | * |Subroutine DESCON is calling two subroutines: | * |EVALFG an user subroutine (function and gradient), | * |LINESEARCH a package subroutine. | * | | * |The user must supply a subroutine with the function and its | * |gradient: | * | call evalfg(n,x,fx,grad,nexp) | * |where: | * | n (integer) number of variables. | * | x (double) the current iteration. | * | fx (double) function value in point x. | * | grad (double) array with gradient of function in point x. | * | nexp (integer) parameter specifying the number of the | * | problem considered in a train of experiments. | * | | * | | * |The Wolfe line search is implemented in the subroutine | * |LINESEARCH, which belongs to the package. | * |The calling sequence of this subroutine is as follows: | * | call LineSearch (n,x,f,d,gtd,dnorm,alpha,xnew,fnew,gnew,sigma, | * | fgcnt,lscnt,lsflag, nexp) | * |where: | * | n (integer) number of variables. | * | x (double) the current iteration. | * | f (double) function value in current point. | * | d (double) array with search direction. | * | gtd (double) scalar: grad'*d. | * | dnorm (double) 2 norm of d. | * | alpha (double) step length (given by the LineSearch). | * | xnew (double) array with the new estimation of variables. | * | fnew (double) function value in xnew. | * | gnew (double) array with gradient in xnew. | * | sigma (double) parameter sigma in the second Wolfe line | * | search condition. (input parameter) | * | fgcnt (integer) number of function evaluations. | * | lscnt (integer) number of line searches. | * | lsflag (integer) parameter for abnormal Line Search | * | Termination. If the # of iterations in | * | LineSearch is greater than 20 then lsflag=1 | * | nexp (integer) parameter specifying the number of the | * | problem considered in a train of experiments | * | | * |Subroutine LINESEARCH is the same as that used in CONMIN package | * |by Shanno and Phua, and in SCALCG package by Andrei. | * | | * |-----------------------------------------------------------------| * | Neculai Andrei, 2011 | * \-----------------------------------------------------------------/ * * * ********************************************************************* subroutine descon(n,x,epsg,maxiter,maxfg,f,gnorm,stoptest,dc,cc, * iter,irs,fgcnt,lscnt,angle, powell, * ibeta, itheta, nexp) parameter(ia=1000000) * SCALAR ARGUMENTS integer n,iter,irs,fgcnt,lscnt,maxiter,maxfg integer stoptest, nexp double precision epsg, f,gnorm logical angle, powell * ARRAY ARGUMENTS double precision x(n) * LOCAL SCALARS integer i,lsflag double precision fnew,alpha,gtg, beta, sts, + dnorm,dnormprev, ginf, + gtd, gtgp, stg, acc,bdc, + yts, ytg, theta, delta, dc,cc, epsm, bn,sigma * LOCAL ARRAYS double precision xnew(ia),g(ia),gnew(ia),d(ia), + y(ia), s(ia) common /acca/epsm * Initialization n5 = mod(n,5) n6 = n5 + 1 iter = 0 irs = 0 fgcnt = 0 lscnt = 0 ibeta = 0 itheta = 0 call evalfg(n,x,f,g, nexp) fgcnt = fgcnt + 1 gtg = 0.0d0 do i = 1,n5 d(i) = - g(i) gtg = gtg + g(i) ** 2 end do do i = n6,n,5 d(i) = -g(i) d(i+1) = -g(i+1) d(i+2) = -g(i+2) d(i+3) = -g(i+3) d(i+4) = -g(i+4) gtg = gtg + g(i)**2 + g(i+1)**2 + g(i+2)**2 + * g(i+3)**2 + g(i+4)**2 end do gnorm = sqrt( gtg ) gtd = -gtg dnorm = gnorm if ( gnorm .gt. 0.0d0 ) then alpha = 1.0d0 / dnorm end if * Initial value of parameter sigma. * At the next iteration it is computed as in (3.11). Please see * ICI Technical Report, November 9, 2011. sigma = 0.8d0 * -------------------------------- Main loop -------------------- *==================================================================== 110 continue *------------------------------------ STOP test section * ================= if(iter .eq. 0) go to 91 if(stoptest .eq. 1) then ginf=dabs(g(1)) do i=2,n5 if(dabs(g(i)) .gt. ginf) ginf = dabs(g(i)) end do do i=n6,n,5 if(dabs(g(i)) .gt. ginf) ginf = dabs(g(i)) if(dabs(g(i+1)) .gt. ginf) ginf = dabs(g(i+1)) if(dabs(g(i+2)) .gt. ginf) ginf = dabs(g(i+2)) if(dabs(g(i+3)) .gt. ginf) ginf = dabs(g(i+3)) if(dabs(g(i+4)) .gt. ginf) ginf = dabs(g(i+4)) end do if(ginf .le. epsg) go to 999 end if * if(stoptest .eq. 2) then if(gnorm .le. epsg) go to 999 end if * 91 continue *---------------------------------- Increment iteration section * =========================== iter = iter + 1 if(iter .gt. maxiter) go to 999 *---------------------------------- Line search section * =================== * * Determine the step length ALPHA and the new point XNEW, as well as * the function value in xnew, FNEW, and the gradient in xnew, GNEW. call LineSearch(n,x,f,d,gtd,dnorm,alpha,xnew,fnew,gnew, + sigma,fgcnt,lscnt,lsflag, n5,n6,nexp) if(fgcnt .gt. maxfg) go to 999 alpha = alpha * *---------------------------------- Acceleration section * ==================== * * (We use an/bn only if b is different from zero) * (an=gtd) bn=0.d0 do i = 1,n5 bn = bn + (g(i)-gnew(i))*d(i) end do do i = n6,n,5 bn= bn + (g(i)-gnew(i))*d(i)+ * (g(i+1)-gnew(i+1))*d(i+1)+ * (g(i+2)-gnew(i+2))*d(i+2)+ * (g(i+3)-gnew(i+3))*d(i+3)+ * (g(i+4)-gnew(i+4))*d(i+4) end do * if(dabs(bn) .gt. epsm) then do i=1,n5 xnew(i) = x(i) + (gtd/bn)*alpha*d(i) end do do i=n6,n,5 xnew(i) = x(i) + (gtd/bn)*alpha*d(i) xnew(i+1) = x(i+1) + (gtd/bn)*alpha*d(i+1) xnew(i+2) = x(i+2) + (gtd/bn)*alpha*d(i+2) xnew(i+3) = x(i+3) + (gtd/bn)*alpha*d(i+3) xnew(i+4) = x(i+4) + (gtd/bn)*alpha*d(i+4) end do call evalfg(n,xnew,fnew,gnew, nexp) fgcnt = fgcnt + 1 if(fgcnt .gt. maxfg) go to 999 end if * * *---------------------------------- Prepare some scalar products * ============================ * gtg = 0.d0 gtgp= 0.d0 ytg = 0.d0 stg = 0.d0 yts = 0.d0 sts = 0.d0 do i = 1,n5 s(i) = xnew(i) - x(i) y(i) = gnew(i) - g(i) ytg = ytg + gnew(i)*y(i) stg = stg + gnew(i)*s(i) yts = yts + y(i)*s(i) gtgp = gtgp + gnew(i)*g(i) x(i) = xnew(i) g(i) = gnew(i) gtg = gtg + g(i) * g(i) sts = sts + s(i) * s(i) end do do i = n6,n,5 s(i) = xnew(i) - x(i) s(i+1) = xnew(i+1) - x(i+1) s(i+2) = xnew(i+2) - x(i+2) s(i+3) = xnew(i+3) - x(i+3) s(i+4) = xnew(i+4) - x(i+4) y(i) = gnew(i) - g(i) y(i+1) = gnew(i+1) - g(i+1) y(i+2) = gnew(i+2) - g(i+2) y(i+3) = gnew(i+3) - g(i+3) y(i+4) = gnew(i+4) - g(i+4) ytg = ytg + gnew(i)*y(i)+gnew(i+1)*y(i+1)+gnew(i+2)*y(i+2)+ * gnew(i+3)*y(i+3)+gnew(i+4)*y(i+4) stg = stg + gnew(i)*s(i)+gnew(i+1)*s(i+1)+gnew(i+2)*s(i+2)+ * gnew(i+3)*s(i+3)+gnew(i+4)*s(i+4) yts = yts + y(i)*s(i)+y(i+1)*s(i+1)+y(i+2)*s(i+2)+ * y(i+3)*s(i+3)+y(i+4)*s(i+4) gtgp = gtgp + gnew(i)*g(i)+gnew(i+1)*g(i+1)+gnew(i+2)*g(i+2)+ * gnew(i+3)*g(i+3)+gnew(i+4)*g(i+4) sts = sts + s(i)*s(i)+s(i+1)*s(i+1)+s(i+2)*s(i+2)+ * s(i+3)*s(i+3)+s(i+4)*s(i+4) x(i) = xnew(i) x(i+1) = xnew(i+1) x(i+2) = xnew(i+2) x(i+3) = xnew(i+3) x(i+4) = xnew(i+4) g(i) = gnew(i) g(i+1) = gnew(i+1) g(i+2) = gnew(i+2) g(i+3) = gnew(i+3) g(i+4) = gnew(i+4) gtg = gtg + g(i)*g(i)+g(i+1)*g(i+1)+g(i+2)*g(i+2)+ * g(i+3)*g(i+3)+g(i+4)*g(i+4) end do * gnorm= sqrt( gtg ) * f = fnew dnormprev = dnorm * *--------------------------------- Sigma computation * ================= * * sigma = gtg/(dabs(ytg)+gtg) * * * * -------------------------------- Delta, Theta and Beta computation * ================================= * *1 Delta computation. (Delta bar) * delta = stg*ytg-gtg*yts * acc (conjugacy condition) (ak) * bdc (descent condition) (bk) acc = cc*stg + ytg bdc = dc*yts*gtg + ytg*stg * *2 Beta and theta computation * If |delta| is greater than epsilon machine, then compute * beta and theta by means of the algorithm. * Otherwise, set theta=1 and beta = 0. * * Now theta computation: if(dabs(delta) .gt. epsm) then theta = (acc/ytg)*(1.d0+yts*gtg/delta)-bdc/delta else theta = 1.d0 itheta=itheta+1 end if * * * Variants for beta computation * ============================= * * For beta computation we consider 3 possibilities: * * 1) beta as in algorithm DESCON, * 2) beta as suggested by Dai and Liao+ (i.e. similar to PRP+), * 3) beta truncated (see Hager and Zhang). * * * Therefore, the algorithm can be implemented in 4 variants as follows: * * a) (2.1),(2.2) and (2.12) for theta and (2.13) for beta computation. * * b) (2.1),(2.2) and (2.12) for theta and (7.29) for beta computation. * * c) (2.1),(2.2) and (2.12) for theta and (2.13) for beta comptation * with truncation. * * d) (2.1) (2.2) and (2.12) for theta and (7.29) for beta computation * with truncation. * * Please see ICI Technical Report, November 9, 2011. * * Numerical experiments proved that all these variants have similar * performances. * They do not improve significantly the performances of the algorithm. * However, variant a) is slightly better. * * if(yts .ne. 0.d0 .and. dabs(delta) .gt. epsm) then beta = ytg/yts-(bdc*ytg)/(yts*delta)+acc*gtg/delta cc beta = dmax1(ytg/yts,0.d0) - cc * (bdc*ytg)/(yts*delta) + cc * (acc*gtg)/delta cc beta = dmax1(beta,-1.d0/(dnorm*dmin1(0.1d0,gnorm))) else beta = 0.d0 ibeta=ibeta+1 end if * * * --------------------------------- Direction computation * ===================== * dnorm = 0.0d0 gtd = 0.0d0 do i = 1,n5 d(i) = -theta*g(i) + beta*s(i) dnorm = dnorm + d(i) ** 2 gtd = gtd + g(i) * d(i) end do do i = n6,n,5 d(i) =-theta * g(i) + beta * s(i) d(i+1) =-theta * g(i+1) + beta * s(i+1) d(i+2) =-theta * g(i+2) + beta * s(i+2) d(i+3) =-theta * g(i+3) + beta * s(i+3) d(i+4) =-theta * g(i+4) + beta * s(i+4) dnorm = dnorm + d(i)**2+d(i+1)**2+d(i+2)**2+ * d(i+3)**2+d(i+4)**2 gtd = gtd + g(i)*d(i)+g(i+1)*d(i+1)+g(i+2)*d(i+2)+ * g(i+3)*d(i+3)+g(i+4)*d(i+4) end do dnorm = sqrt( dnorm ) * *------------------------------------ END direction computation * * RESTART CRITERIA * ================ * * Angle Restart Test * if(angle) then if ( gtd .gt. -1.0d-03 * gnorm * dnorm ) then irs = irs + 1 do i = 1,n d(i) = -g(i) end do dnorm = gnorm gtd = -gtg end if end if * * Beale-Powell restart test * if(powell) then if(dabs(gtgp) .gt. 0.2d0*dabs(gtg)) then irs = irs + 1 do i = 1,n5 d(i) = -g(i) end do do i = n6,n,5 d(i) = -g(i) d(i+1) = -g(i+1) d(i+2) = -g(i+2) d(i+3) = -g(i+3) d(i+4) = -g(i+4) end do dnorm = gnorm gtd = -gtg end if end if *------------------------------------------ Prepare first trial * of steplength * =================== if(dnorm .ne. 0.d0) then alpha = alpha * dnormprev / dnorm else alpha = 1.d0 end if * go to 110 *------------------------------------------ End of main loop * ================ 999 continue * return end *-------------------------------------------- END DESCON subroutine c****************************************************************** subroutine LineSearch (n,x,f,d,gtd,dnorm,alpha,xnew,fnew,gnew, + sigma,fgcnt,lscnt,lsflag, n5,n6,nexp) C This is the one-dimensional line search used in CONMIN C SCALAR ARGUMENTS integer n,fgcnt,lscnt,lsflag, nexp double precision f,gtd,dnorm,alpha,fnew C ARRAY ARGUMENTS double precision x(n),d(n),xnew(n),gnew(n) C LOCAL SCALARS integer i,lsiter double precision alphap,alphatemp,fp,dp,gtdnew,a,b,sigma lsflag = 0 * Maximum number of LineSearch is max$ls (now=6) max$ls=8 alphap = 0.0d0 fp = f dp = gtd do i = 1,n5 xnew(i) = x(i) + alpha * d(i) end do do i = n6,n,5 xnew(i) = x(i) + alpha * d(i) xnew(i+1) = x(i+1) + alpha * d(i+1) xnew(i+2) = x(i+2) + alpha * d(i+2) xnew(i+3) = x(i+3) + alpha * d(i+3) xnew(i+4) = x(i+4) + alpha * d(i+4) end do c1 call evalfg(n,xnew,fnew,gnew, nexp) fgcnt = fgcnt + 1 gtdnew = 0.0d0 do i = 1,n5 gtdnew = gtdnew + gnew(i) * d(i) end do do i = n6,n,5 gtdnew = gtdnew + gnew(i)*d(i)+gnew(i+1)*d(i+1)+gnew(i+2)*d(i+2)+ * gnew(i+3)*d(i+3)+gnew(i+4)*d(i+4) end do lsiter = 0 10 if ( alpha * dnorm .gt. 1.0d-30 .and. lsiter .lt. max$ls .and. + .not. ( gtdnew .eq. 0.0d0 .and. fnew .lt. f ) .and. + ( ( fnew .gt. f + 1.0d-04 * alpha * gtd .or. + dabs( gtdnew / gtd ) .gt. sigma ) .or. ( lsiter .eq. 0 .and. + dabs( gtdnew / gtd ) .gt. 0.50d0 ) ) ) then 20 if ( alpha * dnorm .gt. 1.0d-30 .and. fnew .gt. f .and. + gtdnew .lt. 0.0d0 ) then alpha = alpha / 3.0d0 do i = 1,n5 xnew(i) = x(i) + alpha * d(i) end do do i = n6,n,5 xnew(i) = x(i) + alpha * d(i) xnew(i+1) = x(i+1) + alpha * d(i+1) xnew(i+2) = x(i+2) + alpha * d(i+2) xnew(i+3) = x(i+3) + alpha * d(i+3) xnew(i+4) = x(i+4) + alpha * d(i+4) end do c2 call evalfg(n,xnew,fnew,gnew, nexp) fgcnt = fgcnt + 1 gtdnew = 0.0d0 do i = 1,n5 gtdnew = gtdnew + gnew(i) * d(i) end do do i = n6,n,5 gtdnew = gtdnew + gnew(i)*d(i)+gnew(i+1)*d(i+1)+ * gnew(i+2)*d(i+2)+gnew(i+3)*d(i+3)+ * gnew(i+4)*d(i+4) end do alphap = 0.0d0 fp = f dp = gtd goto 20 end if a = dp + gtdnew - 3.0d0 * ( fp - fnew ) / ( alphap - alpha ) b = a ** 2 - dp * gtdnew if ( b .gt. 0.0d0 ) then b = sqrt( b ) else b = 0.0d0 end if alphatemp = alpha - ( alpha - alphap ) * ( gtdnew + b - a ) / + ( gtdnew - dp + 2.0d0 * b ) if ( gtdnew / dp .le. 0.0d0 ) then if ( 0.99d0 * max( alpha, alphap ) .lt. alphatemp .or. + alphatemp .lt. 1.01d0 * min( alpha, alphap ) ) then alphatemp = ( alpha + alphap ) / 2.0d0 end if else if ( gtdnew .lt. 0.0d0 .and. + alphatemp .lt. 1.01d0 * max( alpha, alphap ) ) then alphatemp = 2.0d0 * max( alpha, alphap ) end if if ( ( gtdnew .gt. 0.0d0 .and. + alphatemp .gt. 0.99d0 * min( alpha, alphap ) ) .or. + alphatemp .lt. 0.0d0 ) then alphatemp = min( alpha, alphap ) / 2.0d0 end if end if alphap = alpha fp = fnew dp = gtdnew alpha = alphatemp do i = 1,n5 xnew(i) = x(i) + alpha * d(i) end do do i = n6,n,5 xnew(i) = x(i) + alpha * d(i) xnew(i+1) = x(i+1) + alpha * d(i+1) xnew(i+2) = x(i+2) + alpha * d(i+2) xnew(i+3) = x(i+3) + alpha * d(i+3) xnew(i+4) = x(i+4) + alpha * d(i+4) end do c3 call evalfg(n,xnew,fnew,gnew, nexp) fgcnt = fgcnt + 1 gtdnew = 0.0d0 do i = 1,n5 gtdnew = gtdnew + gnew(i) * d(i) end do do i = n6,n,5 gtdnew = gtdnew + gnew(i)*d(i)+gnew(i+1)*d(i+1)+ * gnew(i+2)*d(i+2)+gnew(i+3)*d(i+3)+ * gnew(i+4)*d(i+4) end do lsiter = lsiter + 1 goto 10 end if if ( lsiter .ge. max$ls ) then lsflag = 1 end if if ( lsiter .ne. 0 ) then lscnt = lscnt + 1 end if return end *---------------------------------- End LineSearch subroutine *----------------------------------------------------------- * Date created : May 30, 1995 * Date last modified : May 30, 1995 * * Subroutine for execution time computation. * *----------------------------------------------------------- * subroutine exetim(tih,tim,tis,tic, tfh,tfm,tfs,tfc) * integer*4 tih,tim,tis,tic integer*4 tfh,tfm,tfs,tfc * integer*4 ti,tf integer*4 ch,cm,cs data ch,cm,cs/360000,6000,100/ * ti=tih*ch+tim*cm+tis*cs+tic tf=tfh*ch+tfm*cm+tfs*cs+tfc tf=tf-ti tfh=tf/ch tf=tf-tfh*ch tfm=tf/cm tf=tf-tfm*cm tfs=tf/cs tfc=tf-tfs*cs * return end *---------------------------------------------- End of EXETIM * * * *-----------------------------------------------------------------* * | Subroutine inipoint | * | =================== Final | * | | * |Subroutine for initial point specification. | * |This is a user subroutine: | * | | * | The calling sequence is: | * | | * | call inipoint(n,x,nexp) | * |where: | * | n (integer) the number of variables, | * | x (double) array with the initial point. | * | nexp (integer) parameter specifying the number of the | * | problem considered in a train of experiments. | * | | * | Please, see the paper: | * | N. Andrei, | * | An unconstrained optimization test functions collection, | * | Advanced Modeling and Optimization, vol. 10, No. 1, 2008, | * | pp. 147-161. | * | http://www.ici.ro/camo/journal/v10n1.htm | * | | * | Neculai Andrei | * *-----------------------------------------------------------------* ****************************************************************** subroutine inipoint(n,x, nexp) C This subroutine computes the initial point real*8 x(n) go to ( 1, 2, 3, 4, 5, 6, 7, 8, 9,10, * 11,12,13,14,15,16,17,18,19,20, * 21,22,23,24,25,26,27,28,29,30, * 31,32,33,34,35,36,37,38,39,40, * 41,42,43,44,45,46,47,48,49,50, * 51,52,53,54,55,56,57,58,59,60, * 61,62,63,64,65,66,67,68,69,70, * 71,72,73,74,75,76) nexp 1 continue c Freudenstein & Roth - FREUROTH (CUTE) i=1 991 x(i) = 0.5d0 x(i+1)= -2.d0 i=i+2 if(i.le.n) go to 991 return 2 continue c Trigonometric do i=1,n x(i) = 0.2d0 end do return 3 continue c Extended Rosenbrock SROSENBR (CUTE) i=1 993 x(i) = -1.2d0 x(i+1)= 1.d0 i=i+2 if(i.le.n) go to 993 return 4 continue c Extended White & Holst i=1 994 x(i) = -1.2d0 x(i+1)= 1.d0 i=i+2 if(i.le.n) go to 994 return 5 continue c Extended Beale i=1 995 x(i) = 1.d0 x(i+1)= 0.8d0 i=i+2 if(i.le.n) go to 995 return 6 continue c Penalty do i=1,n x(i) = float(i)/1000.d0 end do return 7 continue c Perturbed Quadratic do i=1,n x(i) = 0.5d0 end do return 8 continue c Raydan 1 do i=1,n x(i) = 1.d0 end do return 9 continue c Raydan 2 do i=1,n x(i) = 1.d0 end do return 10 continue c Diagonal 1 x(1)=0.d0 do i=2,n x(i) = 1.d0 end do return 11 continue c Diagonal 2 do i=1,n x(i) = 1.d0/float(i) end do return 12 continue c Diagonal 3 do i=1,n x(i) = 1.d0 end do return 13 continue c Hager do i=1,n x(i) = 1.d0 end do return 14 continue c Generalized Tridiagonal 1 do i=1,n x(i) = 2.d0 end do return 15 continue c Extended Tridiagonal 1 do i=1,n x(i) = 2.d0 end do return 16 continue c Extended Three Expo Terms do i=1,n x(i) = 0.1d0 end do return 17 continue c Generalized Tridiagonal 2 do i=1,n x(i) = -1.d0 end do return 18 continue c Diagonal 4 do i=1,n x(i) = 1.d0 end do return 19 continue c Diagonal 5 do i=1,n x(i) = 1.1d0 end do return 20 continue c Extended Himmelblau do i=1,n x(i) = 1.d0 end do return 21 continue c Generalized PSC1 i=1 9921 x(i) = 3.d0 x(i+1)= 0.001d0 i=i+2 if(i.le.n) go to 9921 return 22 continue c Extended PSC1 i=1 9922 x(i) = 3.d0 x(i+1)= 0.1d0 i=i+2 if(i.le.n) go to 9922 return 23 continue c Extended Powell i=1 9923 x(i) = 3.d0 x(i+1)= -1.d0 x(i+2)= 0.d0 x(i+3)= 1.d0 i=i+4 if(i.le.n) go to 9923 return 24 continue c Extended BD1 do i=1,n x(i) = 0.101d0 end do return 25 continue c Extended Maratos i=1 9925 x(i) = 1.1d0 x(i+1)= 0.1d0 i=i+2 if(i.le.n) go to 9925 return 26 continue c Extended Cliff i=1 9926 x(i) = 0.d0 x(i+1)= -0.1d0 i=i+2 if(i.le.n) go to 9926 return 27 continue c Quadratic Diagonal Perturbed do i=1,n x(i) = 0.5d0 end do return 28 continue c Extended Wood WOODS (CUTE) i=1 9928 x(i) = -3.d0 x(i+1)= -1.d0 x(i+2)= -3.d0 x(i+3)= -1.d0 i=i+4 if(i.le.n) go to 9928 return 29 continue c Extended Hiebert do i=1,n x(i) = 0.00001d0 end do return 30 continue c Quadratic QF1 do i=1,n x(i) = 1.d0 end do return 31 continue c Extended Quadratic Penalty QP1 do i=1,n x(i) = 1.d0 end do return 32 continue c Extended Quadratic Penalty QP2 do i=1,n x(i) = 1.d0 end do return 33 continue c Quadratic QF2 do i=1,n x(i) = 0.5d0 end do return 34 continue c Extended EP1 do i=1,n x(i) = 1.5d0 end do return 35 continue c Extended Tridiagonal 2 do i=1,n x(i) = 1.d0 end do return 36 continue c BDQRTIC (CUTE) do i=1,n x(i) = 1.d0 end do return 37 continue c TRIDIA (CUTE) do i=1,n x(i) = 1.d0 end do return 38 continue c ARWHEAD (CUTE) do i=1,n x(i) = 1.d0 end do return 39 continue c NONDIA (CUTE) do i=1,n x(i) = -1.d0 end do return 40 continue c NONDQUAR (CUTE) i=1 9940 x(i) = 1.d0 x(i+1)= 0.1d0 i=i+2 if(i.le.n) go to 9940 return 41 continue c DQDRTIC (CUTE) do i=1,n x(i) = 3.d0 end do return 42 continue c EG2 (CUTE) do i=1,n x(i) = 1.d0 end do return 43 continue c DIXMAANA (CUTE) do i=1,n x(i) = 2.d0 end do return 44 continue c DIXMAANB (CUTE) do i=1,n x(i) = 2.d0 end do return 45 continue c DIXMAANC (CUTE) do i=1,n x(i) = 2.001d0 end do return 46 continue c DIXMAANE (CUTE) do i=1,n x(i) = 2.d0 end do return 47 continue c Partial Perturbed Quadratic do i=1,n x(i) = 0.00001d0 end do return 48 continue c Broyden Tridiagonal do i=1,n x(i) = -1.d0 end do return 49 continue c Almost Perturbed Quadratic do i=1,n x(i) = 0.5d0 end do return 50 continue c Tridiagonal Perturbed Quadratic do i=1,n x(i) = 0.5d0 end do return 51 continue c EDENSCH (CUTE) do i=1,n x(i) = 0.0d0 end do return 52 continue c HIMMELBHA c HIMMELBH amortized i=1 9952 x(i) = 0.0d0 x(i+1)= 2.0d0 i=i+2 if(i.le.n) go to 9952 return 53 continue c STAIRCASE S1 do i=1,n x(i) = 1.0d0 end do return 54 continue c LIARWHD (CUTE) do i=1,n x(i) = 3.d0 end do return 55 continue c DIAGONAL 6 do i=1,n x(i) = 1.d0 end do return 56 continue c DIXON3DQ (CUTE) do i=1,n x(i) = -1.d0 end do return 57 continue c ENGVAL1 (CUTE) do i=1,n x(i) = 2.d0 end do return 58 continue c DENSCHNA (CUTE) do i=1,n x(i) = 2.d0 end do return 59 continue c DENSCHNC (CUTE) do i=1,n x(i) = 2.d0 end do return 60 continue c DENSCHNB (CUTE) do i=1,n x(i) = 1.d0 end do return 61 continue c DENSCHNF (CUTE) i=1 9961 x(i) = 2.d0 x(i+1)= 0.d0 i=i+2 if(i.le.n) go to 9961 return 62 continue c SINQUAD (CUTE) do i=1,n x(i) = 0.1d0 end do return 63 continue c BIGGSB1 (CUTE) do i=1,n x(i) = 0.d0 end do return 64 continue c Extended Block-Diagonal BD2 i=1 9964 x(i) = 1.5d0 x(i+1)= 2.d0 i=i+2 if(i.le.n) go to 9964 return 65 continue c Generalized quartic GQ1 do i=1,n x(i) = 1.d0 end do return 66 continue c DIAGONAL 7 do i=1,n x(i) = 0.d0 end do return 67 continue c DIAGONAL 8 do i=1,n x(i) = 1.d0 end do return 68 continue c Full Hessian do i=1,n x(i) = 1.d0 end do return 69 continue c SINCOS i=1 9969 x(i) = 3.d0 x(i+1)= 0.1d0 i=i+2 if(i.le.n) go to 9969 return 70 continue c Generalized quartic GQ2 i=1 9970 x(i) = -1.2d0 x(i+1)= 1.d0 i=i+2 if(i.le.n) go to 9970 return 71 continue c EXTROSNB (CUTE) i=1 9971 x(i) = -1.2d0 x(i+1)= 1.d0 i=i+2 if(i.le.n) go to 9971 return 72 continue c ARGLINB (CUTE) i=1 9972 x(i) = 0.001d0 x(i+1)= 0.002d0 i=i+2 if(i.le.n) go to 9972 return 73 continue c FLETCHCR (CUTE) do i=1,n x(i) = 0.5d0 end do return 74 continue c HIMMELBG (CUTE) do i=1,n x(i) = 1.5d0 end do return 75 continue c HIMMELBH (CUTE) i=1 9975 x(i) = 0.0d0 x(i+1)= 2.0d0 i=i+2 if(i.le.n) go to 9975 return 76 continue c DIAGONAL 9 (experiments) do i=1,n x(i) = 10.d0 end do return end c------------------------------------------------ End INIPOINT *************************************************************** * Date created: October 28, 2004* * * * Final * * * * TEST FUNCTIONS FOR UNCONSTRAINED OPTIMIZATION * * =============================================== * * * * 57 problems: October 28, 2004 * * 66 problems: March 29, 2005 * * 70 problems: April 28, 2005 * * 75 problems: April 19, 2006 * * * * Please see the paper: * * N. Andrei, "An unconstrained optimization test functions * * collection", Advanced Modeling and Optimization, vol.10, * * No.1, (2008) pp.147-161. * * http://www.ici.ro/camo/journal/v10n1.htm * * * * Neculai Andrei* *************************************************************** * subroutine evalfg(n,x,f,g, nexp) real*8 x(n), f, g(n) real*8 t1,t2,t3,t4, c, d real*8 s, temp(1000000), temp1, tsum, sum real*8 u(1000000), v(1000000), t(1000000) real*8 u1, v1, c1, c2 real*8 alpha, beta, gamma, delta integer k1, k2, k3, k4 * go to ( 1, 2, 3, 4, 5, 6, 7, 8, 9,10, * 11,12,13,14,15,16,17,18,19,20, * 21,22,23,24,25,26,27,28,29,30, * 31,32,33,34,35,36,37,38,39,40, * 41,42,43,44,45,46,47,48,49,50, * 51,52,53,54,55,56,57,58,59,60, * 61,62,63,64,65,66,67,68,69,70, * 71,72,73,74,75,76) nexp cF1 FREUROTH (CUTE) * Extended Freudenstein & Roth * * Initial Point: [0.5, -2, ...,0.5, -2]. * 1 continue f = 0.d0 j=1 do i=1,n/2 t1=-13.d0+x(2*i-1)+5.d0*x(2*i)*x(2*i)-x(2*i)**3-2.d0*x(2*i) t2=-29.d0+x(2*i-1)+x(2*i)**3+x(2*i)**2-14.d0*x(2*i) f = f + t1*t1 + t2*t2 g(j) =2.d0*(t1+t2) g(j+1)=2.d0*t1*(10.d0*x(2*i)-3.d0*x(2*i)*x(2*i)-2.d0) + * 2.d0*t2*(3.d0*x(2*i)*x(2*i)+2.d0*x(2*i)-14.d0) j=j+2 end do return c******************************************************************** cF2 Extended Trigonometric Function * * Initial Point: [0.2, 0.2, ....,0.2]. 2 continue s= float(n) do i=1,n s = s - dcos(x(i)) end do do i=1,n temp(i) = s + float(i)*(1.d0-dcos(x(i))) - dsin(x(i)) end do f = 0.d0 do i=1,n f = f + temp(i)**2 end do *-- s=0.d0 do i=1,n s = s + temp(i) end do do i=1,n g(i) = 2.d0*s*dsin(x(i)) + + 2.d0*temp(i)*(float(i)*dsin(x(i))-dcos(x(i))) end do return ************************************************************** cF3 SROSENBR (CUTE) * Extended Rosenbrock function * * Initial point: [-1.2, 1, -1.2, 1, ..........., -1.2, 1] 3 continue c=100.d0 f=0.d0 do i=1,n/2 f = f + c*(x(2*i)-x(2*i-1)**2)**2 + (1.d0-x(2*i-1))**2 end do * j=1 do i=1,n/2 g(j) = -4.d0*c*x(2*i-1)*(x(2*i)-x(2*i-1)**2) - * 2.d0*(1.d0-x(2*i-1)) g(j+1) = 2.d0*c*(x(2*i)-x(2*i-1)**2) j = j + 2 end do return c****************************************************************** cF4 Extended White & Holst function * * Initial point: [-1.2, 1, -1.2, 1, ..........., -1.2, 1] 4 continue c=100.d0 f=0.d0 do i=1,n/2 f = f + c*(x(2*i)-x(2*i-1)**3)**2 + (1.d0-x(2*i-1))**2 end do * j=1 do i=1,n/2 g(j) = -6.d0*c*x(2*i-1)*x(2*i-1)*(x(2*i)-x(2*i-1)**3) - * 2.d0*(1.d0-x(2*i-1)) g(j+1) = 2.d0*c*(x(2*i)-x(2*i-1)**3) j = j + 2 end do return c****************************************************************** * cF5 Extended Beale Function BEALE (CUTE) * * Initial Point: [1, 0.8, ...., 1, 0.8] *-------------------------------------------------------------- * 5 continue * f=0.d0 j=1 do i=1,n/2 t1=1.5d0 -x(2*i-1)+x(2*i-1)*x(2*i) t2=2.25d0 -x(2*i-1)+x(2*i-1)*x(2*i)*x(2*i) t3=2.625d0-x(2*i-1)+x(2*i-1)*x(2*i)*x(2*i)*x(2*i) f = f + t1*t1 + t2*t2 + t3*t3 *------------------------------------------------------ g(j) =2.d0*t1*(-1.d0+x(2*i)) + * 2.d0*t2*(-1.d0+x(2*i)**2) + * 2.d0*t3*(-1.d0+x(2*i)**3) g(j+1)=2.d0*t1*x(2*i-1) + * 2.d0*t2*2.d0*x(2*i-1)*x(2*i) + * 2.d0*t3*3.d0*x(2*i-1)*x(2*i)*x(2*i) j=j+2 end do * return cF6 Extended Penalty Function U52 (MatrixRom) * * Intial Point: [1,2,3,.....,n]. * 6 continue temp1=0.d0 do i=1,n temp1 = temp1 + x(i)**2 end do * f = (temp1 - 0.25d0)**2 do i=1,n-1 f = f + (x(i)-1.d0)**2 end do *---------------------- do i=1,n-1 g(i) = 2.d0*(x(i)-1.d0) + 4.d0*x(i)*(temp1-0.25d0) end do g(n) = 4.d0*x(n)*(temp1-0.25d0) return cF7 Perturbed Quadratic function * * Initial Point: [0.5, 0.5, ......, 0.5]. * 7 continue temp1 = 0.d0 do i=1,n temp1 = temp1 + x(i) end do f = temp1*temp1/100.d0 do i=1,n f = f + float(i)*x(i)**2 end do *----------------- do i=1,n g(i) = float(i) * 2.d0 * x(i) + temp1/50.d0 end do return cF8 Raydan 1 Function * * Initial point: [1, 1, ..., 1] 8 continue f=0.d0 do i=1,n f = f + float(i) * (dexp(x(i))-x(i)) / 10.d0 end do *------------- do i=1,n g(i) = float(i) * (dexp(x(i)) - 1.d0) / 10.d0 end do return cF9 Raydan 2 Function * * Initial Point: [1, 1, .....,1] * 9 continue f=0.d0 do i=1,n f = f + dexp(x(i)) - x(i) end do *-- do i=1,n g(i) = dexp(x(i)) - 1.d0 end do return cF10 Diagonal1 Function * * Initial Point: [0, 1 ....., 1] * 10 continue f=0.d0 do i=1,n f = f + dexp(x(i)) - x(i)*float(i) end do *-- do i=1,n g(i) = dexp(x(i)) - float(i) end do return cF11 Diagonal2 Function * * Initial Point: [1/1, 1/2, ....., 1/n] * 11 continue f=0.d0 do i=1,n f = f + dexp(x(i)) - x(i)/float(i) end do *-- do i=1,n g(i) = dexp(x(i)) - 1.d0/float(i) end do return cF12 Diagonal3 Function * * Initial Point: [1,1,...,1] 12 continue f=0.d0 do i=1,n f = f + dexp(x(i)) - float(i)*dsin(x(i)) end do *-- do i=1,n g(i) = dexp(x(i)) - float(i)*dcos(x(i)) end do return cF13 Hager Function * * Initial Point: [1,1,...,1] 13 continue f=0.d0 do i=1,n f = f + dexp(x(i)) - x(i)*sqrt(float(i)) end do *-- do i=1,n g(i) = dexp(x(i)) - sqrt(float(i)) end do return cF14 Generalized Tridiagonal-1 Function * * Initial Point: [2,2,...,2] 14 continue f=0.d0 do i=1,n-1 u(i) = x(i) + x(i+1) - 3.d0 v(i) = x(i) - x(i+1) + 1.d0 end do do i=1,n-1 f = f + u(i)**2 + v(i)**4 end do *--- g(1) = 2.d0*u(1) + 4.d0*v(1)**3 do i=2,n-1 g(i) = 2.d0*u(i-1) - 4.d0*v(i-1)**3 + 2.d0*u(i) + 4.d0*v(i)**3 end do g(n) = 2.d0*u(n-1) - 4.d0*v(n-1)**3 return cF15 Extended Tridiagonal-1 Function * * Initial Point: [2,2,...,2] 15 continue f=0.d0 do i=1,n/2 u(i) = x(2*i-1) + x(2*i) - 3.d0 v(i) = x(2*i-1) - x(2*i) + 1.d0 end do do i=1,n/2 f = f + u(i)**2 + v(i)**4 end do *-- j=1 do i=1,n/2 g(j) = 2.d0*u(i) + 4.d0*v(i)**3 g(j+1) = 2.d0*u(i) - 4.d0*v(i)**3 j=j+2 end do return cF16 Extended Three Exponential Terms * * Intial Point: [0.1,0.1,.....,0.1]. * 16 continue f=0.d0 j=1 do i=1,n/2 t1=x(j) + 3.d0*x(j+1) - 0.1d0 t2=x(j) - 3.d0*x(j+1) - 0.1d0 t3=-x(j) - 0.1d0 f = f + dexp(t1) + dexp(t2) + dexp(t3) *-- g(j) = dexp(t1) + dexp(t2) - dexp(t3) g(j+1) = 3.d0*dexp(t1) - 3.d0*dexp(t2) j=j+2 end do return cF17 Generalized Tridiagonal-2 * * Initial point: [-1, -1, .........., -1., -1] 17 continue f = 0.d0 u(1) = 5.d0*x(1)-3.d0*x(1)**2-x(1)**3-3.d0*x(2)+1.d0 do i=2,n-1 u(i)=5.d0*x(i)-3.d0*x(i)**2-x(i)**3-x(i-1)-3.d0*x(i+1)+1.d0 end do u(n)=5.d0*x(n)-3.d0*x(n)**2-x(n)**3-x(n-1)+1.d0 * do i=1,n f = f + u(i)**2 v(i) = 5.d0 -6.d0*x(i) -3.d0*x(i)**2 end do *----------------------------------------- Gradient g(1) = 2.d0*u(1)*v(1) - 2.d0*u(2) do i=2,n-1 g(i) = -6.d0*u(i-1) + 2.d0*u(i)*v(i) -2.d0*u(i+1) end do g(n) = -6.d0*u(n-1) + 2.d0*u(n)*v(n) return cF18 Diagonal4 Function * * Initial point: [1, 1, .........., 1., 1] 18 continue c=100.d0 f = 0.d0 do i=1,n/2 f = f + (x(2*i-1)**2 + c*x(2*i)**2)/2.d0 end do *-- j=1 do i=1,n/2 g(j) = x(2*i-1) g(j+1) = c*x(2*i) j=j+2 end do return cF19 Diagonal5 Function (MatrixRom) * * Initial point: [1.1, 1.1, .........., 1.1] 19 continue f = 0.d0 do i=1,n f = f + dlog( dexp(x(i)) + dexp(-x(i)) ) end do *-- do i=1,n g(i) = (dexp(x(i)) - dexp(-x(i)))/(dexp(x(i)) + dexp(-x(i))) end do return cF20 HIMMELBC (CUTE) * Extended Himmelblau Function * * Initial Point: [1, 1, ....., 1] 20 continue f=0.d0 j=1 do i=1,n/2 u1 = x(2*i-1)**2 + x(2*i) - 11.d0 v1 = x(2*i-1) + x(2*i)**2 - 7.d0 f = f + u1*u1 + v1*v1 *-- g(j) = 4.d0*u1*x(2*i-1) + 2.d0*v1 g(j+1) = 2.d0*u1 + 4.d0*v1*x(2*i) j=j+2 end do return cF21 Generalized PSC1 Function * * Initial point: [3, 0.1, ..., 3, 0.1] 21 continue f = 0.d0 do i=1,n-1 f = f + (x(i)**2 +x(i+1)**2 +x(i)*x(i+1))**2 * + (dsin(x(i)))**2 + (dcos(x(i+1)))**2 end do g(1)= 2.d0*(x(1)**2+x(2)**2+x(1)*x(2))*(2.d0*x(1)+x(2)) * +2.d0 * dsin(x(1)) * dcos(x(1)) do i=2,n-1 g(i) = 2.d0*(x(i-1)**2+x(i)**2+x(i-1)*x(i))*(2.d0*x(i)+x(i-1)) + +2.d0*(x(i)**2+x(i+1)**2+x(i)*x(i+1))*(2.d0*x(i)+x(i+1)) end do g(n) = 2.d0*(x(n-1)**2+x(n)**2+x(n-1)*x(n))*(2.d0*x(n)+x(n-1)) + -2.d0*dcos(x(n)) * dsin(x(n)) return cF22 Extended PSC1 Function * * Initial point: [3, 0.1, ..., 3, 0.1] 22 continue f = 0.d0 do i=1,n/2 f = f + (x(2*i-1)**2 +x(2*i)**2 +x(2*i-1)*x(2*i))**2 * + (dsin(x(2*i-1)))**2 + (dcos(x(2*i)))**2 end do * j=1 do i=1,n/2 g(j) = 2.d0*(x(2*i-1)**2+x(2*i)**2+x(2*i-1)*x(2*i)) * + (2.d0*x(2*i-1)+x(2*i)) + + 2.d0*(dsin(x(2*i-1)))*(dcos(x(2*i-1))) g(j+1) = 2.d0*(x(2*i-1)**2+x(2*i)**2+x(2*i-1)*x(2*i)) * + (2.d0*x(2*i)+x(2*i-1)) - + 2.d0*(dcos(x(2*i)))*(dsin(x(2*i))) j=j+2 end do return cF23 Extended Powell * * Initial Point: [3, -1, 0, 1, ......]. *------------------------------------------------------------------- * 23 continue f=0.d0 j=1 do i=1,n/4 t1= x(4*i-3) + 10.d0*x(4*i-2) t2= x(4*i-1) - x(4*i) t3= x(4*i-2) - 2.d0*x(4*i-1) t4= x(4*i-3) - x(4*i) f = f + t1*t1 + 5.d0*t2*t2 + t3**4 + 10.d0*t4**4 *- g(j) = 2.d0*t1 + 40.d0*t4**3 g(j+1)= 20.d0*t1 + 4.d0*t3**3 g(j+2)= 10.d0*t2 - 8.d0*t3**3 g(j+3)= -10.d0*t2 - 40.d0*t4**3 j=j+4 end do return cF24 Extended Block Diagonal BD1 Function * * Initial Point: [0.1, 0.1, ..., 0.1]. *------------------------------------------------------------------- * 24 continue f = 0.d0 j=1 do i=1,n/2 t1 = x(2*i-1)**2 + x(2*i)**2 - 2.d0 t2 = dexp(x(2*i-1)) - x(2*i) f = f + t1*t1 + t2*t2 g(j) = 4.d0*t1*x(2*i-1) + 2.d0*t2*dexp(x(2*i-1)-1.d0) g(j+1) = 4.d0*t1*x(2*i) - 2.d0*t2 j=j+2 end do return cF25 Extended Maratos Function * * Initial Point: [1.1, 0.1, ...,1.1, 0.1]. *------------------------------------------------------------------- * 25 continue c = 100.d0 f = 0.d0 j=1 do i=1,n/2 t1 = x(2*i-1)**2 + x(2*i)**2 - 1.d0 f = f + (x(2*i-1) + c*t1*t1) g(j) = 1.d0 + 4.d0 * c * t1 * x(2*i-1) g(j+1) = 4.d0 * c * t1 * x(2*i) j=j+2 end do return cF26 Extended Cliff CLIFF (CUTE) * * Initial Point: [0, -1, ......, 0, -1]. * 26 continue f=0.d0 j=1 do i=1,n/2 temp1 = (x(2*i-1)-3.d0)/100.d0 f = f+temp1*temp1-(x(2*i-1)-x(2*i))+dexp(20.d0*(x(2*i-1)-x(2*i))) g(j) = temp1/50.d0 - 1.d0 + 20.d0*dexp(20.d0*(x(2*i-1)-x(2*i))) g(j+1) = 1.d0 - 20.d0*dexp(20.d0*(x(2*i-1)-x(2*i))) j=j+2 end do return cF27 Quadratic Diagonal Perturbed Function * * Initial Point: [0.5, 0.5, ......, 0.5]. * 27 continue temp1 = 0.d0 do i=1,n temp1 = temp1 + x(i) end do f = temp1*temp1 do i=1,n f = f + (float(i)/100.d0) * x(i)**2 end do *-- do i=1,n g(i) = float(i) * x(i) / 50.d0 + 2.d0*temp1 end do return cF28 Extended Wood Function * WOODS (CUTE) * * Initial Point: [-3,-1,-3,-1,......] * 28 continue f=0.d0 j=1 do i=1,n/4 f = f + 100.d0*(x(4*i-3)**2-x(4*i-2))**2 * + (x(4*i-3)-1.d0)**2 * + 90.d0*(x(4*i-1)**2-x(4*i))**2 * + (1.d0-x(4*i-1))**2 * + 10.1d0*(x(4*i-2)-1.d0)**2 * + 10.1d0*(x(4*i) -1.d0)**2 * + 19.8d0*(x(4*i-2)-1.d0)*(x(4*i)-1.d0) g(j) = 400.d0*(x(4*i-3)**2-x(4*i-2))*x(4*i-3) * + 2.d0*(x(4*i-3)-1.d0) g(j+1) =-200.d0*(x(4*i-3)**2-x(4*i-2)) * + 20.2d0*(x(4*i-2)-1.d0) * + 19.8d0*(x(4*i)-1.d0) g(j+2) = 360.d0*(x(4*i-1)**2-x(4*i))*x(4*i-1) * - 2.d0*(1.d0-x(4*i-1)) g(j+3) =-180.d0*(x(4*i-1)**2-x(4*i)) * + 20.2d0*(x(4*i) -1.d0) * + 19.8d0*(x(4*i-2)-1.d0) j=j+4 end do return cF29 Extended Hiebert Function * * Initial Point: [0,0,...0]. 29 continue c1=10.d0 c2=500.d0 f = 0.d0 j=1 do i=1,n/2 f = f + (x(2*i-1)-c1)**2 + (x(2*i-1)*x(2*i)-c2)**2 g(j) = 2.d0*(x(2*i-1)-c1) * + 2.d0*(x(2*i-1)*x(2*i)-c2)*x(2*i) g(j+1) = 2.d0*(x(2*i-1)*x(2*i)-c2)*x(2*i-1) j=j+2 end do return cF30 Quadratic Function QF1 * * Initial Point: [1,1,...1]. 30 continue f = 0.d0 do i=1,n f = f + float(i)*x(i)*x(i) g(i) = float(i) * x(i) end do f = f/2.d0 f = f - x(n) g(n) = g(n) - 1.d0 return cF31 Extended Quadratic Penalty QP1 Function * * Initial Point: [1, 1, ......,1]. * 31 continue t1=0.d0 do i=1,n t1 = t1 + x(i)*x(i) end do t1 = t1 - 0.5d0 f = 0.d0 do i=1,n-1 f = f + (x(i)*x(i) - 2.d0)**2 g(i) = 4.d0*(x(i)*x(i)-2.d0)*x(i) + 4.d0*t1*x(i) end do f = f + t1*t1 g(n) = 4.d0*t1*x(n) return cF32 Extended Quadratic Penalty QP2 Function * * Initial Point: [1, 1, ......,1]. * 32 continue t1=0.d0 do i=1,n t1 = t1 + x(i)*x(i) end do t1 = t1 - 100.d0 f = 0.d0 do i=1,n-1 f = f + (x(i)*x(i) - dsin(x(i)))**2 g(i) = 2.d0*(x(i)*x(i)-dsin(x(i)))*(2.d0*x(i)-dcos(x(i))) * + 4.d0*t1*x(i) end do f = f + t1*t1 g(n) = 4.d0*t1*x(n) return cF33 A Quadratic Function QF2 * * Initial Point: [0.5, 0.5, ......,0.5]. * 33 continue f=0.d0 do i=1,n f = f + float(i)*(x(i)**2 - 1.d0)**2 end do f = f/2.d0 f = f - x(n) * do i=1,n g(i) = float(i)*2.d0*x(i)*(x(i)**2 - 1.d0) end do g(n) = g(n) - 1.d0 return cF34 Extended EP1 Function * * Initial Point: [1.5.,1.5.,...,1.5]. *------------------------------------------------------------------- * 34 continue * f=0.d0 j=1 do i=1,n/2 t1=dexp(x(2*i-1)-x(2*i)) - 5.d0 t2=x(2*i-1)-x(2*i) t3=x(2*i-1)-x(2*i)-11.d0 f = f + t1*t1 + (t2*t2)*(t3*t3) g(j) = 2.d0*t1*dexp(x(2*i-1)-x(2*i)) * + 2.d0*t2*t3*t3 * + 2.d0*t2*t2*t3 g(j+1) = - g(j) j=j+2 end do return cF35 Extended Tridiagonal-2 Function * * Initial Point: [1.,1.,...,1.]. *------------------------------------------------------------------- * 35 continue * c=0.1d0 f=0.d0 do i=1,n-1 f = f + (x(i)*x(i+1)-1.d0)**2 + c*(x(i)+1.d0)*(x(i+1)+1.d0) end do g(1) = 2.d0*(x(1)*x(2)-1.d0)*x(2) + c*(x(2)+1.d0) do i=2,n-1 g(i) = 2.d0*(x(i-1)*x(i)-1.d0)*x(i-1) + c*(x(i-1)+1.d0) + * 2.d0*(x(i)*x(i+1)-1.d0)*x(i+1) + c*(x(i+1)+1.d0) end do g(n) = 2.d0*(x(n-1)*x(n)-1.d0)*x(n-1) + c*(x(n-1)+1.d0) return cF36 BDQRTIC (CUTE) * * Initial point x0=[1.,1.,...,1.]. * * 36 continue * n4=n-4 f=0.d0 do i=1,n4 temp(i) = x(i)**2 + 2.d0*x(i+1)**2 + 3.d0*x(i+2)**2 * + 4.d0*x(i+3)**2 + 5.d0*x(n)**2 end do do i=1,n4 f = f + (-4.d0*x(i)+3.d0)**2 + temp(i)**2 end do * g(1) = -8.d0*(-4.d0*x(1)+3.d0) + * (4.d0*temp(1))*x(1) g(2) = -8.d0*(-4.d0*x(2)+3.d0) + * (8.d0*temp(1)+ 4.d0*temp(2))*x(2) g(3) = -8.d0*(-4.d0*x(3)+3.d0) + * (12.d0*temp(1)+ 8.d0*temp(2)+ 4.d0*temp(3))*x(3) g(4) = -8.d0*(-4.d0*x(4)+3.d0) + * (16.d0*temp(1)+12.d0*temp(2) +8.d0*temp(3)+ * 4.d0*temp(4))*x(4) do i=5,n4 g(i) = -8.d0*(-4.d0*x(i)+3.d0) + * (16.d0*temp(i-3)+12.d0*temp(i-2)+ * 8.d0*temp(i-1)+4.d0*temp(i))*x(i) end do g(n4+1) =(16.d0*temp(n4-2)+12.d0*temp(n4-1)+8.d0*temp(n4))*x(n4+1) g(n4+2) =(16.d0*temp(n4-1)+12.d0*temp(n4))*x(n4+2) g(n4+3) =(16.d0*temp(n4))*x(n4+3) tsum=0.d0 do i=1,n4 tsum = tsum + temp(i) end do g(n) = 20.d0*tsum*x(n) return cF37 TRIDIA (CUTE) * * Initial point x0=[1,1,...,1]. * * 37 continue * alpha=2.d0 beta=1.d0 gamma=1.d0 delta=1.d0 f=gamma*(delta*x(1)-1.d0)**2 do i=2,n f = f + float(i)*(alpha*x(i)-beta*x(i-1))**2 end do *--- g(1) = 2.d0*gamma*(delta*x(1)-1.d0)*delta - * 4.d0*(alpha*x(2)-beta*x(1))*beta do i=2,n-1 g(i) = 2.d0*float(i)*(alpha*x(i)-beta*x(i-1))*alpha - * 2.d0*float(i+1)*(alpha*x(i+1)-beta*x(i))*beta end do g(n) = 2.d0*float(n)*(alpha*x(n)-beta*x(n-1))*alpha return cF38 ARWHEAD (CUTE) * * Initial point x0=[1,1,...,1]. * * 38 continue f=0.d0 do i=1,n-1 f = f + (-4.d0*x(i)+3.d0) + (x(i)**2+x(n)**2)**2 end do do i=1,n-1 g(i) = -4.d0 + 4.d0*x(i)*(x(i)**2+x(n)**2) end do g(n) = 0.d0 do i=1,n-1 g(n) = g(n) + 4.d0*x(n)*(x(i)**2+x(n)**2) end do return cF39 * NONDIA (Shanno-78) (CUTE) * * Initial point x0=[-1,-1,...,-1]. * * 39 continue c=100.d0 f=(x(1)-1.d0)**2 + c*(x(1)-x(1)**2)**2 do i=2,n f = f + c*(x(1)-x(i)**2)**2 end do *-- g(1)=2.d0*(x(1)-1.d0) + 2.d0*c*(x(1)-x(1)**2)*(1.d0-2.d0*x(1)) do i=2,n g(1) = g(1) + 2.d0*c*(x(1)-x(i)**2) end do do i=2,n g(i) = -4.d0*c*x(i)*(x(1)-x(i)**2) end do return cF40 NONDQUAR (CUTE) * * Initial point x0=[1,-1,1,-1,...,]. * * 40 continue f = (x(1)-x(2))**2 + (x(n-1)+x(n))**2 do i=1,n-2 f = f + (x(i)+x(i+1)+x(n))**4 end do *-- g(1) = 2.d0*(x(1)-x(2))+4.d0*(x(1)+x(2)+x(n))**3 g(2) =-2.d0*(x(1)-x(2))+4.d0*(x(1)+x(2)+x(n))**3 + * 4.d0*(x(2)+x(3)+x(n))**3 do i=3,n-2 g(i) = 4.d0*(x(i-1)+x(i)+x(n))**3 + * 4.d0*(x(i)+x(i+1)+x(n))**3 end do g(n-1) = 4.d0*(x(n-2)+x(n-1)+x(n))**3 + * 2.d0*(x(n-1)+x(n)) g(n) = 2.d0*(x(n-1)+x(n)) do i=1,n-2 g(n) = g(n) + 4.d0*(x(i)+x(i+1)+x(n))**3 end do return cF41 DQDRTIC * * Initial point x0=[3,3,3...,3]. * * 41 continue c=100.d0 d=100.d0 f=0.d0 do i=1,n-2 f = f + (x(i)**2 + c*x(i+1)**2 + d*x(i+2)**2) end do *-- g(1) = 2.d0*x(1) g(2) = 2.d0*c*x(2) + 2.d0*x(2) do i=3,n-2 g(i) = 2.d0*(1.d0+d+c)*x(i) end do g(n-1) = 2.d0*(c+d)*x(n-1) g(n) = 2.d0*d*x(n) return cF42 EG2 (CUTE) * * Initial point x0=[1,1,1...,1]. * * 42 continue f=0.5d0*dsin(x(n)*x(n)) do i=1,n-1 f = f + dsin(x(1)+x(i)*x(i)-1.d0) end do *-- g(1)=(1.d0+2.d0*x(1))*dcos(x(1)+x(1)*x(1)-1.d0) do i=2,n-1 g(1) = g(1) + dcos(x(1)+x(i)*x(i)-1.d0) end do do i=2,n-1 g(i) = 2.d0*x(i)*dcos(x(1)+x(i)*x(i)-1.d0) end do g(n) = x(n)*dcos(x(n)*x(n)) return cF43 DIXMAANA (CUTE) * * Initial point x0=[2.,2.,2...,2.]. * 43 continue * alpha = 1.d0 beta = 0.d0 gamma = 0.125d0 delta = 0.125d0 k1 = 0 k2 = 0 k3 = 0 k4 = 0 m = n/3 f = 1.d0 do i=1,n f = f + alpha * x(i)*x(i)* ((float(i)/float(n))**k1) end do do i=1,n-1 f = f + beta*x(i)*x(i)*((x(i+1)+x(i+1)*x(i+1))**2) * * ((float(i)/float(n))**k2) end do do i=1,2*m f = f + gamma * x(i)*x(i) * (x(i+m)**4) * * ((float(i)/float(n))**k3) end do do i=1,m f = f + delta * x(i) * x(i+2*m) * * ((float(i)/float(n))**k4) end do *-- do i=1,n g(i) =0.d0 end do do i=1,n g(i) = g(i) + 2.d0*alpha*x(i)*((float(i)/float(n))**k1) end do do i=1,n-1 g(i) = g(i) + 2.d0*beta*x(i)*((x(i+1)+x(i+1)**2)**2)* * ((float(i)/float(n))**k2) g(i+1) = g(i+1) + beta*(x(i)**2)*2.d0*(x(i+1)+x(i+1)**2)* * (1.d0+2.d0*x(i+1))*((float(i)/float(n))**k2) end do do i=1,2*m g(i) = g(i) + 2.d0*gamma*x(i)*(x(i+m)**4)* * ((float(i)/float(n))**k3) g(i+m) = g(i+m) + gamma*(x(i)**2)*4.d0*(x(i+m)**3)* * ((float(i)/float(n))**k3) end do do i=1,m g(i) = g(i) + delta*x(i+2*m)*((float(i)/float(n))**k4) g(i+2*m) = g(i+2*m) + delta*x(i)*((float(i)/float(n))**k4) end do return cF44 DIXMAANB (CUTE) * * Initial point x0=[2.,2.,2...,2.]. * 44 continue * alpha = 1.d0 beta = 0.0625d0 gamma = 0.0625d0 delta = 0.0625d0 k1 = 0 k2 = 0 k3 = 0 k4 = 0 m = n/3 f = 1.d0 do i=1,n f = f + alpha * x(i)*x(i)* ((float(i)/float(n))**k1) end do do i=1,n-1 f = f + beta*x(i)*x(i)*((x(i+1)+x(i+1)*x(i+1))**2) * * ((float(i)/float(n))**k2) end do do i=1,2*m f = f + gamma * x(i)*x(i) * (x(i+m)**4) * * ((float(i)/float(n))**k3) end do do i=1,m f = f + delta * x(i) * x(i+2*m) * * ((float(i)/float(n))**k4) end do *-- do i=1,n g(i) =0.d0 end do do i=1,n g(i) = g(i) + 2.d0*alpha*x(i)*((float(i)/float(n))**k1) end do do i=1,n-1 g(i) = g(i) + 2.d0*beta*x(i)*((x(i+1)+x(i+1)**2)**2)* * ((float(i)/float(n))**k2) g(i+1) = g(i+1) + beta*(x(i)**2)*2.d0*(x(i+1)+x(i+1)**2)* * (1.d0+2.d0*x(i+1))*((float(i)/float(n))**k2) end do do i=1,2*m g(i) = g(i) + 2.d0*gamma*x(i)*(x(i+m)**4)* * ((float(i)/float(n))**k3) g(i+m) = g(i+m) + gamma*(x(i)**2)*4.d0*(x(i+m)**3)* * ((float(i)/float(n))**k3) end do do i=1,m g(i) = g(i) + delta*x(i+2*m)*((float(i)/float(n))**k4) g(i+2*m) = g(i+2*m) + delta*x(i)*((float(i)/float(n))**k4) end do return cF45 DIXMAANC (CUTE) * * Initial point x0=[2.,2.,2...,2.]. * 45 continue * alpha = 1.d0 beta = 0.125d0 gamma = 0.125d0 delta = 0.125d0 k1 = 0 k2 = 0 k3 = 0 k4 = 0 m = n/3 f = 1.d0 do i=1,n f = f + alpha * x(i)*x(i)* ((float(i)/float(n))**k1) end do do i=1,n-1 f = f + beta*x(i)*x(i)*((x(i+1)+x(i+1)*x(i+1))**2) * * ((float(i)/float(n))**k2) end do do i=1,2*m f = f + gamma * x(i)*x(i) * (x(i+m)**4) * * ((float(i)/float(n))**k3) end do do i=1,m f = f + delta * x(i) * x(i+2*m) * * ((float(i)/float(n))**k4) end do *-- do i=1,n g(i) =0.d0 end do do i=1,n g(i) = g(i) + 2.d0*alpha*x(i)*((float(i)/float(n))**k1) end do do i=1,n-1 g(i) = g(i) + 2.d0*beta*x(i)*((x(i+1)+x(i+1)**2)**2)* * ((float(i)/float(n))**k2) g(i+1) = g(i+1) + beta*(x(i)**2)*2.d0*(x(i+1)+x(i+1)**2)* * (1.d0+2.d0*x(i+1))*((float(i)/float(n))**k2) end do do i=1,2*m g(i) = g(i) + 2.d0*gamma*x(i)*(x(i+m)**4)* * ((float(i)/float(n))**k3) g(i+m) = g(i+m) + gamma*(x(i)**2)*4.d0*(x(i+m)**3)* * ((float(i)/float(n))**k3) end do do i=1,m g(i) = g(i) + delta*x(i+2*m)*((float(i)/float(n))**k4) g(i+2*m) = g(i+2*m) + delta*x(i)*((float(i)/float(n))**k4) end do return cF46 DIXMAANE (CUTE) * * Initial point x0=[2.,2.,2...,2.]. * 46 continue * alpha = 1.d0 beta = 0.d0 gamma = 0.125d0 delta = 0.125d0 k1 = 1 k2 = 0 k3 = 0 k4 = 1 m = n/3 f = 1.d0 do i=1,n f = f + alpha * x(i)*x(i)* ((float(i)/float(n))**k1) end do do i=1,n-1 f = f + beta*x(i)*x(i)*((x(i+1)+x(i+1)*x(i+1))**2) * * ((float(i)/float(n))**k2) end do do i=1,2*m f = f + gamma * x(i)*x(i) * (x(i+m)**4) * * ((float(i)/float(n))**k3) end do do i=1,m f = f + delta * x(i) * x(i+2*m) * * ((float(i)/float(n))**k4) end do *-- do i=1,n g(i) =0.d0 end do do i=1,n g(i) = g(i) + 2.d0*alpha*x(i)*((float(i)/float(n))**k1) end do do i=1,n-1 g(i) = g(i) + 2.d0*beta*x(i)*((x(i+1)+x(i+1)**2)**2)* * ((float(i)/float(n))**k2) g(i+1) = g(i+1) + beta*(x(i)**2)*2.d0*(x(i+1)+x(i+1)**2)* * (1.d0+2.d0*x(i+1))*((float(i)/float(n))**k2) end do do i=1,2*m g(i) = g(i) + 2.d0*gamma*x(i)*(x(i+m)**4)* * ((float(i)/float(n))**k3) g(i+m) = g(i+m) + gamma*(x(i)**2)*4.d0*(x(i+m)**3)* * ((float(i)/float(n))**k3) end do do i=1,m g(i) = g(i) + delta*x(i+2*m)*((float(i)/float(n))**k4) g(i+2*m) = g(i+2*m) + delta*x(i)*((float(i)/float(n))**k4) end do return cF47 Partial Perturbed Quadratic * * Initial point x0=[0.5, 0.5, ..., 0.5]. * 47 continue * temp(1) = x(1) + x(2) do i=2,n-1 temp(i) = temp(i-1) + x(i+1) end do f=x(1)*x(1) do i=2,n f = f + float(i)*x(i)*x(i) + temp(i-1)*temp(i-1)/100.d0 end do * g(1)= 2.d0*x(1) do i=1,n-1 g(1) = g(1) + temp(i)/50.d0 end do do i=2,n g(i) = 2.d0*float(i)*x(i) do j=i,n g(i) = g(i) + temp(j-1)/50.d0 end do end do return cF48 Broyden Tridiagonal * * Initial point x0=[-1., -1., ..., -1.]. * 48 continue * temp(1) = 3.d0*x(1) - 2.d0*x(1)*x(1) do i=2,n-1 temp(i) = 3.d0*x(i)-2.d0*x(i)*x(i)-x(i-1)-2.d0*x(i+1)+1.d0 end do temp(n) = 3.d0*x(n)-2.d0*x(n)*x(n)-x(n-1)+1.d0 f = 0.d0 do i=1,n f = f + temp(i)*temp(i) end do *---- g(1) = 2.d0*temp(1)*(3.d0-4.d0*x(1)) - 2.d0*temp(2) g(2) = 2.d0*temp(2)*(3.d0-4.d0*x(2)) - 2.d0*temp(3) do i=3,n-1 g(i) = -4.d0*temp(i-1) * +2.d0*temp(i)*(3.d0-4.d0*x(i)) * -2.d0*temp(i+1) end do g(n) = -4.d0*temp(n-1) + 2.d0*temp(n)*(3.d0-4.d0*x(n)) return cF49 Almost Perturbed Quadratic * * Initial point x0=[0.5, 0.5, ...,0.5]. * 49 continue * f = 0.01d0*(x(1)+x(n))**2 do i=1,n f = f + float(i)*x(i)*x(i) end do *- g(1) = 2.d0*x(1) + 0.02d0*(x(1)+x(n)) do i=2,n-1 g(i) = 2.d0*float(i)*x(i) end do g(n) = 2.d0*float(n)*x(n) + 0.02d0*(x(1)+x(n)) return cF50 Tridiagonal Perturbed Quadratic * * Initial point x0=[0.5, 0.5, ...,0.5]. * 50 continue * do i=1,n-2 temp(i) = x(i) + x(i+1) + x(i+2) end do f = x(1)*x(1) do i=2,n-1 f = f + float(i)*x(i)*x(i) + temp(i-1)**2 end do *-- g(1) = 2.d0*x(1) + 2.d0*temp(1) g(2) = 4.d0*x(2) + 2.d0*(temp(1)+temp(2)) do i=3,n-2 g(i) = 2.d0*float(i)*x(i) + 2.d0*(temp(i-2)+temp(i-1)+temp(i)) end do g(n-1) = 2.d0*float(n-1)*x(n-1) + 2.d0*(temp(n-3)+temp(n-2)) g(n) = 2.d0*temp(n-2) return cF51 EDENSCH Function (CUTE) * * Initial Point: [0., 0., ..., 0.]. 51 continue f = 16.d0 do i=1,n-1 f = f + (x(i)-2.d0)**4 + * (x(i)*x(i+1)-2.d0*x(i+1))**2 + * (x(i+1)+1.d0)**2 end do * g(1) = 4.d0*(x(1)-2.d0)**3 + 2.d0*x(2)*(x(1)*x(2)-2.d0*x(2)) * do i=2,n-1 g(i) = 2.d0*(x(i-1)*x(i)-2.d0*x(i))*(x(i-1)-2.d0) + * 2.d0*(x(i)+1.d0) + * 4.d0*(x(i)-2.d0)**3 + * 2.d0*x(i+1)*(x(i)*x(i+1)-2.d0*x(i+1)) end do g(n) = 2.d0*(x(n-1)*x(n)-2.d0*x(n))*(x(n-1)-2.d0) + * 2.d0*(x(n)+1.d0) return cF52 HIMMELBHA * * Initial point: [0, 2,0, 2, ...., 0, 2] 52 continue f=0.d0 do i=1,n/2 f=f+(-3.d0*x(2*i-1)-2.d0*x(2*i)+2.d0+x(2*i-1)**3+x(2*i)**3)* * (dexp(-x(2*i-1)-x(2*i))) end do *-- j=1 do i=1,n/2 g(j) = (-3.d0+3.d0*x(2*i-1)**2)*(dexp(-x(2*i-1)-x(2*i))) - * (-3.d0*x(2*i-1)-2.d0*x(2*i)+2.d0+x(2*i-1)**3+x(2*i)**3)* * (dexp(-x(2*i-1)-x(2*i))) g(j+1)=(-2.d0+3.d0*x(2*i)**2)*(dexp(-x(2*i-1)-x(2*i))) - * (-3.d0*x(2*i-1)-2.d0*x(2*i)+2.d0+x(2*i-1)**3+x(2*i)**3)* * (dexp(-x(2*i-1)-x(2*i))) j=j+2 end do return cF53 STAIRCASE S1 * * Initial point x0=[1,1,...,1]. * 53 continue f=0.d0 do i=1,n-1 f = f + (x(i)+x(i+1)-float(i))**2 end do c g(1) = 2.d0*(x(1)+x(2)-1.d0) do i=2,n-1 g(i) = 2.d0*(x(i-1)+x(i)-float(i-1)) + * 2.d0*(x(i)+x(i+1)-float(i)) end do g(n) = 2.d0*(x(n-1)+x(n)-float(n-1)) return cF54 LIARWHD (CUTE) * * Initial point x0=[4., 4., ....4.]. * 54 continue f=0.d0 do i=1,n f = f + 4.d0*(x(i)*x(i) - x(1))**2 + (x(i)-1.d0)**2 end do *-- g(1) = 2.d0*(x(1)-1.d0) + 8.d0*(x(1)*x(1)-x(1))*(2.d0*x(1)-1.d0) do i=2,n g(1) = g(1) - 8.d0*(x(i)*x(i)-x(1)) end do do i=2,n g(i) = 16.d0*x(i)*(x(i)*x(i)-x(1)) + 2.d0*(x(i)-1.d0) end do return cF55 DIAGONAL 6 * * Initial point x0=[1.,1., ..., 1.]. * 55 continue f = 0.d0 do i=1,n f = f + dexp(x(i)) - (1.d0+x(i)) end do *- do i=1,n g(i) = dexp(x(i)) - 1.d0 end do return cF56 DIXON3DQ (CUTE) * * Initial Point x0=[-1, -1,..., -1] March 7, 2005 * 56 continue f=(x(1)-2.d0)**2 do i=1,n-1 f = f + (x(i)-x(i+1))**2 end do f = f + (x(n)-1.d0)**2 c g(1) = 2.d0*(x(1)-2.d0) + 2.d0*(x(1)-x(2)) do i=2,n-1 g(i) = -2.d0*(x(i-1)-x(i)) + 2.d0*(x(i)-x(i+1)) end do g(n) = -2.d0*(x(n-1)-x(n)) + 2.d0*(x(n)-1.d0) return cF57 ENGVAL1 (CUTE) * * Initial point x0=[2.,2.,2...,2.]. * 57 continue do i=1,n-1 t(i) = x(i)*x(i) + x(i+1)*x(i+1) end do f = 0.d0 do i=1,n-1 f = f + t(i)*t(i) + (-4.d0*x(i) + 3.d0) end do c g(1) = 4.d0*x(1)*t(1) - 4.d0 do i=2,n-1 g(i) = 4.d0*x(i)*t(i-1) + 4.d0*x(i)*t(i) - 4.d0 end do g(n) = 4.d0*x(n)*t(n-1) return cF58 DENSCHNA (CUTE) * * Initial point: [2,2,...,2] * 58 continue f=0.d0 do i=1,n/2 f = f + x(2*i-1)**4 + * (x(2*i-1)+x(2*i))**2 + * (-1.d0+dexp(x(2*i)))**2 end do c j=1 do i=1,n/2 g(j) = 4.d0*x(2*i-1)**3 + 2.d0*(x(2*i-1)+x(2*i)) g(j+1) = 2.d0*(x(2*i-1)+x(2*i)) + * 2.d0*(dexp(x(2*i)))*(-1.d0+dexp(x(2*i))) j=j+2 end do return cF59 DENSCHNC (CUTE) * * Initial point: [2,2,...,2] 59 continue f=0.d0 do i=1,n/2 f = f + (-2.d0+x(2*i-1)**2+x(2*i)**2)**2 + * (-2.d0+dexp(x(2*i-1)-1.d0)+x(2*i)**3)**2 end do c j=1 do i=1,n/2 g(j) = 4.d0*x(2*i-1)*(-2.d0+x(2*i-1)**2+x(2*i)**2)+ * 2.d0*dexp(x(2*i-1)-1.d0)*(-2.d0+dexp(x(2*i-1)-1.d0)+x(2*i)**3) g(j+1) = 4.d0*x(2*i)*(-2.d0+x(2*i-1)**2+x(2*i)**2)+ * 6.d0*(x(2*i)**2)*(-2.d0+dexp(x(2*i-1)-1.d0)+x(2*i)**3) j=j+2 end do return cF60 DENSCHNB (CUTE) * * Initial point: [1,1,...,1] 60 continue f=0.d0 do i=1,n/2 f = f + (x(2*i-1)-2.d0)**2 + * ((x(2*i-1)-2.d0)**2)*(x(2*i)**2) + * (x(2*i)+1.d0)**2 end do c j=1 do i=1,n/2 g(j) = 2.d0*(x(2*i-1)-2.d0) + 2.d0*(x(2*i-1)-2.d0)*x(2*i)*x(2*i) g(j+1) = ((x(2*i-1)-2.d0)**2)*2.d0*x(2*i) + 2.d0*(x(2*i)+1.d0) j=j+2 end do return cF61 DENSCHNF (CUTE) * * Initial point: [2,0,2,0,...,2,0] 61 continue f=0.d0 do i=1,n/2 f=f+(2.d0*(x(2*i-1)+x(2*i))**2+(x(2*i-1)-x(2*i))**2-8.d0)**2+ * (5.d0*x(2*i-1)**2+(x(2*i)-3.d0)**2-9.d0)**2 end do c j=1 do i=1,n/2 g(j)=2.d0*(2.d0*(x(2*i-1)+x(2*i))**2+(x(2*i-1)-x(2*i))**2-8.d0)* * (4.d0*(x(2*i-1)+x(2*i))+2.d0*(x(2*i-1)-x(2*i))) + * 2.d0*(5.d0*x(2*i-1)**2+(x(2*i)-3.d0)**2-9.d0)*10.d0*x(2*i-1) g(j+1)=2.d0*(2.d0*(x(2*i-1)+x(2*i))**2+(x(2*i-1)-x(2*i))**2-8.d0)* * (4.d0*(x(2*i-1)+x(2*i))-2.d0*(x(2*i-1)-x(2*i))) + * 2.d0*(5.d0*x(2*i-1)**2+(x(2*i)-3.d0)**2-9.d0)*2.d0*(x(2*i)-3.d0) j=j+2 end do return cF62 SINQUAD (CUTE) * * Initial Point: [0.1, 0.1, ..., 0.1] 62 continue f=(x(1)-1.d0)**4 + (x(n)**2-x(1)**2)**2 do i=1,n-2 t(i) = sin(x(i+1)-x(n)) - x(1)**2 + x(i+1)**2 f = f + t(i)*t(i) end do c g(1) = 4.d0*(x(1)-1.d0)**3 - 4.d0*x(1)*(x(n)**2-x(1)**2) do i=1,n-2 g(1) = g(1) - 4.d0*t(i)*x(1) end do do i=2,n-1 g(i) = 2.d0*t(i-1)*(cos(x(i)-x(n))+2.d0*x(i)) end do g(n) = 4.d0*x(n)*(x(n)**2-x(1)**2) do i=1,n-2 g(n) = g(n) - 2.d0*t(i)*cos(x(i+1)-x(n)) end do return cF63 BIGGSB1 (CUTE) * * Initial Point: [0., 0., ....,0.] 63 continue f=(x(1)-1.d0)**2 + (1.d0-x(n))**2 do i=2,n f = f + (x(i)-x(i-1))**2 end do c g(1) = 4.d0*x(1) - 2.d0*x(2) - 2.d0 do i=2,n-1 g(i) = 4.d0*x(i) - 2.d0*x(i-1) - 2.d0*x(i+1) end do g(n) = 4.d0*x(n) - 2.d0*x(n-1) - 2.d0 return cF64 Extended Block-Diagonal BD2 * * Initial Point: [1.5, 2, ..., 1.5, 2] 64 continue f = 0.d0 do i=1,n/2 f = f + (x(2*i-1)**2 + x(2*i)**2 - 2.d0)**2 + * (dexp(x(2*i-1)-1.d0) + x(2*i)**3 - 2.d0)**2 end do c j=1 do i=1,n/2 t1 = x(2*i-1)**2 + x(2*i)**2 - 2.d0 t2 = dexp(x(2*i-1)-1.d0)+x(2*i)**3-2.d0 g(j) = 4.d0*x(2*i-1)*t1 + 2.d0*t2*dexp(x(2*i-1)-1.d0) g(j+1)= 4.d0*x(2*i)*t1 + 6.d0*x(2*i)*x(2*i)*t2 j=j+2 end do return cF65 Generalized quartic GQ1 function * * Initial Point: [1,1,...,1] 65 continue f = 0.d0 do i=1,n-1 f = f + x(i)*x(i) + (x(i+1)+x(i)*x(i))**2 end do c g(1) = 2.d0*x(1) + 4.d0*(x(2)+x(1)*x(1))*x(1) do i=2,n-1 g(i) = 2.d0*(x(i)+x(i-1)**2) + 2.d0*x(i) + * 4.d0*(x(i+1)+x(i)*x(i))*x(i) end do g(n) = 2.d0*(x(n)+x(n-1)**2) return cF66 Diagonal 7 * * Initial point: [1,1,...,1] 66 continue f=0.d0 do i=1,n f = f + dexp(x(i)) - 2.d0*x(i) - x(i)*x(i) end do c do i=1,n g(i) = dexp(x(i)) - 2.d0 - 2.d0*x(i) end do return cF67 Diagonal 8 * * Initial Point: [1,1,...,1] 67 continue f=0.d0 do i=1,n f = f + x(i)*dexp(x(i)) - 2.d0*x(i) - x(i)*x(i) end do c do i=1,n g(i) = dexp(x(i)) + x(i)*dexp(x(i)) - 2.d0 - 2.d0*x(i) end do return cF68 Full Hessian * * Initial Point: [1,1,...,1] 68 continue sum=0.d0 do i=1,n sum = sum + x(i) end do f = sum*sum do i=1,n f = f + x(i)*dexp(x(i)) - 2.d0*x(i) - x(i)*x(i) end do c do i=1,n g(i) = dexp(x(i)) + x(i)*dexp(x(i)) - * 2.d0 - 2.d0*x(i) + 2.d0*sum end do return cF69 SINCOS * * Initial Point: [3, 0.1, 3, 0.1, ..., 3, 0.1] 69 continue f= 0.d0 do i=1,n/2 f = f + (x(2*i-1)**2 + x(2*i)**2 + x(2*i-1)*x(2*i))**2 + * (dsin(x(2*i-1)))**2 + (dcos(x(2*i)))**2 end do c j=1 do i=1,n/2 s = x(2*i-1)**2 + x(2*i)**2 + x(2*i-1)*x(2*i) g(j) = 2.d0*s*(2.d0*x(2*i-1)+x(2*i)) + * 2.d0*dsin(x(2*i-1))*dcos(x(2*i-1)) g(j+1) = 2.d0*s*(2.d0*x(2*i)+x(2*i-1)) - * 2.d0*dcos(x(2*i))*dsin(x(2*i)) j=j+2 end do return cF70 Generalized quartic GQ2 function * * Initial Point: [1,1,...,1] 70 continue f= (x(1)*x(1)-1.d0)**2 do i=2,n f = f + (x(i)*x(i) - x(i-1) - 2.d0)**2 end do c g(1) = 4.d0*x(1)*(x(1)*x(1)-1.d0) - 2.d0*(x(2)**2-x(1)-2) do i=2,n-1 g(i) = 4.d0*x(i)*(x(i)**2-x(i-1)-2.d0) - * 2.d0*(x(i+1)**2 - x(i) - 2.d0) end do g(n) = 4.d0*x(n)*(x(n)**2-x(n-1)-2.d0) return cF71 EXTROSNB (CUTE) * * Initial Point: [1,1,...,1] 71 continue f = (x(1)-1.d0)**2 do i=2,n f = f + 100.d0*(x(i)-x(i-1)**2)**2 end do c g(1) = 2.d0*(x(1)-1.d0)-400.d0*x(1)*(x(2)-x(1)**2) do i=2,n-1 g(i) = 200.d0*(x(i)-x(i-1)**2)-400.d0*x(i)*(x(i+1)-x(i)**2) end do g(n) = 200.d0*(x(n)-x(n-1)**2) return cF72 ARGLINB (CUTE) * * Initial Point: [0.01,0.001,...,0.01,0.001] 72 continue m=2 f=0.d0 do i=1,m u(i)=0.d0 do j=1,n u(i) = u(i) + float(i)*float(j)*x(j) end do f = f + (u(i)-1.d0)**2 end do c do j=1,n g(j) = 0.d0 do i=1,m g(j) = g(j) + 2.d0*(u(i)-1.d0)*float(i)*float(j) end do end do return cF73 FLETCHCR (CUTE) * * Initial Point: [0.5,0.5,...0.5] 73 continue f=0.d0 do i=1,n-1 f = f + 100.d0*(x(i+1)-x(i)+1.d0-x(i)*x(i))**2 end do c g(1) = 200.d0*(x(2)-x(1)+1.d0-x(1)*x(1))*(-1.d0-2.d0*x(1)) do i=2,n-1 g(i) = 200.d0*(x(i)-x(i-1)+1.d0-x(i-1)*x(i-1))+ * 200.d0*(x(i+1)-x(i)+1.d0-x(i)*x(i))*(-1.d0-2.d0*x(i)) end do g(n) = 200.d0*(x(n)-x(n-1)+1.d0-x(n-1)**2) return cF74 HIMMELBG (CUTE) * * Initial Point: [1.5,1.5,...,1.5] 74 continue f=0.d0 do i=1,n/2 f = f + (2.d0*x(2*i-1)**2+3.d0*x(2*i)**2)* * (dexp(-x(2*i-1)-x(2*i))) end do c j=1 do i=1,n/2 t1 = 2.d0*x(2*i-1)**2+3.d0*x(2*i)**2 t2 = dexp(-x(2*i-1)-x(2*i)) g(j) = 4.d0*x(2*i-1)*t2 - t1*t2 g(j+1) = 6.d0*x(2*i)*t2 - t1*t2 j=j+2 end do return cF75 HIMMELBH (CUTE) * * Initial Point: [1.5,1.5,...,1.5] 75 continue f= 0.d0 do i=1,n/2 f=f+(-3.d0*x(2*i-1)-2.d0*x(2*i)+2.d0+x(2*i-1)**3 + x(2*i)**2) end do c j=1 do i=1,n/2 g(j) = -3.d0 + 3.d0*x(2*i-1)**2 g(j+1) = -2.d0 + 2.d0*x(2*i) j=j+2 end do return cF76 DIAGONAL 9 (experiments) * * Initial point: [1,1,...,1] 76 continue f=0.d0 do i=1,n f = f + (x(i)-float(i))**2 end do *-- do i=1,n g(i) = 2.d0*(x(i)-float(i)) end do return end C---------------------------------- EVALFG subroutine - last line C Neculai Andrei C Last line DESCON package C================================================================ * Last Line