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 = 50 ! Number of variables (in total) NI = 2 ! Number of integer variables (0 <= NI <= N) M = 43 ! Number of constraints (in total) ME = 41 ! Number of equality constraints (0 <= ME <= M) C C Step 1.B : Lower and upper bounds: 'XL' and 'XU' C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC do i = 1,26 xl(i) = 0.0d0 xu(i) = 100.0d0 end do xu( 9) = 10.0d0 xu(10) = 10.0d0 xu(11) = 1.0d0 xu(14) = 1.0d0 xu(16) = 1.0d0 xu(17) = 1.0d0 xu(20) = 200.0d0 do i=27,50 xl(i) = 0.0d0 xu(i) = 1.0d0 end do do i=45,48 xl(i) = 0.85d0 end do 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 = 1000000 ! 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.1D0 ! ACCURACY PARAM( 2) = 1.0D0 ! SEED PARAM( 3) = 1.57d0 ! 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(100), sqr, / 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, b50, / b51, 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, e35, e36, e37, e38, e39, e40, / e41, e42, e43, e44 integer i CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC do i=1,2 y(i) = x(48+i) enddo x2 = x(1) x3 = x(2) x4 = x(3) x5 = x(4) x6 = x(5) x7 = x(6) x8 = x(7) x9 = x(8) x10 = x(9) x11 = x(10) x12 = x(11) x13 = x(12) x14 = x(13) x15 = x(14) x16 = x(15) x17 = x(16) x18 = x(17) x19 = x(18) x20 = x(19) x21 = x(20) x22 = x(21) x23 = x(22) x24 = x(23) x25 = x(24) x26 = x(25) x27 = x(26) x28 = x(27) x29 = x(28) x30 = x(29) x31 = x(30) x32 = x(31) x33 = x(32) x34 = x(33) x35 = x(34) x36 = x(35) x37 = x(36) x38 = x(37) x39 = x(38) x40 = x(39) x41 = x(40) x42 = x(41) x43 = x(42) x44 = x(43) x45 = x(44) x46 = x(45) x47 = x(46) x48 = x(47) x49 = x(48) b50 = y(1) b51 = y(2) f(1) = (0.0042656d0*x29 - 0.0005719d0*x28 + 0.0093514d0*x46 / + 0.0077308d0*x47 - 0.0139904d0)*x4 + (0.0016371d0*x31 / + 0.0288996d0*x32 + 0.0338147d0*x48 + 0.0373349d0*x49 / - 0.0661588d0)*x5 + 0.23947d0*b50 + 0.75835d0*b51 e2 = x2 + x3 + x20 + x21 - 300.0d0 e3 = x6 - x12 - x13 e4 = x7 - x11 - x14 - x15 e5 = x8 - x10 - x16 - x17 e6 = x9 - x18 - x19 e7 = -x10*x40 - 0.333333333333333d0*x2 + x22 e8 = -x10*x41 - 0.333333333333333d0*x2 + x23 e9 = - x10*x42 - 0.333333333333333d0*x2 + x24 e10 = - x11*x37 - 0.333333333333333d0*x3 + x25 e11 = - x11*x38 - 0.333333333333333d0*x3 + x26 e12 = - x11*x39 - 0.333333333333333d0*x3 + x27 e13 = -(x6*x34 + x7*x37) + x22 e14 = -(x6*x35 + x7*x38) + x23 e15 = -(x6*x36 + x7*x39) + x24 e16 = -(x8*x40 + x9*x43) + x25 e17 = -(x8*x41 + x9*x44) + x26 e18 = -(x8*x42 + x9*x45) + x27 e19 = x22*x46 - x6*x34 e20 = x23*x47 - x7*x38 e21 = x26*x48 - x8*x41 e22 = x27*x49 - x9*x45 e23 = x12*x34 + x14*x37 + x16*x40 + x18*x43 / + 0.333333333333333d0*x20 - 30.0d0 e24 = x12*x35 + x14*x38 + x16*x41 + x18*x44 / + 0.333333333333333d0*x20 - 50.0d0 e25 = x12*x36 + x14*x39 + x16*x42 + x18*x45 / + 0.333333333333333d0*x20 - 30.0d0 e26 = x13*x34 + x15*x37 + x17*x40 + x19*x43 / + 0.333333333333333d0*x21 - 70.0d0 e27 = x13*x35 + x15*x38 + x17*x41 + x19*x44 / + 0.333333333333333d0*x21 - 50.0d0 e28 = x13*x36 + x15*x39 + x17*x42 + x19*x45 / + 0.333333333333333d0*x21 - 70.0d0 e29 = x4*x28 - x22 e30 = x4*x29 - x23 e31 = x4*x30 - x24 e32 = x5*x31 - x25 e33 = x5*x32 - x26 e34 = x5*x33 - x27 e35 = x34 + x35 + x36 - 1.0d0 e36 = x37 + x38 + x39 - 1.0d0 e37 = x40 + x41 + x42 - 1.0d0 e38 = x43 + x44 + x45 - 1.0d0 e39 = x28 + x29 + x30 - 1.0d0 e40 = x31 + x32 + x33 - 1.0d0 e41 = x36 e42 = x43 e43 = x4 - 300.0d0*b50 e44 = x5 - 300.0d0*b51 g(1) = e2 g(2) = e3 g(3) = e4 g(4) = e5 g(5) = e6 g(6) = e7 g(7) = e8 g(8) = e9 g(9) = e10 g(10) = e11 g(11) = e12 g(12) = e13 g(13) = e14 g(14) = e15 g(15) = e16 g(16) = e17 g(17) = e18 g(18) = e19 g(19) = e20 g(20) = e21 g(21) = e22 g(22) = e23 g(23) = e24 g(24) = e25 g(25) = e26 g(26) = e27 g(27) = e28 g(28) = e29 g(29) = e30 g(30) = e31 g(31) = e32 g(32) = e33 g(33) = e34 g(34) = e35 g(35) = e36 g(36) = e37 g(37) = e38 g(38) = e39 g(39) = e40 g(40) = e41 g(41) = e42 g(42) = -e43 g(43) = -e44 END function sqr(x) double precision sqr, x sqr = x*x end CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCCCCCCCCCCCCCC END OF FILE CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC