C********************************************************************* C C EQUIVALENCE statements for the character control variables. C These may be included in your program to allow referencing C control variables by mnemonic names. C C********************************************************************* C OSLCLN contains the number of character control variables. INTEGER*4 OSLCLN PARAMETER (OSLCLN=17) C Array for character control variables. CHARACTER*80 OSLC(OSLCLN) C The problem name in the MPS file. CHARACTER*80 CNAME EQUIVALENCE (OSLC( 1),CNAME) C The objective function row name in the MPS file. CHARACTER*80 COBJECTIVE EQUIVALENCE (OSLC( 2),COBJECTIVE) C The RHS name in the MPS file. CHARACTER*80 CRHS EQUIVALENCE (OSLC( 3),CRHS) C The range name in the MPS file. CHARACTER*80 CRANGE EQUIVALENCE (OSLC( 4),CRANGE) C The bound name in the MPS file. CHARACTER*80 CBOUND EQUIVALENCE (OSLC( 5),CBOUND) C The basis name in the MPS file. CHARACTER*80 CBASIS EQUIVALENCE (OSLC( 6),CBASIS) C The name of cost (objective) change row in the MPS file to be C used by EKKSPAR. CHARACTER*80 CCHANGEOBJ EQUIVALENCE (OSLC( 7),CCHANGEOBJ) C The name of RHS change in the MPS file to be used by EKKSPAR. CHARACTER*80 CCHANGERHS EQUIVALENCE (OSLC( 8),CCHANGERHS) C The name of range change in the MPS file to be used by EKKSPAR. CHARACTER*80 CCHANGERANGE EQUIVALENCE (OSLC( 9),CCHANGERANGE) C The name of bounds change in the MPS file to be used by EKKSPAR. CHARACTER*80 CCHANGEBOUNDS EQUIVALENCE (OSLC(10),CCHANGEBOUNDS) C The name of the spreadsheet range(s) containing the adjustable cells. CHARACTER*80 CSSOLUTION EQUIVALENCE (OSLC(11),CSSOLUTION) C The name of the spreadsheet range(s) containing the constraint cells. CHARACTER*80 CSCONSTRTS EQUIVALENCE (OSLC(12),CSCONSTRTS) C The name of the spreadsheet range containing the objective cell. CHARACTER*80 CSOBJECTIVE EQUIVALENCE (OSLC(13),CSOBJECTIVE) C The name of the spreadsheet range(s) containing SOS sets of type 1. CHARACTER*80 CSEKKSOS1 EQUIVALENCE (OSLC(14),CSEKKSOS1) C The name of the spreadsheet range(s) containing SOS sets of type 2. CHARACTER*80 CSEKKSOS2 EQUIVALENCE (OSLC(15),CSEKKSOS2) C The name of the spreadsheet range(s) containing SOS sets of type 3. CHARACTER*80 CSEKKSOS3 EQUIVALENCE (OSLC(16),CSEKKSOS3) C The name of the spreadsheet range(s) containing SOS sets of type 4 C (general integer variables). CHARACTER*80 CSEKKSOS4 EQUIVALENCE (OSLC(17),CSEKKSOS4)
C********************************************************************* C C EQUIVALENCE statements for the integer control variables. C These may be included in your program to allow referencing C control variables by mnemonic names. C C********************************************************************* C OSLILN contains the number of integer control variables. INTEGER*4 OSLILN PARAMETER (OSLILN=64) C Array for integer control variables. INTEGER*4 OSLI(OSLILN) C The log frequency. INTEGER*4 ILOGFREQ EQUIVALENCE (OSLI( 1),ILOGFREQ) C The unit where output is directed for printing. INTEGER*4 IPRINTUNIT EQUIVALENCE (OSLI( 2),IPRINTUNIT) C The maximum number of iterations between a refactorization C (invert) of the basis must be performed. INTEGER*4 IMAXFACTOR EQUIVALENCE (OSLI( 3),IMAXFACTOR) C The current number of iterations that a solver has performed. INTEGER*4 IITERNUM EQUIVALENCE (OSLI( 4),IITERNUM) C The maximum number of iterations that will be performed. INTEGER*4 IMAXITER EQUIVALENCE (OSLI( 5),IMAXITER) C The simplex log detail bit mask. INTEGER*4 ILOGLEVEL EQUIVALENCE (OSLI( 6),ILOGLEVEL) C One objective function (type N row) flag for MPS files. INTEGER*4 IONEOBJ EQUIVALENCE (OSLI( 7),IONEOBJ) C The number of the current EKKQPAR parametric adjustment. INTEGER*4 IQPARNUMITER EQUIVALENCE (OSLI( 8),IQPARNUMITER) C The maximum number of rows allowed in the matrix. INTEGER*4 IMAXROWS EQUIVALENCE (OSLI( 9),IMAXROWS) C The maximum number of columns allowed in the matrix. INTEGER*4 IMAXCOLS EQUIVALENCE (OSLI(10),IMAXCOLS) C The number of characters in the names of the INTEGER*4 INUMCHAR EQUIVALENCE (OSLI(11),INUMCHAR) C The stopping condition bit mask. INTEGER*4 ISTOPMASK EQUIVALENCE (OSLI(12),ISTOPMASK) C The maximum number of iterations of the interior-point barrier C algorithm. INTEGER*4 IMAXITERB EQUIVALENCE (OSLI(13),IMAXITERB) C The formation of the adjacency matrix biA <biA sup T>. INTEGER*4 IADJACTYPE EQUIVALENCE (OSLI(14),IADJACTYPE) C The formation of the normal matrix. INTEGER*4 IFORMNTYPE EQUIVALENCE (OSLI(15),IFORMNTYPE) C The dense column threshold. INTEGER*4 IDENSECOL EQUIVALENCE (OSLI(16),IDENSECOL) C The type of Devex pricing to be used. INTEGER*4 IDEVEXMODE EQUIVALENCE (OSLI(17),IDEVEXMODE) C The null space checking switch. INTEGER*4 INULLCHECK EQUIVALENCE (OSLI(18),INULLCHECK) C The constraint dropping threshold. INTEGER*4 IDROPROWCT EQUIVALENCE (OSLI(19),IDROPROWCT) C The frequency which EKKITRU is called. INTEGER*4 IITERUFREQ EQUIVALENCE (OSLI(20),IITERUFREQ) C The potential basis flag. INTEGER*4 IPOSSBASIS EQUIVALENCE (OSLI(21),IPOSSBASIS) C The maximum null space projections. INTEGER*4 IMAXPROJNS EQUIVALENCE (OSLI(22),IMAXPROJNS) C The number of elements in the last created block. INTEGER*4 INUMELS EQUIVALENCE (OSLI(23),INUMELS) C The number of matrix blocks. INTEGER*4 INUMBLOCKS EQUIVALENCE (OSLI(24),INUMBLOCKS) C The position of the message number on the output line. INTEGER*4 IMSGPOS EQUIVALENCE (OSLI(25),IMSGPOS) C The number of lines on the page. INTEGER*4 IPAGELINES EQUIVALENCE (OSLI(26),IPAGELINES) C The number of rows in the matrix. INTEGER*4 INUMROWS EQUIVALENCE (OSLI(27),INUMROWS) C The number of structural variables in the matrix. INTEGER*4 INUMCOLS EQUIVALENCE (OSLI(28),INUMCOLS) C The current number of primal infeasibilities. INTEGER*4 INUMPINF EQUIVALENCE (OSLI(29),INUMPINF) C The current number of dual infeasibilities. INTEGER*4 INUMDINF EQUIVALENCE (OSLI(30),INUMDINF) C The bit mask that determines which parts of the matrix are C written or read by EKKPTMD or EKKGTMD. INTEGER*4 IMODELMASK EQUIVALENCE (OSLI(31),IMODELMASK) C The solution printing bit mask for EKKPRTS. INTEGER*4 IPRTINFOMASK EQUIVALENCE (OSLI(32),IPRTINFOMASK) C The print matrix bit mask for EKKPRTS. INTEGER*4 ISOLMASK EQUIVALENCE (OSLI(33),ISOLMASK) INTEGER*4 IPRTMTRXMASK EQUIVALENCE (OSLI(33),IPRTMTRXMASK) C The number of elements in each spare block. INTEGER*4 IEXTRABLK EQUIVALENCE (OSLI(34),IEXTRABLK) C The maximum number of parametric adjustments that will be C performed by EKKQPAR. INTEGER*4 IQPARMAXITER EQUIVALENCE (OSLI(35),IQPARMAXITER) C The length of the output line. INTEGER*4 ILINELEN EQUIVALENCE (OSLI(36),ILINELEN) C The maximum node number created so far. INTEGER*4 INUMNODES EQUIVALENCE (OSLI(37),INUMNODES) C The EKKMSLV log detail bit mask. INTEGER*4 IINTMASK EQUIVALENCE (OSLI(38),IINTMASK) C The fast iteration switch. INTEGER*4 IFASTITS EQUIVALENCE (OSLI(39),IFASTITS) C The maximum number of nodes to evaluate. INTEGER*4 IMAXNODES EQUIVALENCE (OSLI(40),IMAXNODES) C The maximum number of feasible integer solutions to find. INTEGER*4 IMAXSOLS EQUIVALENCE (OSLI(41),IMAXSOLS) C The number of integer solutions found so far. INTEGER*4 INUMSOLS EQUIVALENCE (OSLI(42),INUMSOLS) C The number of individual integer variables. INTEGER*4 INUMINTS EQUIVALENCE (OSLI(43),INUMINTS) C The number of sets. INTEGER*4 INUMSETS EQUIVALENCE (OSLI(44),INUMSETS) C The number of integer variables at fractional values. INTEGER*4 INUMUNSAT EQUIVALENCE (OSLI(45),INUMUNSAT) C IBM Vector facility flag. INTEGER*4 IVECTOR EQUIVALENCE (OSLI(46),IVECTOR) C The problem status. INTEGER*4 IPROBSTAT EQUIVALENCE (OSLI(47),IPROBSTAT) C The maximum number of decomposition iterations. INTEGER*4 IMAJORITS EQUIVALENCE (OSLI(48),IMAJORITS) C The sensitivity information printing bit mask. INTEGER*4 IPRINTSENS EQUIVALENCE (OSLI(49),IPRINTSENS) C The maximum number of integer variables. INTEGER*4 IMAXINTS EQUIVALENCE (OSLI(50),IMAXINTS) C The maximum number of sets. INTEGER*4 IMAXSETS EQUIVALENCE (OSLI(51),IMAXSETS) C The bit mask that selects various steps of the MIP algorithm. INTEGER*4 ISTRATEGY EQUIVALENCE (OSLI(52),ISTRATEGY) C The maximum amount of integer information. INTEGER*4 IMAXINTINFO EQUIVALENCE (OSLI(53),IMAXINTINFO) C Number of integer variables that must be fixed for supernode C processing to continue. INTEGER*4 ITHRESHOLD EQUIVALENCE (OSLI(54),ITHRESHOLD) C The number of heuristic passes to be made by EKKMPRE. INTEGER*4 IHEURPASS EQUIVALENCE (OSLI(55),IHEURPASS) C The number of branches allowed inside a supernode before C supernode processing ends. INTEGER*4 ISUPERTOL EQUIVALENCE (OSLI(56),ISUPERTOL) C The row ordering method indicator. INTEGER*4 IROWORD EQUIVALENCE (OSLI(57),IROWORD) C The row ordering read and write logical unit. INTEGER*4 IORDUNIT EQUIVALENCE (OSLI(58),IORDUNIT) C The amount of extra information that is saved and restored by C the user exit subroutine EKKNODU. INTEGER*4 IMIPLENGTH EQUIVALENCE (OSLI(59),IMIPLENGTH) C The current number of iterations EKKBSLV has performed. INTEGER*4 IITERBNUM EQUIVALENCE (OSLI(60),IITERBNUM) C The type of pricing for EKKNSLV. INTEGER*4 IPRICETYPE EQUIVALENCE (OSLI(61),IPRICETYPE) C A secondary problem status variable. INTEGER*4 IPROBSTAT2 EQUIVALENCE (OSLI(63),IPROBSTAT2) C The bit mask that indicates the type of model read in by EKKSMDL. INTEGER*4 ISMDLTYPEMASK EQUIVALENCE (OSLI(64),ISMDLTYPEMASK)
C********************************************************************* C C EQUIVALENCE statements for the index control variables. C These may be included in your program to allow referencing C control variables by mnemonic names. C C********************************************************************* C OSLNLN contains the number of index control variables. INTEGER*4 OSLNLN PARAMETER (OSLNLN=66) C Array for index control variables. INTEGER*4 OSLN(OSLNLN) C The index into dspace for the first element of row lower bounds. INTEGER*4 NROWLOWER EQUIVALENCE (OSLN( 1),NROWLOWER) C The index into dspace for the first element of row activities. INTEGER*4 NROWACTS EQUIVALENCE (OSLN( 2),NROWACTS) C The index into dspace for the first element of row upper bounds. INTEGER*4 NROWUPPER EQUIVALENCE (OSLN( 3),NROWUPPER) C The index into dspace for the first element of row slacks INTEGER*4 NROWDUALS EQUIVALENCE (OSLN( 4),NROWDUALS) INTEGER*4 NROWSLACKS EQUIVALENCE (OSLN( 4),NROWSLACKS) C The index into mspace for the first element of the row status C vector. INTEGER*4 NROWSTAT EQUIVALENCE (OSLN( 5),NROWSTAT) C The index into dspace for the first element of column lower C bounds. INTEGER*4 NCOLLOWER EQUIVALENCE (OSLN( 6),NCOLLOWER) C The index into dspace for the first element of the solution C (column activities). INTEGER*4 NCOLSOL EQUIVALENCE (OSLN( 7),NCOLSOL) C The index into dspace for the first element of column upper C bounds. INTEGER*4 NCOLUPPER EQUIVALENCE (OSLN( 8),NCOLUPPER) C The index into dspace for the first element of reduced costs. INTEGER*4 NCOLRCOSTS EQUIVALENCE (OSLN( 9),NCOLRCOSTS) C The index into mspace for the first element of the column C status vector. INTEGER*4 NCOLSTAT EQUIVALENCE (OSLN(10),NCOLSTAT) C The index into dspace for the first element of column costs C (objective function coefficient). INTEGER*4 NOBJECTIVE EQUIVALENCE (OSLN(11),NOBJECTIVE) C The index into dspace for the first element of row names. INTEGER*4 NROWNAMES EQUIVALENCE (OSLN(12),NROWNAMES) C The index into dspace for the first element of column names. INTEGER*4 NCOLNAMES EQUIVALENCE (OSLN(13),NCOLNAMES) C The index into dspace for the first element of row scale factors. INTEGER*4 NROWSCALES EQUIVALENCE (OSLN(14),NROWSCALES) C The index into dspace for the first element of column scale C factors. INTEGER*4 NCOLSCALES EQUIVALENCE (OSLN(15),NCOLSCALES) C The index into mspace for the first element of the presolve C region. INTEGER*4 NPRESOLVE EQUIVALENCE (OSLN(16),NPRESOLVE) C The index into mspace for the first element of rows for matrix C (column copy). INTEGER*4 NROWCC EQUIVALENCE (OSLN(17),NROWCC) C The index into mspace for the first element of columns for C matrix (row copy). INTEGER*4 NCOLRC EQUIVALENCE (OSLN(18),NCOLRC) C The index into dspace for the first element of elements for C matrix (column copy). INTEGER*4 NELEMCC EQUIVALENCE (OSLN(19),NELEMCC) C The index into dspace for the first element of columns for C matrix (row copy). INTEGER*4 NELEMRC EQUIVALENCE (OSLN(20),NELEMRC) C The index into mspace for the first element of row starts (row C copy). INTEGER*4 NROWRC EQUIVALENCE (OSLN(21),NROWRC) C The index into mspace for the first element of column starts C (column copy). INTEGER*4 NCOLCC EQUIVALENCE (OSLN(22),NCOLCC) C The index into dspace of the first element of free space. INTEGER*4 NFIRSTFREE EQUIVALENCE (OSLN(23),NFIRSTFREE) C The index into dspace of the last element of free space. INTEGER*4 NLASTFREE EQUIVALENCE (OSLN(24),NLASTFREE) C The index into mspace for the first element of column entries C for latest block. INTEGER*4 NBLOCKCOL EQUIVALENCE (OSLN(25),NBLOCKCOL) C The index into mspace for the first element of row entries for C latest block. INTEGER*4 NBLOCKROW EQUIVALENCE (OSLN(26),NBLOCKROW) C The index into dspace for the first element of elements for C latest block. INTEGER*4 NBLOCKELEM EQUIVALENCE (OSLN(27),NBLOCKELEM) C The index into mspace for the first element of integer C information. INTEGER*4 NINTINFO EQUIVALENCE (OSLN(28),NINTINFO) C The index into dspace for the first element of row auxiliary C solve information. INTEGER*4 NROWAUX EQUIVALENCE (OSLN(29),NROWAUX) C The index into dspace for the first element of row auxiliary C solve information. INTEGER*4 NCOLAUX EQUIVALENCE (OSLN(30),NCOLAUX) C The index into dspace created by EKKSOBJ for the first element C of the array of cost upper limits. INTEGER*4 NSOBJUPC EQUIVALENCE (OSLN(31),NSOBJUPC) C The index into dspace created by EKKSOBJ for the first element C of the array of cost lower limits. INTEGER*4 NSOBJDNC EQUIVALENCE (OSLN(32),NSOBJDNC) C The index into dspace created by EKKSOBJ for the first element C of ranges of the objective function values corresponding to the C upper limits on cost coefficients indexed by Nsobjupc. INTEGER*4 NSOBJUPV EQUIVALENCE (OSLN(33),NSOBJUPV) C The index into dspace created by EKKSOBJ for the first element C of ranges of the objective function values corresponding to the C lower limits on cost coefficients indexed by Nsobjdnc. INTEGER*4 NSOBJDNV EQUIVALENCE (OSLN(34),NSOBJDNV) C The index into mspace created by EKKSOBJ for the first element C of the array of entering rows or columns corresponding to the C increased cost coefficients indexed by Nsobjupc. INTEGER*4 NSOBJUPE EQUIVALENCE (OSLN(35),NSOBJUPE) C The index into mspace created by EKKSOBJ for the first element C of the array of entering rows or columns corresponding to the C decreased cost coefficients indexed by Nsobjdnc. INTEGER*4 NSOBJDNE EQUIVALENCE (OSLN(36),NSOBJDNE) C The index into mspace created by EKKSOBJ for the first element C of the array of leaving rows or columns corresponding to the C increased cost coefficients indexed by Nsobjupc. INTEGER*4 NSOBJUPL EQUIVALENCE (OSLN(37),NSOBJUPL) C The index into mspace created by EKKSOBJ for the first element C of the array of leaving rows or columns corresponding to the C decreased cost coefficients indexed by Nsobjdnc. INTEGER*4 NSOBJDNL EQUIVALENCE (OSLN(38),NSOBJDNL) C The index into dspace created by EKKSBND for the first element C of the upper limits on column bounds. INTEGER*4 NSBNDCUPB EQUIVALENCE (OSLN(39),NSBNDCUPB) C The index into dspace created by EKKSBND for the first element C of the lower limits on column bounds. INTEGER*4 NSBNDCDNB EQUIVALENCE (OSLN(40),NSBNDCDNB) C The index into dspace created by EKKSBND for the first element C of the ranges of the objective function values corresponding to C the upper limits on column bounds indexed by Nsbndcupb. INTEGER*4 NSBNDCUPV EQUIVALENCE (OSLN(41),NSBNDCUPV) C The index into dspace created by EKKSBND for the first element C of ranges of the objective function values corresponding to the C lower limits on column bounds indexed by Nsbndcdnb. INTEGER*4 NSBNDCDNV EQUIVALENCE (OSLN(42),NSBNDCDNV) C The index into mspace created by EKKSBND for the first element C of the array of entering rows or columns corresponding to the C upper limits on column bounds indexed by Nsbndcupb. INTEGER*4 NSBNDCUPE EQUIVALENCE (OSLN(43),NSBNDCUPE) C The index into mspace created by EKKSBND for the first element C of the array of entering rows or columns corresponding to the C lower limits on column bounds indexed by Nsbndcdnb. INTEGER*4 NSBNDCDNE EQUIVALENCE (OSLN(44),NSBNDCDNE) C The index into mspace created by EKKSBND for the first element C of the array of leaving rows or columns corresponding to the C upper limits on column bounds indexed by Nsbndcupb. INTEGER*4 NSBNDCUPL EQUIVALENCE (OSLN(45),NSBNDCUPL) C The index into mspace created by EKKSBND for the first element C of the array of leaving rows or columns corresponding to the C lower limits on column bounds indexed by Nsbndcdnb. INTEGER*4 NSBNDCDNL EQUIVALENCE (OSLN(46),NSBNDCDNL) C The index into dspace created by EKKSBND for the first element C of the upper limits on row bounds. INTEGER*4 NSBNDRUPB EQUIVALENCE (OSLN(47),NSBNDRUPB) C The index into dspace created by EKKSBND for the first element C of the lower limits on row bounds. INTEGER*4 NSBNDRDNB EQUIVALENCE (OSLN(48),NSBNDRDNB) C The index into dspace created by EKKSBND for the first element C of the ranges of the objective function values corresponding to C the upper limits on row bounds indexed by Nsbndrupb. INTEGER*4 NSBNDRUPV EQUIVALENCE (OSLN(49),NSBNDRUPV) C The index into dspace created by EKKSBND for the first element C of ranges of the objective function values corresponding to the C lower limits on row bounds indexed by Nsbndrdnb. INTEGER*4 NSBNDRDNV EQUIVALENCE (OSLN(50),NSBNDRDNV) C The index into mspace created by EKKSBND for the first element C of the array of entering rows or columns corresponding to the C upper limits on row bounds indexed by Nsbndrupb. INTEGER*4 NSBNDRUPE EQUIVALENCE (OSLN(51),NSBNDRUPE) C The index into mspace created by EKKSBND for the first element C of the array of entering rows or columns corresponding to the C lower limits on row bounds indexed by Nsbndrdnb. INTEGER*4 NSBNDRDNE EQUIVALENCE (OSLN(52),NSBNDRDNE) C The index into mspace created by EKKSBND for the first element C of the array of leaving rows or columns corresponding to the C upper limits on row bounds indexed by Nsbndrupb. INTEGER*4 NSBNDRUPL EQUIVALENCE (OSLN(53),NSBNDRUPL) C The index into mspace created by EKKSBND for the first element C of the array of leaving rows or columns corresponding to the C lower limits on row bounds indexed by Nsbndrdnb. INTEGER*4 NSBNDRDNL EQUIVALENCE (OSLN(54),NSBNDRDNL) C The index into mspace for the column selection list. INTEGER*4 NSELLISTCOL EQUIVALENCE (OSLN(55),NSELLISTCOL) C The index into mspace for the row selection list. INTEGER*4 NSELLISTROW EQUIVALENCE (OSLN(56),NSELLISTROW) C The index into dspace for the parametric cost (objective) C change vector created for EKKSPAR. INTEGER*4 NSPARCOST EQUIVALENCE (OSLN(57),NSPARCOST) C The index into dspace for the row lower bounds parametric C change vector created for EKKSPAR. INTEGER*4 NSPARRLO EQUIVALENCE (OSLN(58),NSPARRLO) C The index into dspace for the row upper bounds parametric C change vector created for EKKSPAR. INTEGER*4 NSPARRUP EQUIVALENCE (OSLN(59),NSPARRUP) C The index into dspace for the column lower bounds parametric C change vector created for EKKSPAR. INTEGER*4 NSPARCLO EQUIVALENCE (OSLN(60),NSPARCLO) C The index into dspace for the column upper bounds parametric C change vector created for EKKSPAR. INTEGER*4 NSPARCUP EQUIVALENCE (OSLN(61),NSPARCUP) C The index into mspace for the first element of the indices of C the arcs in the basis. INTEGER*4 NARCID EQUIVALENCE (OSLN(62),NARCID) C The index into mspace for the first element of the array of C node levels. INTEGER*4 NLEVEL EQUIVALENCE (OSLN(63),NLEVEL) C The index into mspace for the first element of the array of C parent nodes. INTEGER*4 NPARENT EQUIVALENCE (OSLN(64),NPARENT) C The index into mspace for the first element of the preorder C traversal array. INTEGER*4 NPREORDER EQUIVALENCE (OSLN(65),NPREORDER) C The index into mspace for the first element of the reverse C preorder traversal array. INTEGER*4 NREVPREORDER EQUIVALENCE (OSLN(66),NREVPREORDER)
C********************************************************************* C C EQUIVALENCE statements for the real control variables. C These may be included in your program to allow referencing C control variables by mnemonic names. C C********************************************************************* C OSLRLN contains the number of real control variables. INTEGER*4 OSLRLN PARAMETER (OSLRLN=45) C Array for real control variables. REAL*8 OSLR(OSLRLN) C The allowed amount of primal infeasibility. REAL*8 RTOLPINF EQUIVALENCE (OSLR( 1),RTOLPINF) C The allowed amount of dual infeasibility. REAL*8 RTOLDINF EQUIVALENCE (OSLR( 2),RTOLDINF) C The weight of the linear objective. REAL*8 RMAXMIN EQUIVALENCE (OSLR( 3),RMAXMIN) C The reduction factor for mu in the primal barrier algorithm. REAL*8 RMUFACTOR EQUIVALENCE (OSLR( 4),RMUFACTOR) C The lower limit for mu in the primal barrier algorithm. REAL*8 RMULIMIT EQUIVALENCE (OSLR( 5),RMULIMIT) C The reduced gradient target reduction factor. REAL*8 RRGFACTOR EQUIVALENCE (OSLR( 6),RRGFACTOR) C The reduced gradient limit for the primal barrier algorithm. REAL*8 RRGLIMIT EQUIVALENCE (OSLR( 7),RRGLIMIT) C The tolerance for fixing variables in the barrier method when C infeasible. REAL*8 RFIXVAR1 EQUIVALENCE (OSLR( 8),RFIXVAR1) C The tolerance for fixing variables in the barrier method when C feasible. REAL*8 RFIXVAR2 EQUIVALENCE (OSLR( 9),RFIXVAR2) C The absolute pivot tolerance for Cholesky factorization. REAL*8 RCHOLABSTOL EQUIVALENCE (OSLR(10),RCHOLABSTOL) C The cut-off tolerance for Cholesky factorization. REAL*8 RCHOLTINYTOL EQUIVALENCE (OSLR(11),RCHOLTINYTOL) REAL*8 RCHOLRELTOL EQUIVALENCE (OSLR(11),RCHOLRELTOL) C The multiple of mu to add to the linear objective. REAL*8 RMULINFAC EQUIVALENCE (OSLR(12),RMULINFAC) C The projection error tolerance. REAL*8 RPROJTOL EQUIVALENCE (OSLR(13),RPROJTOL) C The multiplier of the feasible objective that is used when the C current solution is primal infeasible. REAL*8 RPWEIGHT EQUIVALENCE (OSLR(14),RPWEIGHT) C The rate of change for Rpweight or Rdweight. REAL*8 RCHANGEWEIGHT EQUIVALENCE (OSLR(15),RCHANGEWEIGHT) C The cutoff for the branch and bound. REAL*8 RBBCUTOFF EQUIVALENCE (OSLR(16),RBBCUTOFF) C The proportion of the feasible objective that is used when the C current solution is dual infeasible. REAL*8 RDWEIGHT EQUIVALENCE (OSLR(17),RDWEIGHT) C The value of the objective function. REAL*8 ROBJVALUE EQUIVALENCE (OSLR(18),ROBJVALUE) C The sum of the primal infeasibilities. REAL*8 RSUMPINF EQUIVALENCE (OSLR(19),RSUMPINF) C The sum of the dual infeasibilities. REAL*8 RSUMDINF EQUIVALENCE (OSLR(20),RSUMDINF) C The zero tolerance for data in MPS and spreadsheet format. REAL*8 RTOLMPS EQUIVALENCE (OSLR(21),RTOLMPS) C The scale factor for all degradation. REAL*8 RDEGSCALE EQUIVALENCE (OSLR(22),RDEGSCALE) C The best feasible integer solution found so far. REAL*8 RBESTSOL EQUIVALENCE (OSLR(23),RBESTSOL) C The weight for each integer infeasibility. REAL*8 RIWEIGHT EQUIVALENCE (OSLR(24),RIWEIGHT) C The amount by which a new solution must be better. REAL*8 RIMPROVE EQUIVALENCE (OSLR(25),RIMPROVE) C The value of the target solution. REAL*8 RTARGET EQUIVALENCE (OSLR(26),RTARGET) C The integer tolerance. REAL*8 RTOLINT EQUIVALENCE (OSLR(27),RTOLINT) C The best possible solution. REAL*8 RBESTPOSS EQUIVALENCE (OSLR(28),RBESTPOSS) C The best estimated solution. REAL*8 RBESTEST EQUIVALENCE (OSLR(29),RBESTEST) C The step-length multiplier for the primal barrier algorithm. REAL*8 RSTEPMULT EQUIVALENCE (OSLR(30),RSTEPMULT) C The initial value of mu for the primal barrier algorithm. REAL*8 RMUINIT EQUIVALENCE (OSLR(31),RMUINIT) C The density threshold for Cholesky processing. REAL*8 RDENSETHR EQUIVALENCE (OSLR(32),RDENSETHR) C The weight given to true objective in primal composite phase 1. REAL*8 ROBJWEIGHT EQUIVALENCE (OSLR(33),ROBJWEIGHT) C The value of the EKKQPAR parametric parameter lambda. REAL*8 RLAMBDAVAL EQUIVALENCE (OSLR(34),RLAMBDAVAL) C The value of the EKKQSLV decomposition cutoff. REAL*8 RDCCUTOFF EQUIVALENCE (OSLR(35),RDCCUTOFF) C The value of the dual objective for EKKBSLV. REAL*8 RDOBJVAL EQUIVALENCE (OSLR(36),RDOBJVAL) C The value of the EKKSPAR parameter lambda. REAL*8 RSLAMBDA EQUIVALENCE (OSLR(37),RSLAMBDA) C The limiting value for the EKKSPAR parameter lambda. REAL*8 RSLAMBDALIM EQUIVALENCE (OSLR(38),RSLAMBDALIM) C The incrementing value for the EKKSPAR parameter lambda. REAL*8 RSLAMBDADELTA EQUIVALENCE (OSLR(39),RSLAMBDADELTA) C The supernode processing threshold. REAL*8 RTHRESHOLD EQUIVALENCE (OSLR(40),RTHRESHOLD) C The barrier method primal-dual gap tolerance. REAL*8 RPDGAPTOL EQUIVALENCE (OSLR(41),RPDGAPTOL) C The primal-dual barrier method step-length multiplier. REAL*8 RPDSTEPMULT EQUIVALENCE (OSLR(42),RPDSTEPMULT) C The diagonal perturbation for Cholesky factorization. REAL*8 RPERTDIAG EQUIVALENCE (OSLR(43),RPERTDIAG) C The sample size for the EKKNSLV pricing algorithm. REAL*8 RNETSAMP EQUIVALENCE (OSLR(44),RNETSAMP) C Switch to print CPU time used by library subroutines. REAL*8 RPRINTCPU EQUIVALENCE (OSLR(45),RPRINTCPU)
C*********************************************************************** C C EXITRU C C By setting the user return code to 3, this user exit routine C causes EKKSSLV to stop after the accumulated CPU time exceeds C 1000 microseconds. The CPU clock is started after the first C primal iteration and it is checked after each primal iteration. C NOTE: CPUTIME subroutine is available only in VS FORTRAN. C On AIX platforms, the times() system call may be used to get process C and child process times. C C*********************************************************************** C SUBROUTINE EKKITRU(DSPACE,MSPACE,IMODE,ISTAT) C INTEGER*4 IMODE,ISTAT,MSPACE(*),RTCOD REAL*8 DSPACE(*),START,CURRENT,ELAPSED SAVE START C C Include file with integer control variable definitions. INCLUDE (OSLI) C C IMODE=1: called after a primal iteration of EKKSSLV. IF(IMODE.NE.1) GOTO 100 CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN) C C CPUTIME subroutine is available only with VS FORTRAN. C User should check RTCOD here to make sure the timing is correct. IF (IITERNUM.EQ.1) THEN CALL CPUTIME(START,RTCOD) ELSE CALL CPUTIME(CURRENT,RTCOD) ELAPSED = CURRENT - START IF (ELAPSED.GT.1000.0) THEN CALL EKKPRTS(RTCOD,DSPACE) CALL EKKBASO(RTCOD,DSPACE,35,1) ISTAT=3 ENDIF ENDIF 100 RETURN END
C*********************************************************************** C C EXMSGU C C This example uses the message user exit routine to maintain a fifo C queue of the last MSGQLEN messages that occurred. C C*********************************************************************** PROGRAM MAIN C C Allocate dspace. PARAMETER (MAXSPC=200000) REAL*8 DSPACE(MAXSPC) COMMON/BIG/DSPACE C C Queue of message numbers. PARAMETER (MSGQLEN=4) INTEGER*4 MSGQNUM(MSGQLEN) C C Arrays to hold real, integer, and character values that are C printed in the message. REAL*8 MSGQRL(25,MSGQLEN) INTEGER*4 MSGQIN(25,MSGQLEN) CHARACTER*128 MSGQCH(25,MSGQLEN) C C Vectors to hold number of elements in each column of C msgqrl, msgqin, msgqch. INTEGER*4 MSGQNRL(MSGQLEN),MSGQNIN(MSGQLEN),MSGQNCH(MSGQLEN) C C Common containing message queue data. COMMON /MSGQUE/ MSGQRL,MSGQNUM,MSGQIN,MSGQNRL,MSGQNIN,MSGQNCH, + MSGQPTR,MSGQCH INTEGER*4 RTCOD C C C Call EKKMSET so message user exit routine gets called after C each message, and initialize message queue pointer. MSGQPTR=1 CALL EKKMSET(RTCOD,DSPACE,1,0,0,0,2,9999,0) IF(RTCOD.GT.0) CALL DSPMSGS C C Describe application and specify that there is 1 model. CALL EKKDSCA(RTCOD,DSPACE,MAXSPC,1) IF(RTCOD.GT.0) CALL DSPMSGS C C Describe the model as having 1 block. CALL EKKDSCM(RTCOD,DSPACE,1,1) IF(RTCOD.GT.0) CALL DSPMSGS C C Read model data from MPS file on unit 98 CALL EKKMPS(RTCOD,DSPACE,98,2,0) IF(RTCOD.GT.0) CALL DSPMSGS C C Scale the problem. CALL EKKSCAL(RTCOD,DSPACE) IF(RTCOD.GT.0) CALL DSPMSGS C C Create a vector copy of the matrix. CALL EKKNWMT(RTCOD,DSPACE,3) IF(RTCOD.GT.0) CALL DSPMSGS C C Solve the problem using primal barrier method. CALL EKKBSLV(RTCOD,DSPACE,1,3) C C Display the message queue. CALL DSPMSGS C C Print the solution. CALL EKKPRTS(RTCOD,DSPACE) IF(RTCOD.GT.0) CALL DSPMSGS C STOP END C C*********************************************************************** C This routine displays previous MSGQLEN message conditions that C occurred. C*********************************************************************** C SUBROUTINE DSPMSGS C C Queue of message numbers PARAMETER (MSGQLEN=4) INTEGER*4 MSGQNUM(MSGQLEN) C C Array to hold real, integer, and character values that are C printed in the message. REAL*8 MSGQRL(25,MSGQLEN) INTEGER*4 MSGQIN(25,MSGQLEN) CHARACTER*128 MSGQCH(25,MSGQLEN) C C Vectors to hold number of elements in each column of C msgqrl, msgqin, msgqch. INTEGER*4 MSGQNRL(MSGQLEN),MSGQNIN(MSGQLEN),MSGQNCH(MSGQLEN) C C Common containing message queue data. COMMON /MSGQUE/ MSGQRL,MSGQNUM,MSGQIN,MSGQNRL,MSGQNIN,MSGQNCH, + MSGQPTR,MSGQCH C C WRITE(6,*)' ' WRITE(6,*)'Writing FIFO queue of previous',MSGQLEN,'messages.' DO 1000 I=1,MSGQLEN WRITE(6,*)' ' WRITE(6,*)'Message number is:',MSGQNUM(MSGQPTR) C Write real numbers written with this message. DO 100 J=1,MSGQNRL(MSGQPTR) WRITE(6,*)' real printed on message:',MSGQRL(J,MSGQPTR) 100 CONTINUE C Write integers written with this message. DO 200 J=1,MSGQNIN(MSGQPTR) WRITE(6,*)' integers printed on message:',MSGQIN(J,MSGQPTR) 200 CONTINUE C Write characters written with this message. DO 300 J=1,MSGQNCH(MSGQPTR) WRITE(6,*)' Char. printed on message:',MSGQCH(J,MSGQPTR) 300 CONTINUE C Update queue pointer. MSGQPTR=MOD(MSGQPTR,MSGQLEN)+1 1000 CONTINUE RETURN END C C*********************************************************************** C This user exit routine will maintain a queue of messages. C*********************************************************************** C SUBROUTINE EKKMSGU(DSPACE,MSPACE, + STRTNUM,NREAL,RVEC,NINT,IVEC,NCHAR,CVEC) REAL*8 RVEC(*),DSPACE(*) INTEGER*4 IVEC(*),MSPACE(*),STRTNUM CHARACTER*128 CVEC(*) C C Queue of message numbers PARAMETER (MSGQLEN=4) INTEGER*4 MSGQNUM(MSGQLEN) C C Array to hold real, integer, and character values that are C printed in the message. REAL*8 MSGQRL(25,MSGQLEN) INTEGER*4 MSGQIN(25,MSGQLEN) CHARACTER*128 MSGQCH(25,MSGQLEN) C C Vectors to hold number of elements in each column of C msgqrl, msgqin, msgqch. INTEGER*4 MSGQNRL(MSGQLEN),MSGQNIN(MSGQLEN),MSGQNCH(MSGQLEN) C C Common containing message queue data. COMMON /MSGQUE/ MSGQRL,MSGQNUM,MSGQIN,MSGQNRL,MSGQNIN,MSGQNCH, 1 MSGQPTR,MSGQCH C C C Save message number. MSGQNUM(MSGQPTR)=STRTNUM C C Save real values. MSGQNRL(MSGQPTR)=NREAL DO 100 J=1,NREAL MSGQRL(J,MSGQPTR)=RVEC(J) 100 CONTINUE C C Save integer values. MSGQNIN(MSGQPTR)=NINT DO 200 J=1,NINT MSGQIN(J,MSGQPTR)=IVEC(J) 200 CONTINUE C C Save character values. MSGQNCH(MSGQPTR)=NCHAR DO 300 J=1,NCHAR MSGQCH(J,MSGQPTR)=CVEC(J) 300 CONTINUE C C Update queue pointer. MSGQPTR=MOD(MSGQPTR,MSGQLEN)+1 C RETURN END
You can run this program using "Sample Linear Programming Model Data 1".
C*********************************************************************** C C EXSPARIT C C This is a sample EKKITRU to use with EKKSPAR. EKKSPAR calls C EKKITRU at every solution point found, as follows: C C IMODE = 10 means that this is a solution at an increment point. C IMODE = 11 means that this is a solution at a basis change C between increment points. C C*********************************************************************** C SUBROUTINE EKKITRU(DSPACE,MSPACE,IMODE,ISTAT) INTEGER*4 MSPACE(*),IMODE,ISTAT,IRTCOD REAL*8 DSPACE(*) C Print out every EKKSPAR solution IF(IMODE.EQ.10.OR.IMODE.EQ.11) CALL EKKPRTS(IRTCOD,DSPACE) RETURN END
C*********************************************************************** C C EXBRNU C C This user exit routine modifies the default choice of the C branching variable. C C IREASN is the situation when EKKBRNU is called, where: C C IREASN=1: subroutine is being called before any set is processed; C MARRAY and DARRAY are not used. C =2: subroutine is being called before processing each set; C only set number, type of set, priority, and number in set C are valid in MARRAY and DARRAY. C =3: subroutine is being called after processing each C variable in the set; all of MARRAY and DARRAY are valid C and you may change pseudocosts (takes effect on the next C branch). C =4: subroutine is being called after processing each set; C all of MARRAY and DARRAY are valid and the user may C change variable number and priority (takes effect on C next branch). C =5: subroutine is being called after processing all sets; C all of MARRAY and DARRAY are valid, and the set number C is the chosen set, which you may now change. C C MARRAY(1): set number being processed. C MARRAY(2): type of set being processed. C MARRAY(3): priority (1 is highest). C MARRAY(4): number of variables in the set C MARRAY(5): variable column number of the current variable. C MARRAY(6): direction of the branching. C DARRAY(1): current value of variable in continuous solution. C DARRAY(2): down pseudocost. C DARRAY(3): up pseudocost for single variables. C For sets it is the reference row entry. C DARRAY(4): estimated degradation for the down branch. C DARRAY(5): estimated degradation for the up branch. C C NOTE THIS SAMPLE USER EXIT IS NOT VALID FOR MIP PROBLEMS WITH SOS C C*********************************************************************** C SUBROUTINE EKKBRNU(DSPACE,MSPACE,IREASN,MARRAY,DARRAY,JRTCOD) C C Bring in include file with integer control variables. IMPLICIT NONE INCLUDE (OSLI) C REAL*8 DSPACE(*),DARRAY(5),DVAL,DBEST,DBEST2 INTEGER*4 MSPACE(*),MARRAY(6),M2,IREASN,JRTCOD,RTCOD,ISEQ, + ISET,IF9 SAVE DBEST,DBEST2,ISEQ,ISET,IF9,DVAL C C First check to see if this problem has SOS -- not valid with C this example user exit. C M2 = MARRAY(2) IF((M2.EQ.1).OR.(M2.EQ.2).OR.(M2.EQ.3)) THEN PRINT *,'THIS EKKBRNU NOT FOR SOS' PRINT *,'STOPPING YOUR APPLICATION NOW' STOP ENDIF C GOTO (1000,2000,3000,4000,5000),IREASN C C Initialization C Using 0.499999 so that variables at 0.0 will be skipped C 1000 DBEST=0.499999D0 DBEST2=0.0D0 ISEQ=0 ISET=0 IF9=0 CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN) WRITE (6,101) 'There are ',INUMSETS,' sets.' GOTO 6000 C C Before Set C 2000 WRITE (6,102) 'Set number ',MARRAY(1),MARRAY(2),MARRAY(3), + MARRAY(4) C C Set return code to force EKKBRNU calls. JRTCOD=0 GOTO 6000 C C In Set C Choose variable closest to 1.0 or to 0.5 if none above .9. C 3000 IF(DARRAY(1).GE.0.9D0) THEN IF(DARRAY(1).GT.1.000005D0) THEN PRINT *,'THIS EKKBRNU NOT FOR GENERAL INTEGER VARIABLES' PRINT *,'STOPPING YOUR APPLICATION NOW' STOP ENDIF IF(DARRAY(1).GT.DBEST2.AND.DARRAY(1).LE.0.99999D0) THEN ISEQ=MARRAY(5) DBEST2=DARRAY(1) DVAL=DARRAY(1) C Branch up. MARRAY(6)=1 ISET=MARRAY(1) IF9=1 ENDIF ELSEIF(ABS(DARRAY(1)-0.5D0).LT.DBEST.AND.IF9.EQ.0) THEN ISEQ=MARRAY(5) DBEST=ABS(DARRAY(1)-0.5D0) DVAL=DARRAY(1) C Branch up. MARRAY(6)=1 ISET=MARRAY(1) ENDIF GOTO 6000 C C At end of set -- point to the chosen one. C 4000 WRITE (6,103) 'OSL chooses ',MARRAY(5),MARRAY(6),DARRAY(1) WRITE (6,103) 'I chose ',ISEQ,1,DVAL IF(ISET.EQ.MARRAY(1)) THEN MARRAY(5)=-ISEQ ENDIF GOTO 6000 C 5000 MARRAY(1)=-ISET 6000 CONTINUE RETURN 101 FORMAT(1X,A10,I5,A5) 102 FORMAT(1X,A11,I5,I5,I5,I5) 103 FORMAT(1X,A12,I5,I5,F9.2) END
C***********************************************************************
C
C EXBRNU2
C
C This user exit routine modifies the default choice of the branching
C variable. It is intended for use with EXMSLV3 and EXNODU.
C
C DSPACE is the user work area.
C MSPACE is the user work area.
C IREASN is the reason for calling.
C MARRAY is the short node list -- integer values.
C DARRAY is the short node list -- real*8 values (equivalenced).
C JRTCOD is the return code.
C
C MARRAY(1) is the set number. (5) (negative allowed)
C MARRAY(2) is the set type.
C MARRAY(3) is the priority. (2)
C MARRAY(4) is the number of variables in the set.
C MARRAY(5) is the column number of current variable. (4)
C (negative allow)
C MARRAY(6) is which way. (4)
C DARRAY(1) is the current value of variable.
C DARRAY(2) is the down pseudo-cost. (3)
C DARRAY(3) is the up cost (3) or ref row entry (4).
C DARRAY(4) is the estimated degradation for going down. (4) (5)
C DARRAY(5) is the estimated degradation for going up. (4) (5)
C
C Note:
C The (n) to the right of the definitions of the MARRAY and DARRAY
C elements indicate that these data items are available and/or may
C be set when the calling parameter REASON=n.
C
C***********************************************************************
C
SUBROUTINE EKKBRNU(DSPACE,MSPACE,IREASN,MARRAY,DARRAY,JRTCOD)
C
C Include files with control variable definitions.
IMPLICIT REAL*8(D)
INCLUDE (OSLI)
INCLUDE (OSLN)
C
C Communication with EXNODU(EKKNODU).
COMMON/USRCOM1/DBRANCH
C
REAL*8 DSPACE(*),DARRAY(5)
INTEGER*4 MSPACE(*),MARRAY(6)
SAVE DREFSUM,DSUM,DLO,DHI
C
C Only interested on first and last call
GOTO (1000,6000,6000,6000,5000) ,IREASN
C
C Initial entry - do all work here
1000 CALL EKKIGET(IRTCOD,DSPACE,OSLI,OSLILN)
CALL EKKNGET(IRTCOD,DSPACE,OSLN,OSLNLN)
WRITE (6,101) 'There are ',INUMSETS,' sets and',INUMINTS,
+ ' variables'
101 FORMAT(1X,A,I5,A,I5,A)
C
C Number in grid
NGRID=INUMINTS/INUMSETS
ISOL=NCOLSOL-1
C
C First set is X by itself
NNZERO=0
DO IVAR=1,NGRID
ISOL=ISOL+1
DVAL=DSPACE(ISOL)
IF(ABS(DVAL).GT.1.0D-5) NNZERO=NNZERO+1
ENDDO
C
C Skip if first set unsatisfied as can do ordinary branch
IF(NNZERO.GT.1) GO TO 6000
C
C Through other sets getting *linked* reference entry
C (In real use we would use true reference entries for grid)
NCENTER= 1+(NGRID-1)/2
DPERGRID=2.0D0/DFLOAT((NGRID-1)/2)
DREFSUM=0.0D0
DSUM=0.0D0
DLO=1.0D20
DHI=-1.0D20
DO ISET =2,INUMSETS
DO IVAR=1,NGRID
ISOL=ISOL+1
DVAL=DSPACE(ISOL)
C accumulate
IF(ABS(DVAL).GT.1.0D-5) THEN
DREFVAL=DFLOAT(IVAR-NCENTER)*DPERGRID
DREFSUM=DREFSUM+DVAL*DREFVAL
DSUM=DSUM+DVAL
DLO=MIN(DLO,DREFVAL)
DHI=MAX(DHI,DREFVAL)
ENDIF
ENDDO
ENDDO
GOTO 6000
C
C At end
5000 IF(MARRAY(1).EQ.1) RETURN
C X satisfied - check Y
IF(DHI-DLO.LE.1.0D-5) RETURN
C choose set 2
MARRAY(1)=-2
C choose where to branch
DBRANCH=DREFSUM/DSUM
6000 CONTINUE
RETURN
END
C***********************************************************************
C
C EXCHNU
C
C This user exit subroutine chooses the next node for the branch
C and bound algorithm.
C
C IREASN=1 : Subroutine is being called before going through the list
C of active nodes.
C =2 : Subroutine is being called as each active node is being
C processed.
C =3 : Subroutine is being called after going through the list
C of active nodes.
C
C MARRAY(1): If IREASN=1, MARRAY(1) is the number of active nodes;
C the rest of MARRAY and DARRAY are not meaningful.
C If IREASN=2, MARRAY(1) is the number of the current node.
C If IREASN=3, MARRAY(1) is the number of the chosen node;
C the rest of MARRAY and DARRAY are not meaningful.
C
C MARRAY(2): Number of unsatisfied variables.
C
C DARRAY(2): Solution value of parent node.
C
C***********************************************************************
C
SUBROUTINE EKKCHNU(DSPACE,MSPACE,IREASN,MARRAY,DARRAY,JRTCOD)
C
C Bring in include file with real control variable definitions.
IMPLICIT NONE
INCLUDE (OSLR)
C
REAL*8 DSPACE(*),DARRAY(4),RXTARGET,DBEST,DVALOBJ
INTEGER*4 MSPACE(*),IREASN,MARRAY(6),JRTCOD,RTCOD,NUMBER,IBEST
SAVE DBEST,IBEST,NUMBER,RXTARGET
C
C Communication with EXEVNU(EKKEVNU).
COMMON/USERCOM/DVALOBJ
C
C Choose node with smallest number of infeasibilities,
C but try to stay above the target value.
C
GOTO (1000,2000,3000) ,IREASN
C
C Initialization
C
1000 DBEST=1.0D30
IBEST=0
NUMBER=999999
C
C Find target value.
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
RXTARGET=RTARGET
C
C Set return code to force EKKCHNU calls.
JRTCOD=0
GOTO 4000
C
C Ordinary call.
C
2000 IF(DARRAY(2).LT.RXTARGET) THEN
C Better than the target, so choose one with fewest
C infeasibilities.
IF(NUMBER.GT.MARRAY(2)) THEN
C Fewer infeasibilities -- choose this one.
DBEST=DARRAY(2)
IBEST=MARRAY(1)
NUMBER=MARRAY(2)
ELSEIF(NUMBER.EQ.MARRAY(2).AND.DBEST.GT.DARRAY(2)) THEN
C Same number, but better value.
DBEST=DARRAY(2)
IBEST=MARRAY(1)
ENDIF
ENDIF
GOTO 4000
C
C Done
C If any node better than target, point to one with fewest
C infeasibilities.
C
3000 IF(IBEST.NE.0) MARRAY(1)=IBEST
C
C Store value of objective for EKKEVNU.
DVALOBJ=DBEST
4000 CONTINUE
C
RETURN
END
C*********************************************************************** C C EXCUTU C C Sample user exit routine EKKCUTU. EKKCUTU allows you to generate C "cuts", or additional constraint rows, to a problem matrix. It is C called during EKKMPRE preprocessing, or during supernode C processing in EKKMSLV. C C On Input MSTATBIN tells the user which 0-1 variables have been C fixed so far, -1 says fixed to 0, +1 to 1, 0 still free. C It is of length NBIN. MTOBIN is an array of INUMCOLS C length which has 0 for a continous, - the type for other C "Integer" variables and points into MSTATBIN for all 0-1 C variables. C C The user returns a series of cuts by filling in MCADD,MRADD, C DEADD and NADD. C C MCADD - 1 is the first column of matrix, INUMCOLS is last. C minus 1 denotes a lower bound on a row and minus 2 C denotes an upper bound. C C If on entry NADD were 1002 and NROW were 205 then to add a C single cut of X + 2* Y <= 2 might be: C C IADD MCADD MRADD DEADD C C 1003 5 206 1.0 C 1003 407 206 2.0 C 1003 -2 206 2.0 C C and NADD would be changed to 1005 on exit, and NROW to 206. C C DSPACE - Main Data Array C MSTATBIN- Column status: 0 - free, 1 - fixed to 1, -1 - fixed to 0 C MTOBIN - 0 or 0-1 sequence for each real variable C MCADD - Column indices of cuts C MRADD - Row indices of cuts C DEADD - Elements of cuts C NBIN - Number of 0-1 variables in MSTAT01 C NADD - Current number of entries in MCADD,MRADD and DEADD C NADDMAX - Maximum number of entries allowed C NROW - Current number of rows in matrix (including cuts) C NROWMAX - Maximum number of rows allowed C C*********************************************************************** C SUBROUTINE EKKCUTU(DSPACE,MSTATBIN,MTOBIN,MCADD,MRADD,DEADD,NBIN, + NADD,NADDMAX,NROW,NROWMAX) C IMPLICIT REAL*8 (D,Z) REAL*8 DSPACE(*) INTEGER*4 MSTATBIN(NBIN),MTOBIN(NBIN) INTEGER*4 MCADD(NADDMAX),MRADD(NADDMAX) REAL*8 DEADD(NADDMAX) C C In actual use one or more cuts would be computed. C For explanations we assume that variables are X1,X2.... C Assume first cut is magically in a Data statement REAL*8 DELEMENT(5),DRHS INTEGER*4 MCOLUMN1(5),MCOLUMN2(3) C C First cut will be 5 X4 - 7 X6 + X8 +10 X30 - X2 <= 8 DATA DELEMENT/5.0D0,-7.0D0,1.0D0,10.0D0,-1.0D0/,DRHS/8.0D0/ DATA MCOLUMN1/4,6,8,30,2/ DATA MCOLUMN2/1,4,7/ C C Add in first cut if enough room IF(NROW.LT.NROWMAX.AND.NADD.LE.NROWMAX-6) THEN NROW=NROW+1 C elements DO I=1,4 NADD=NADD+1 MRADD(NADD)=NROW MCADD(NADD)=MCOLUMN1(I) DEADD(NADD)=DELEMENT(I) ENDDO C upper bound on row activity NADD=NADD+1 MRADD(NADD)=NROW MCADD(NADD)=-2 DEADD(NADD)=DRHS ENDIF C C Second cut will be X1 + X4 + X7 = 1 IF(NROW.LT.NROWMAX.AND.NADD.LE.NROWMAX-5) THEN NROW=NROW+1 C elements DO I=1,3 NADD=NADD+1 MRADD(NADD)=NROW MCADD(NADD)=MCOLUMN2(I) DEADD(NADD)=1.0D0 ENDDO C upper bound on row activity NADD=NADD+1 MRADD(NADD)=NROW MCADD(NADD)=-2 DEADD(NADD)=1.0D0 C and lower bound NADD=NADD+1 MRADD(NADD)=NROW MCADD(NADD)=-1 DEADD(NADD)=1.0D0 ENDIF RETURN END
C*********************************************************************** C C EXEVNU C C This user exit routine determines whether the primal or the C dual simplex method will be used to evaluate the current node. C C The routine is written under the assumption that for the class C problems being solved, the primal algorithm is faster than the C dual algorithm. However, with the dual algorithm, the branch can C be cut off when the objective increases above the cutoff. So this C routine selects the primal algorithm unless the objective is near C the cutoff. It is assumed that EKKCHNU saved the value of the C objective function in DVALOBJ. C C Note that the return code must be set if the problem in infeasible. C C*********************************************************************** C SUBROUTINE EKKEVNU(DSPACE,MSPACE,JRTCOD) C C Bring in include files with control variable definitions. IMPLICIT NONE INCLUDE (OSLR) INCLUDE (OSLI) C REAL*8 DSPACE(*),DVALOBJ INTEGER*4 MSPACE(*),RTCOD,JRTCOD C C Communication with EXCHNU(EKKCHNU). COMMON/USERCOM/DVALOBJ C C Get cutoff. CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN) IF(DVALOBJ+2000.0.GT.RBBCUTOFF) THEN C Near cutoff, so use dual algorithm. CALL EKKSSLV(RTCOD,DSPACE,2,1) ELSE C Not near cutoff, so use primal algorithm. CALL EKKSSLV(RTCOD,DSPACE,1,1) ENDIF CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN) C C Set user return code if needed. IF(IPROBSTAT.NE.0) THEN JRTCOD = 1 ELSE JRTCOD = 0 ENDIF C RETURN END
C*********************************************************************** C C EXHEUU C C Sample user exit routine EKKHEUU. EKKHEUU gives you control over C the fixing of variables to their upper or lower bounds. C C On Input MSTATBIN tells the user which 0-1 variables have been C fixed so far, -1 says fixed to 0, +1 to 1, 0 still free. C It is of length NBIN. MTOBIN is an array of INUMCOLS C length which has 0 for a continous, - the type for other C "Integer" variables and points into MSTATBIN for all 0-1 C variables. C C The user returns a valid branch. Processing will continue C setting 0-1 variables to their bounds using the first C NFIX1 entries in MFIX. The postponed branch (which is only C used if JTYPE is 2) is given by the next NFIX2 entries of MFIX. C C In this example the user knows that going up to 1 is always C feasible, so the variable closest to one will be chosen C C Calling sequence - CALL EKKHEUU C C DSPACE - Main Data Array C MSTATBIN - Column status: 0 -free, 1 -fixed to 1, -1 -fixed to 0 C MTOBIN - 0 or 0-1 sequence for each real variable C MFIX - Stack of 0-1s - negative fixed to, positive to 1 C (maximum length 2*NBIN) C NBIN - Number of 0-1 variables in MSTATBIN C NFIX1 - Number of variables fixed on this way C NFIX2 - Number of variables fixed on postponed way C JTYPE - 1 for heuristic guess, 2 for heuristic branch C C********************************************************************* C SUBROUTINE EKKHEUU(DSPACE,MSTATBIN,MTOBIN,MFIX,NBIN,NFIX1, + NFIX2,JTYPE) C IMPLICIT REAL*8 (D,Z) REAL*8 DSPACE(*) INTEGER*4 MSTATBIN(NBIN),MFIX(*),MTOBIN(*) C C Bring in include files with control variable definitions. INCLUDE (OSLN) INCLUDE (OSLI) C C Do nothing unless in Branch and bound phase IF(JTYPE.NE.2) RETURN C C Get all values (GETs need only be done once) CALL EKKIGET(IRET,DSPACE,OSLI,OSLILN) CALL EKKNGET(IRET,DSPACE,OSLN,OSLNLN) C C Find largest 0-1 value (not at 1) DLARGE=0.0D0 ICHOSEN=0 DO ICOL=1,INUMCOLS IF(MTOBIN(ICOL).GT.0) THEN DVAL=DSPACE(NCOLSOL+ICOL-1) IF(DVAL.LT.0.9999D0.AND.DVAL.GT.DLARGE) THEN DLARGE=DVAL ICHOSEN=ICOL ENDIF ENDIF ENDDO IF(ICHOSEN.EQ.0) STOP 'This should never happen' C C Find 0-1 sequence ICHOSEN=MTOBIN(ICHOSEN) C C Carry on with this one to one NFIX1=1 MFIX(1)=ICHOSEN C C And postpone other way NFIX2=1 MFIX(2)=-ICHOSEN RETURN END
C*********************************************************************** C C EXNODU C C This user exit routine allows for non standard branching. C Data will be saved and restored to allow very flexible C branch and bound. It is intended for use with EXMSLV3 and C EXBRNU2. C C DSPACE is the user work area. C MSPACE is the user work area. C IREASN is the reason for calling. C MARRAY is the short node list -- integer values. C DARRAY is the short node list -- real*8 values (equivalenced). C C MARRAY(1) - Branch type SOS=1-3, Integer=4,Null=99 C MARRAY(2) - 0 for down branch , 1 for up C MARRAY(3) - Variable number / Set number C DARRAY(1) - Integer value/Set reference value C C MUSER - User array C NUSER - Length of array C C*********************************************************************** C SUBROUTINE EKKNODU(DSPACE,MSPACE,IREASN,MARRAY,DARRAY,MUSER,NUSER) C C Include files with control variable definitions. IMPLICIT REAL*8(D) INCLUDE (OSLI) INCLUDE (OSLN) C REAL*8 DSPACE(*),DARRAY(1),DTEMP(10) INTEGER*4 MARRAY(3),MUSER(NUSER),MSPACE(*),MTEMP(20) EQUIVALENCE (MTEMP,DTEMP) SAVE DTEMP,MTEMP C C Communication with EXBRNU2(EKKBRNU) COMMON/USRCOM1/DBRANCH C C This example assumes Imiplength was 20 IF(NUSER.NE.20) THEN WRITE(6,*)'Error detected in user exit EKKNODU' WRITE(6,*)'Bad example coding - Imiplength must be = 20' WRITE(6,*)'Stopping your application now' STOP ENDIF C GOTO (1000,2000) ,IREASN C C Return if ordinary branch 1000 IF(MARRAY(3).EQ.1) RETURN C C Save any information which will be needed when node is evaluated. C this information can be of any kind. The user could be C continually refining the grid, in which case information C on mesh size and X,Y values of basic variables would be stored C then in EKKEVNU the matrix could be completely rewritten! C DTEMP(1)=DBRANCH DO I = 1,NUSER MUSER(I)=MTEMP(I) ENDDO C Switch off ***ANY*** action to fix variables MARRAY(1)=99 GOTO 3000 C C Return if ordinary branch 2000 IF(MARRAY(1).NE.99) RETURN C Now set all variables to zero DO I = 1,NUSER MTEMP(I)=MUSER(I) ENDDO DBRANCH=DTEMP(1) IF(MARRAY(2).EQ.1) THEN C Up branch - fix all low reference values to zero DLO=-1.0D20 DHI=DBRANCH ELSE C Down branch - fix all high reference values to zero DLO=DBRANCH DHI=1.0D20 ENDIF CALL EKKIGET(IRTCOD,DSPACE,OSLI,OSLILN) CALL EKKNGET(IRTCOD,DSPACE,OSLN,OSLNLN) C C Number in grid NGRID=INUMINTS/INUMSETS IUP=NCOLUPPER-1+NGRID C C Through other sets getting *linked* reference entry C (In real use we would use true reference entries for grid) NCENTER= 1+(NGRID-1)/2 DPERGRID=2.0D0/DFLOAT((NGRID-1)/2) DO ISET =2,INUMSETS DO IVAR=1,NGRID IUP=IUP+1 DBRANCH=DFLOAT(IVAR-NCENTER)*DPERGRID C zero bound if in range IF(DBRANCH.GE.DLO.AND.DBRANCH.LE.DHI) THEN DSPACE(IUP)=0.0D0 ENDIF ENDDO ENDDO 3000 RETURN END
C***********************************************************************
C
C EXSLVU
C
C This program reads a quadratic integer program from MPS files,
C solves the problem, and prints the solution.
C
C***********************************************************************
C
PROGRAM MAIN
C
INCLUDE(OSLI)
INCLUDE(OSLN)
INCLUDE(OSLR)
C
C Allocate dspace.
IMPLICIT NONE
INTEGER*4 MAXSPC,RTCOD
PARAMETER (MAXSPC=200000)
REAL*8 DSPACE(MAXSPC)
COMMON/BIG/DSPACE
C
C**********************************************************************
C
C Describe application and specify that there is 1 model.
CALL EKKDSCA(RTCOD,DSPACE,MAXSPC,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCA',RTCOD)
C
C Describe the model. Minimum of 5 blocks are needed for QP.
CALL EKKDSCM(RTCOD,DSPACE,1,5)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
C
C Read linear model data from MPS file on unit 98.
CALL EKKMPS(RTCOD,DSPACE,98,2,9)
IF (RTCOD.GT.0) CALL CHKRT('EKKMPS ',RTCOD)
C
C Read quadratic matrix from file on unit 99.
CALL EKKQMPS(RTCOD,DSPACE,99,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKQMPS',RTCOD)
C
C Solve quadratic MIP problem using B&B algorithm.
CALL EKKMSLV(RTCOD,DSPACE,1,0,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKMSLV',RTCOD)
C
C Print the solution.
CALL EKKPRTS(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKPRTS',RTCOD)
C
STOP
END
C
C***********************************************************************
C This subroutine prints the character string RTNAME and the return
C code RTCOD and stops if RTCOD is large enough to indicate that an
C error or severe error has occured.
C***********************************************************************
C
SUBROUTINE CHKRT(RTNAME,RTCOD)
CHARACTER*7 RTNAME
INTEGER*4 RTCOD
C
WRITE(6,9000) RTNAME,RTCOD
IF (RTCOD.GE.200) STOP 16
RETURN
9000 FORMAT (1X,'********** ',A7,' return code of ',I4,' **********')
END
C***********************************************************************
C
C EXSLVU
C This sample user exit program shows how to invoke EKKQSLV to
C solve a branch and bound node of a quadratic MIP problem. It may
C also be used for linear MIP problems. There are three situations
C in which EKKSLVU is called. The first situation corresponds to the
C
C***********************************************************************
C
C DOBJVAL- Value of objective
C JRTCOD - Return code
C JTYPE - 1 - initial solve
C 2 - normal node
C 3 - final solve
C
C***********************************************************************
SUBROUTINE EKKSLVU(DSPACE,MSPACE,DOBJVAL,JRTCOD,JTYPE)
* ---------------------------------------
IMPLICIT NONE
REAL*8 DSPACE(*),DOBJVAL
INTEGER*4 MSPACE(*),JRTCOD,JTYPE,IINIT,IALG,IRTCOD
INCLUDE (OSLI)
INCLUDE (OSLN)
INCLUDE (OSLR)
c
IF (JTYPE.EQ.1) THEN
IALG = 1
IINIT = 1
ELSEIF (JTYPE.EQ.2) THEN
IALG = 2
IINIT = 0
ELSEIF (JTYPE.EQ.3) THEN
IALG = 1
IINIT = 1
ENDIF
C Solve the LP or QP node
CALL EKKNGET(IRTCOD,DSPACE,OSLN,OSLNLN)
IF(NQELEM.EQ.0) THEN
CALL EKKSSL2(JRTCOD,DSPACE,IALG,IINIT)
ELSE
CALL EKKQSLV(JRTCOD,DSPACE,IALG,IINIT)
ENDIF
CALL EKKIGET(IRTCOD,DSPACE,OSLI,OSLILN)
JRTCOD=IPROBSTAT
CALL EKKRGET(IRTCOD,DSPACE,OSLR,OSLRLN)
DOBJVAL=ROBJVALUE
RETURN
END
C********************************************************************* C C EXORDU C C This user exit enables the user to custom-order the LP matrix. In C this example, Joseph Liu's Multiple Minimum Degree algorithm (to C be supplied by the user, GENMMD) is used. C C ADJNCY: The entries (row indices) for the adjacency matrix C PERM : The array where the permutation will be put C INVP : The array where the inverse permutation will be put C MWORK : An integer array for user work space C NWORDS: The length of MWORK in single (INTEGER*4) words. C NROW : The row size of the LP matrix A C C********************************************************************* C SUBROUTINE EKKORDU(XADJ,ADJNCY,PERM,INVP,MWORK,NWORDS,NROW) C ------------------------------------------- C IMPLICIT REAL*8(A-H,O-W,Y-Z), INTEGER*4(I-J,X) INTEGER*4 XADJ(*),ADJNCY(*),PERM(*),INVP(*),MWORK(*) C C Test for sufficient space. C IF (NWORDS .LT. 4*NROW) STOP ' Not enough space for GENMMD' C C Set some GENMMD-specific parameters C METOL = 1 MAXI4 = 2**30 C CALL GENMMD(NROW,XADJ,ADJNCY,INVP,PERM,METOL,MWORK(1), * MWORK(NROW+1),MWORK(2*NROW+1),MWORK(3*NROW+1), * MAXI4,NOFSUB ) RETURN END