CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C This is an example call of MIDACO 6.0 C ------------------------------------- C C MIDACO solves Multi-Objective Mixed-Integer Non-Linear Problems: C C C Minimize F_1(X),... F_O(X) where X(1,...N-NI) is CONTINUOUS C and X(N-NI+1,...N) is DISCRETE C C subject to G_j(X) = 0 (j=1,...ME) equality constraints C G_j(X) >= 0 (j=ME+1,...M) inequality constraints C C and bounds XL <= X <= XU C C C The problem statement of this example is given below. You can use C this example as template to run your own problem. To do so: Replace C the objective functions 'F' (and in case the constraints 'G') given C here with your own problem and follow the below instruction steps. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCCCCCCCCCCC MAIN PROGRAM CCCCCCCCCCCCCCCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC PROGRAM MAIN IMPLICIT NONE CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C Dimensions of the optimization problem INTEGER O, N, NI, M, ME C Lower and upper bounds ('XL' & 'XU') and optimization variable 'X' DOUBLE PRECISION XL(1000), XU(1000), X(1000) C Objectives 'F(X)' and constraints 'G(X)' DOUBLE PRECISION F(10), G(1000) C MIDACO information and stop flags INTEGER IFLAG, ISTOP C MIDACO parameter DOUBLE PRECISION PARAM(13) C MIDACO integer 'IW' and real'RW' workspace and pareto front 'PF' INTEGER LIW, LRW, LPF PARAMETER (LIW = 50000, LRW = 50000, LPF = 50000) INTEGER IW(LIW) DOUBLE PRECISION RW(LRW),PF(LPF) C Parameter for stopping criteria, printing and license INTEGER MAXTIME, MAXEVAL, PRINTEVAL, SAVE2FILE, I CHARACTER*60 KEY KEY='************************************************************' CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CCC Step 1: Problem definition CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C Step 1.A : Problem dimensions C CCCCCCCCCCCCCCCCCCCCCCCCCCCCC O = 1 ! Number of objectives N = 66 ! Number of variables (in total) NI = 12 ! Number of integer variables (0 <= NI <= N) M = 33 ! Number of constraints (in total) ME = 21 ! Number of equality constraints (0 <= ME <= M) C C Step 1.B : Lower and upper bounds: 'XL' and 'XU' C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC DO I = 1,n-ni XL(I) = 0.0D0 XU(I) = 1.0D3 ENDDO DO I = n-ni+1,n XL(I) = 0.0D0 XU(I) = 1.0D0 ENDDO C C Step 1.C : Starting point 'X' C CCCCCCCCCCCCCCCCCCCCCCCCCCCCC DO I = 1,N X(I) = XL(I) ! Here for example: starting point = lower bounds ENDDO CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CCC Step 2: Choose stopping criteria and printing options CCCCCCCCCCC CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C Step 2.A : Stopping criteria C CCCCCCCCCCCCCCCCCCCCCCCCCCCC MAXEVAL = 999999999 ! Maximum evaluation budget (e.g. 1000000) MAXTIME = 60*60*24 ! Maximum time limit (e.g. 60*60*24 = 1 Day) C C Step 2.B : Printing options C CCCCCCCCCCCCCCCCCCCCCCCCCCC PRINTEVAL = 50000 ! Print-Frequency for current best solution (e.g. 1000) SAVE2FILE = 1 ! Save SCREEN and SOLUTION to TXT-files [0=NO/1=YES] CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CCC Step 3: Choose MIDACO parameters (FOR ADVANCED USERS) CCCCCCCCCCC CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC PARAM( 1) = 0.01D0 ! ACCURACY PARAM( 2) = 0.0D0 ! SEED PARAM( 3) = 331837498.19999999d0 ! FSTOP PARAM( 4) = 0.0D0 ! ALGOSTOP PARAM( 5) = 0.0D0 ! EVALSTOP PARAM( 6) = 0.0D0 ! FOCUS PARAM( 7) = 0.0D0 ! ANTS PARAM( 8) = 0.0D0 ! KERNEL PARAM( 9) = 0.0D0 ! ORACLE PARAM(10) = 0.0D0 ! PARETOMAX PARAM(11) = 0.0D0 ! EPSILON PARAM(12) = 0.0D0 ! BALANCE PARAM(13) = 0.0D0 ! CHARACTER CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C Call MIDACO by Reverse Communication C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C Print MIDACO headline with basic information CALL MIDACO_PRINT(1,PRINTEVAL,SAVE2FILE,IFLAG,ISTOP,F,G,X,XL, & XU,O,N,NI,M,ME,RW,PF,MAXEVAL,MAXTIME,PARAM,1,0,KEY) DO WHILE(ISTOP.EQ.0) !~~~Start~of~reverse~communication~loop C Evaluate Objective F(X) and constraints G(X) CALL PROBLEM_FUNCTION( F, G , X) C Call MIDACO CALL MIDACO(1,O,N,NI,M,ME,X,F,G,XL,XU,IFLAG, & ISTOP,PARAM,RW,LRW,IW,LIW,PF,LPF,KEY) C Call MIDACO printing routine CALL MIDACO_PRINT(2,PRINTEVAL,SAVE2FILE,IFLAG,ISTOP,F,G,X, & XL,XU,O,N,NI,M,ME,RW,PF,MAXEVAL,MAXTIME,PARAM,1,0,KEY) ENDDO !~~~~~~~~~~~~~~~~~~~~End~of~reverse~communication~loop CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ! PRINT*," Solution F(1) = ", F(1) ! PRINT*," Solution G(1) = ", G(1) ! PRINT*," Solution X(1) = ", X(1) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCCCCCCCCCCCCCC END OF MAIN CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCCCCCCCC OPTIMIZATION PROBLEM CCCCCCCCCCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC SUBROUTINE PROBLEM_FUNCTION(F,G,X) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC IMPLICIT NONE CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC DOUBLE PRECISION F(*),G(*),X(*) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC double precision y(54), sqr, eps, / x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, / x11, x12, x13, x14, x15, x16, x17, x18, x19,x20, / x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, / x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, / x41, x42, x43, x44, x45, x46, x47, x48, x49, x50, / x51, x52, x53, x54, b55, b56, b57, b58, b59, b60, / b61, b62, b63, b64, b65, b66, / e2, e3, e4, e5, e6, e7, e8, e9, e10, / e11, e12, e13, e14, e15, e16, e17, e18, e19, e20, / e21, e22, e23, e24, e25, e26, e27, e28, e29, e30, / e31, e32, e33, e34 integer i CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC do i=1,12 y(i) = x(54+i) end do x1 = x(1) x2 = x(2) x3 = x(3) x4 = x(4) x5 = x(5) x6 = x(6) x7 = x(7) x8 = x(8) x9 = x(9) x10 = x(10) x11 = x(11) x12 = x(12) x13 = x(13) x14 = x(14) x15 = x(15) x16 = x(16) x17 = x(17) x18 = x(18) x19 = x(19) x20 = x(20) x21 = x(21) x22 = x(22) x23 = x(23) x24 = x(24) x25 = x(25) x26 = x(26) x27 = x(27) x28 = x(28) x29 = x(29) x30 = x(30) x31 = x(31) x32 = x(32) x33 = x(33) x34 = x(34) x35 = x(35) x36 = x(36) x37 = x(37) x38 = x(38) x39 = x(39) x40 = x(40) x41 = x(41) x42 = x(42) x43 = x(43) x44 = x(44) x45 = x(45) x46 = x(46) x47 = x(47) x48 = x(48) x49 = x(49) x50 = x(50) x51 = x(51) x52 = x(52) x53 = x(53) x54 = x(54) b55 = y(1) b56 = y(2) b57 = y(3) b58 = y(4) b59 = y(5) b60 = y(6) b61 = y(7) b62 = y(8) b63 = y(9) b64 = y(10) b65 = y(11) b66 = y(12) eps = 1.0d-8 f(1) =276.28d0*DMAX1(x1 + x2 + x3 + x4 + x5 + x6 + x19 + x20 + x21 / + x22 + x23 + x24 + x37 + x38 + x39 + x40 + x41 + x42, / eps)**2.5d0 + 792.912d0*DMAX1(x7 + x8 + x9 + x10 / + x11 + x12 + x25 + x26 + x27 + x28 + x29 + x30 + x43 + x44 / + x45 + x46 + x47 + x48,eps)**2.5d0 / + 991.679d0*DMAX1(x13 + x14 + x15 + x16 + x17 + x18 + x31 / + x32 + x33 + x34 + x35 + x36 + x49 + x50 + x51 + x52 + x53 / + x54,eps)**2.5d0 + 115.274d0*x1 + 98.5559d0*x2 / + 142.777d0*x3 + 33.9886d0*x4 + 163.087d0*x5 + 10.4376d0*x6 / + 234.406d0*x7 + 142.066d0*x8 + 50.6436d0*x9 + 123.61d0*x10 / + 242.356d0*x11 + 135.071d0*x12 + 10.7347d0*x13 / + 56.0272d0*x14 + 14.912d0*x15 + 169.218d0*x16 / + 209.028d0*x17 + 259.29d0*x18 + 165.41d0*x19 + 40.7497d0*x20 / + 124.907d0*x21 + 18.495d0*x22 + 95.2789d0*x23 / + 251.899d0*x24 + 114.185d0*x25 + 37.8148d0*x26 / + 10.5547d0*x27 + 52.5162d0*x28 / + 37.4727d0*x29 + 254.843d0*x30 + 266.645d0*x31 / + 136.583d0*x32 + 15.092d0*x33 + 194.101d0*x34 + 78.768d0*x35 / + 120.36d0*x36 + 257.318d0*x37 + 172.747d0*x38 / + 142.813d0*x39 + 251.331d0*x40 + 15.9113d0*x41 / + 48.8251d0*x42 + 289.116d0*x43 + 129.705d0*x44 / + 275.621d0*x45 + 20.2235d0*x46 + 253.789d0*x47 / + 56.7474d0*x48 + 201.646d0*x49 + 164.573d0*x50 / + 295.157d0*x51 + 151.474d0*x52 + 221.794d0*x53 / + 278.304d0*x54 + 2481400.0d0*b64 + 2156460.0d0*b65 / + 2097730.0d0*b66 e2 = x1 + x3 + x5 + x7 + x9 + x11 + x13 + x15 + x17 - 60.0d0 e3 = x2 + x4 + x6 + x8 + x10 + x12 + x14 + x16 + x18 - 60.0d0 e4 = x19 + x21 + x23 + x25 + x27 + x29 + x31 + x33 + x35 - 60.0d0 e5 = x20 + x22 + x24 + x26 + x28 + x30 + x32 + x34 + x36 - 60.0d0 e6 = x37 + x39 + x41 + x43 + x45 + x47 + x49 + x51 + x53 - 60.0d0 e7 = x38 + x40 + x42 + x44 + x46 + x48 + x50 + x52 + x54 - 60.0d0 e8 = x1 + x19 + x37 - 60.0d0*b55 e9 = x2 + x20 + x38 - 60.0d0*b55 e10 = x3 + x21 + x39 - 60.0d0*b56 e11 = x4 + x22 + x40 - 60.0d0*b56 e12 = x5 + x23 + x41 - 60.0d0*b57 e13 = x6 + x24 + x42 - 60.0d0*b57 e14 = x7 + x25 + x43 - 60.0d0*b58 e15 = x8 + x26 + x44 - 60.0d0*b58 e16 = x9 + x27 + x45 - 60.0d0*b59 e17 = x10 + x28 + x46 - 60.0d0*b59 e18 = x11 + x29 + x47 - 60.0d0*b60 e19 = x12 + x30 + x48 - 60.0d0*b60 e20 = x13 + x31 + x49 - 60.0d0*b61 e21 = x14 + x32 + x50 - 60.0d0*b61 e22 = x15 + x33 + x51 - 60.0d0*b62 e23 = x16 + x34 + x52 - 60.0d0*b62 e24 = x17 + x35 + x53 - 60.0d0*b63 e25 = x18 + x36 + x54 - 60.0d0*b63 e26 = 120.0d0*b55 + 120.0d0*b56 + 120.0d0*b57 - 2749.5d0*b64 e27 = 120.0d0*b58 + 120.0d0*b59 + 120.0d0*b60 - 2872.94d0*b65 e28 = 120.0d0*b61 + 120.0d0*b62 + 120.0d0*b63 - 2508.06d0*b66 e29 = 120.0d0*b55 + 120.0d0*b56 + 120.0d0*b57 - 50.0d0*b64 e30 = 120.0d0*b58 + 120.0d0*b59 + 120.0d0*b60 - 50.0d0*b65 e31 = 120.0d0*b61 + 120.0d0*b62 + 120.0d0*b63 - 50.0d0*b66 e32 = b55 + b58 + b61 - 1.0d0 e33 = b56 + b59 + b62 - 1.0d0 e34 = b57 + b60 + b63 - 1.0d0 g(1) = e8 g(2) = e9 g(3) = e10 g(4) = e11 g(5) = e12 g(6) = e13 g(7) = e14 g(8) = e15 g(9) = e16 g(10) = e17 g(11) = e18 g(12) = e19 g(13) = e20 g(14) = e21 g(15) = e22 g(16) = e23 g(17) = e24 g(18) = e25 g(19) = e32 g(20) = e33 g(21) = e34 g(22) = -e2 g(23) = -e3 g(24) = -e4 g(25) = -e5 g(26) = -e6 g(27) = -e7 g(28) = -e26 g(29) = -e27 g(30) = -e28 g(31) = e29 g(32) = e30 g(33) = e31 END function sqr(x) double precision sqr, x sqr = x*x end CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCCCCCCCCCCCCCC END OF FILE CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC