These are sample FORTRAN programs used in part (6) or in whole throughout this document. In addition to these programs, there may be additional sample FORTRAN programs distributed with the Optimization Library code. Note that these simple driver programs are only samples that show how an application program that uses Optimization Library modules should be organized. They should not be used for production work or for evaluating performance.
C***********************************************************************
C
C EXIMDL4
C
C***********************************************************************
C
C This driver solves a separable minimization problem in two
C variables x and y. The linear problem constraints are given by
C 0<=x<=10, 0<=y<=10 and x+y<=4.5. The objective function,
C Fx(x)+Fy(y) is modelled by a piecewise linear function Px(x)+Py(y).
C A Special Ordered Set of type 2 is used to express points on the
C curve Px() as convex combinations of adjacent knots in the
C curve. The set is referred to below as SOSx. Similarly the type 2
C Special Ordered Set SOSy is used to model Py(). The knots (x,Px(x))
C are given by (0,2), (7/10,1), (1,5), (4,-1), (5,-3), (10,4), and
C the knots for Py() are given by (0,2), (1,4), (4,-1) and (10,-2).
C The value of x is given by the dot product SOSx()*xabs() where
C xabs() contains the abscissae of the knots of Px(). A convexity
C row for SOSx ensures that the sum of the non-zero components of
C SOSx sum to one. Similarly, y=SOSy()*yabs(), where the non-zero
C components of SOSy() sum to one. The linearized objective function
C Px(x)+Py(y) is created by loading the ordinates of the knots into
C cost vector. Feasible values for SOSx() and SOSy() then
C yield objective values of SOSx()*xord()+SOSy()*yord().
C The variables x and y themselves have objective function
C coefficients of 0.
C
C To demonstrate the use of "overlapping" Special Ordered Sets
C (i.e. SOS's that share one or more variables), the non-convex
C constraint that x may not be strictly between 4 and 5 is added.
C This is done by creating SOSo, a Special Ordered Set of type 1.
C The two members of the set are members 4 and 5 (corresponding to
C knots 4 and 5) of SOSx.
C
C
C MIP formulation:
C min 2x1 + x2 + 5x3 - x4 - 3x5 + 4x6 +
C 2y1 + 4y2 - y3 - 2y4
C .s.t. x1 + x2 + x3 + x4 + x5 + x6 = 1
C (7/10)x2 + x3 + 4x4 + 5x5 +10x6 - x = 0
C y1 + y2 + y3 + y4 = 1
C y2 + 4y3 +10y4 - y = 0
C x + y <= 4.5
C 0<=x<=10, 0<=y<=10, xi = 0 for all i
C x1,x2,x3,x4,x5,x6 are members of an SOS of type 2 (SOSx)
C y1,y2,y3,y4 are members of an SOS of type 2 (SOSy)
C x4,x5 are members of an SOS of type 1 (SOSo)
C
C The variables x1 up to x6 contain the members of SOSx, and the
C variables y1 up to y4 contain the members of SOSy.
C Columns 1...6 contain x1...x6, col 7 contains x, cols 8...11
C contain y1...y4 and col 12 contains y. During the solution process,
C no more than two members of a given SOS2 will be non-zero, and if
C two are nonzero, then they must be adjacent. The user must supply
C convexity rows that are required by the formulation. Rows 1 and 3
C are the convexity rows for this problem.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include files with control variable definitions.
IMPLICIT NONE
INCLUDE (OSLR)
INCLUDE (OSLI)
INCLUDE (OSLN)
C
C Allocate dspace and other arrays.
INTEGER*4 MAXSPC,RTCOD,MEMBER
PARAMETER (MAXSPC=500000)
REAL*8 DSPACE(MAXSPC),XABS(6),XORD(6),YABS(4),YORD(4)
CHARACTER*8 QSPACE(MAXSPC)
COMMON/BIG/DSPACE
EQUIVALENCE(QSPACE,DSPACE)
C
C Number of rows, columns, elements and type of EKKLMDL input format.
INTEGER*4 NROW,NCOL,NELS,ITYPE
DATA NROW,NCOL,NELS,ITYPE/5,12,0,1/
C
C Row and Column indices
INTEGER*4 IA(50),JA(50)
C
C Upper and lower bounds of rows and columns, and elems and cost
REAL*8 DRLO(50),DRUP(50),DCLO(50),DCUP(50),DELS(100),DOBJ(50)
C
C Number of integer variables (and/or SOS members) and the corresponding
C column numbers
INTEGER*4 NINTS, INTNUMS(10)
DATA NINTS /10/, INTNUMS/1,2,3,4,5,6,8,9,10,11/
C
C Number of sets of integer variables, types and priorities.
INTEGER*4 NSETS, TYPE(3), PRIORITY(3)
DATA NSETS /3/, TYPE /2,2,1/, PRIORITY /1000,1000,1000/
C
C Total size of sets and integer variables.
INTEGER*4 NTOTINFO
DATA NTOTINFO /12/
C
C Indices of sets and numbers of the variables in the sets.
C SETINDEX(i) gives the beginning index for the segment of the SETS()
C array that contains Special Ordered Set i. So the members of the
C first SOS are listed in entries 1 through (7-1) of SETS(). Note that
C columns 4 and 5 are listed twice in SETS(). This is because these
C columns belong to the first and the third Special Ordered Set. The
C last entry in SETINDEX() is NTOTINFO+1, the upper bound for the last
C SOS in SETS().
INTEGER*4 SETINDEX(4), SETS(12)
DATA SETINDEX/1,7,11,13/, SETS/1,2,3,4,5,6,8,9,10,11,4,5/
C
C Pseudo costs. (Up pseudocost used for ref row entries)
REAL*8 DNPCOST(50),UPPCOST(50)
C
C Load abscissae and ordinates for the piecewise linear objectives
DATA XABS / 0.0d0, 0.7d0, 1.0d0, 4.0d0, 5.0d0, 10.0d0 /
DATA XORD / 2.0d0, 1.0d0, 5.0d0, -1.0d0, -3.0d0, 4.0d0 /
DATA YABS / 0.0d0, 1.0d0, 4.0d0, 10.0d0 /
DATA YORD / 2.0d0, 4.0d0, -1.0d0, -2.0d0 /
C
C Load information for SOSx
DO MEMBER=1,6
C Load convexity row for SOSx so that SOSx yields a convex
C combination of two adjacent grid points.
NELS = NELS + 1
JA(NELS) = MEMBER + 0
IA(NELS) = 1
DELS(NELS) = 1.0d0
C Load the "value row" for x to impose the constraint x=SOSx()*xabs()
C Also add reference row entries in up pseudocost array.
NELS = NELS + 1
JA(NELS) = MEMBER + 0
IA(NELS) = 2
DELS(NELS) = XABS(MEMBER)
UPPCOST(MEMBER+0) = XABS(MEMBER)
DOBJ(MEMBER+0) = XORD(MEMBER)
DCLO(MEMBER+0) = 0.0d0
DCUP(MEMBER+0) = 1.0d+31
ENDDO
C Set row bounds for convexity row so that 1 <= conv(SOSx) <= 1
DRLO(1) = 1.0d0
DRUP(1) = 1.0d0
C Set row bounds for value row so that 0 <= SOSx()*xabs() - x <= 0
DRLO(2) = 0.0d0
DRUP(2) = 0.0d0
C
C Add column for x
NELS = NELS + 1
IA(NELS) = 2
JA(NELS) = 7
DELS(NELS) = -1.0d0
DOBJ(7) = 0.0d0
DCLO(7) = 0.0d0
DCUP(7) = 10.0d0
C
DO MEMBER=1,4
C Load convexity row for SOSy so that SOSy yields a convex
C combination of two adjacent grid points.
NELS = NELS + 1
JA(NELS) = MEMBER + 7
IA(NELS) = 3
DELS(NELS) = 1.0d0
C Load the "value row" for y to impose the constraint y=SOSy()*yabs()
C Also add reference row entries in up pseudocost array.
NELS = NELS + 1
JA(NELS) = MEMBER + 7
IA(NELS) = 4
DELS(NELS) = YABS(MEMBER)
UPPCOST(MEMBER+6) = YABS(MEMBER)
DOBJ(MEMBER+7) = YORD(MEMBER)
DCLO(MEMBER+7) = 0.0d0
DCUP(MEMBER+7) = 1.0d+31
ENDDO
C Set row bounds for convexity row so that 1 <= conv(SOSy) <= 1
DRLO(3) = 1.0d0
DRUP(3) = 1.0d0
C Set row bounds for value row so that 0 <= SOSy()*yabs() - y <= 0
DRLO(4) = 0.0d0
DRUP(4) = 0.0d0
C
C Add column for y
NELS = NELS + 1
IA(NELS) = 4
JA(NELS) = 12
DELS(NELS) = -1.0d0
DOBJ(12) = 0.0d0
DCLO(12) = 0.0d0
DCUP(12) = 10.0d0
C Add constraint x+y<=4.5
NELS = NELS + 1
IA(NELS) = 5
JA(NELS) = 7
DELS(NELS) = 1.0d0
NELS = NELS + 1
IA(NELS) = 5
JA(NELS) = 12
DELS(NELS) = 1.0d0
DRLO(5) = -1.0d+31
DRUP(5) = 4.5d0
C Load reference row entries for the SOS1 set. Any non-decreasing
C or non-increasing sequence will suffice.
UPPCOST(11) = XORD(4)
UPPCOST(12) = XORD(5)
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.
CALL EKKDSCM(RTCOD,DSPACE,1,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
C
C Pass the model with the matrix stored by indices.
CALL EKKLMDL(RTCOD,DSPACE,ITYPE,NROW,NCOL,NELS,DOBJ,
+ DRLO,DRUP,DCLO,DCUP,IA,JA,DELS)
IF (RTCOD.GE.200) CALL CHKRT('EKKLMDL',RTCOD)
C
C Create names for the variables
CALL EKKNAME(RTCOD,DSPACE,0,0,1,0,0,1,1)
IF (RTCOD.GE.200) CALL CHKRT('EKKNAME',RTCOD)
C
C Load names for x and y into the names region.
CALL EKKNGET(RTCOD,DSPACE,OSLN,OSLNLN)
QSPACE(NCOLNAMES+7-1) = 'X_value'
QSPACE(NCOLNAMES+12-1) = 'Y_value'
C
C Specify three integer variables.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
IMAXINTS = 15
ISOLMASK = 6
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKISET',RTCOD)
C
C Specify the integer parts of a mixed integer programming problem.
CALL EKKIMDL(RTCOD,DSPACE,NINTS,INTNUMS,NSETS,TYPE,
+ PRIORITY,NTOTINFO,SETINDEX,SETS,DNPCOST,UPPCOST)
IF (RTCOD.GT.0) CALL CHKRT('EKKIMDL',RTCOD)
C
C Solve the model using mixed-integer programming.
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 occurred.
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 EXIMDL5
C
C This example program helps to show how the input for EKKIMDL can
C be simplified in the cases where 1) All of the problem variables
C should be regular integer variables, and 2) Only those variables
C listed in parameter 4 of IMDL should be regular integer variables,
C and all other problem variables may take on any value. Case 1) is
C brought about by setting NINTS=0, NSETS=0 and NTSIZE=0 in parameters
C 3, 5 and 8 of EKKIMDL. Case 2) is brought about by setting NINTS
C equal to the number of integer variables listed in parameter 4 of
C EKKIMDL, and setting NSETS=0 and NTSIZE=0. This driver is an example
C of Case 2).
C
C
C This program solves the following problem:
C
C Maximize 4x1 - 2x2 + 7x3 - x4
C
C Subject to:
C
C x1 + 5x3 <= 10
C x1 + x2 - x3 <= 1
C 6x1 - 5x2 <= 0
C -x1 + 2x3 - 2x4 <= 3
C
C
C And subject to:
C
C 0 <= x1 <= 1.0D+6 ; x1 integer variable
C 0 <= x2 <= 1.0D+6 ; x2 integer variable
C 0 <= x3 <= 1.0D+6 ; x3 integer variable
C 0 <= x4 <= 1.0D+6
C
C NROW is the number of rows in the constraint matrix.
C NCOL is the number of columns in the constraint matrix.
C NEL is the number of elements in the constraint matrix.
C ITYPE is the storage format.
C IRL is the length of the arrays containing row information.
C ICL is the length of the arrays containing column information.
C ICL1 is ICL + 1
C NINTS is the number of integer variables.
C MINTS is the variable numbers of integer variables.
C NSETS is the number of sets of integer variables.
C NTSIZE is the total size of sets plus variables.
C NSSETS is the variable numbers of variables in sets.
C IMDLTP is the types of sets of integer variables.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include files with control variable definitions.
INCLUDE (OSLR)
INCLUDE (OSLI)
INCLUDE (OSLN)
C
C Allocate dspace and other arrays.
INTEGER*4 MAXSPC,IRL,ICL,ICL1,RTCOD
PARAMETER (MAXSPC=100000,IRL=4,ICL=4,ICL1=5)
REAL*8 DSPACE(MAXSPC)
INTEGER*4 MSPACE(2*MAXSPC)
EQUIVALENCE (MSPACE,DSPACE)
INTEGER*4 NINTS,NSETS,NTSIZE
COMMON/BIG/DSPACE
C
C Define the linear model.
C
INTEGER*4 NROW,NCOL,NEL,ITYPE
DATA NROW,NCOL,NEL,ITYPE/4,4,10,1/
C
C Objective function coefficients.
REAL*8 DOBJ(IRL)
DATA DOBJ/4.0D0,-2.0D0,7.0D0,-1.0D0/
C
C Elements of the constraint matrix.
REAL*8 DELS(10)
DATA DELS /2*1.0D0,6.0D0,-1.0D0,1.0D0,-5.0D0,
+ 5.0D0,-1.0D0,2.0D0,-2.0D0/
C
C Row and Column indices of matrix elements.
INTEGER*4 IA(10),JA(10)
DATA IA/1,2,3,4,2,3,1,2,4,4/ JA/4*1,2*2,3*3,4/
C
C Upper and lower bounds of rows.
REAL*8 DRLO(IRL),DRUP(IRL)
DATA DRLO/IRL*-1.0D31/ DRUP/1.0D1,1.0D0,0.0D0,3.0D0/
C
C Upper and lower bounds of columns.
REAL*8 DCLO(ICL),DCUP(ICL)
DATA DCLO/ICL*0.0D0/ DCUP/ICL*1.0D06/
C
C Indicate the integer constraints.
C
C Number of integer variables. If NINTS=0, all variables will be
C assumed to be regular integer variables.
DATA NINTS/3/
C
C Variable numbers of the integer variables
INTEGER*4 MINTS(3)
DATA MINTS/1,2,3/
C
C Number of sets of integer variables. With NSETS=0, EKKIMDL will put
C all integer variables into one set of type 4 (regular integer
C variables). To force the variables to be 0-1 variables, adjust the
C bounds accordingly.
DATA NSETS/0/
C
C Set priorities. The priorities will be assumed to be 1000 since NSET
INTEGER*4 PRI(1)
DATA PRI/0/
C
C Total size of sets and variables. 0 will indicate that psuedocosts
C should be assumed to be 0.
DATA NTSIZE/0/
C
C Indices of sets. This will be ignored by EKKIMDL since NSETS=0.
INTEGER*4 NSETIN(1)
DATA NSETIN/0/
C
C Variable numbers of the variables in sets. Ignored, since NSETS=0
INTEGER*4 NSSETS(1)
DATA NSSETS/0/
C
C Pseudo costs. These will be ignored by EKKIMDL since NTSIZE=0
REAL*8 DNPCOST(1),UPPCOST(1)
DATA DNPCOST/0.0d0/ UPPCOST/0.0d0/
C
C Types of sets for EKKIMDL call. This is ignored since NSETS=0.
INTEGER*4 IMDLTP(1)
DATA IMDLTP/0/
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.
CALL EKKDSCM(RTCOD,DSPACE,1,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
C
C Specify maximization problem.
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRGET',RTCOD)
RMAXMIN = -1.0D0
CALL EKKRSET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRSET',RTCOD)
C
C Specify three integer variables.
c CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
c IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
c IMAXINTS = 10
c CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
c IF (RTCOD.GT.0) CALL CHKRT('EKKISET',RTCOD)
C
C Pass the model with the matrix stored by indices.
CALL EKKLMDL(RTCOD,DSPACE,ITYPE,NROW,NCOL,NEL,DOBJ,
+ DRLO,DRUP,DCLO,DCUP,IA,JA,DELS)
IF (RTCOD.GT.0) CALL CHKRT('EKKLMDL',RTCOD)
C
C Specify the integer parts of a mixed integer programming problem.
IF (RTCOD.GT.0) CALL CHKRT('EKKIMDL',RTCOD)
C
C Solve the model using mixed-integer programming.
CALL EKKSSLV(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKMSLV',RTCOD)
C
C Print the solution.
CALL EKKPRTS(RTCOD,DSPACE)
C
C
C Specify the integer parts of a mixed integer programming problem.
CALL EKKIMDL(RTCOD,DSPACE,NINTS,MINTS,NSETS,IMDLTP,
+ PRI,NTSIZE,NSETIN,NSSETS,DNPCOST,UPPCOST)
IF (RTCOD.GT.0) CALL CHKRT('EKKIMDL',RTCOD)
C
C Solve the model using mixed-integer programming.
CALL EKKMSLV(RTCOD,DSPACE,2,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 EXINIT
C
C This program reads an MPS file that has three models that
C are to be solved sequentially. The models are independent of
C one another. Each model is read in, solved, and results are
C printed.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include file with character control variable definitions.
IMPLICIT NONE
INCLUDE (OSLC)
C
C Allocate dspace.
INTEGER*4 MAXSPC,RTCOD,IMODEL,I
PARAMETER (MAXSPC=150000)
REAL*8 DSPACE(MAXSPC)
COMMON/BIG/DSPACE
CHARACTER*80 BLANKS
DATA BLANKS/' '/
C
DO 150 IMODEL=1,3
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 Read model data from MPS file on unit 98.
CALL EKKMPS(RTCOD,DSPACE,98,2,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKMPS ',RTCOD)
C
C Solve problem using simplex method.
CALL EKKSSLV(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
C
C Print the solution.
CALL EKKPRTS(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKPRTS',RTCOD)
C
C Call EKKINIT since EKKDSCA will be called again.
CALL EKKINIT(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKINIT',RTCOD)
C
C Reset all character control variables so the next model may be read.
CALL EKKCGET(RTCOD,DSPACE,OSLC,OSLCLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKCGET',RTCOD)
DO I=1,OSLCLN
OSLC(I)=BLANKS
ENDDO
CALL EKKCSET(RTCOD,DSPACE,OSLC,OSLCLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKCSET',RTCOD)
150 CONTINUE
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
You can run this program using "Sample Linear Programming Model Data 3".
C*********************************************************************** C C EXISET C C This subroutine sets the integer control variable I to the C value NEWVAL. C C*********************************************************************** C SUBROUTINE GETSETI(I,NEWVAL,RTCOD) INTEGER*4 I,NEWVAL,RTCOD C C Bring in include file with integer control variable definitions. INCLUDE (OSLI) C CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN) OSLI(I)=NEWVAL CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN) C RETURN END
C***********************************************************************
C
C EXLMDL
C
C This program solves the following problem:
C
C Maximize x1 + 2x5 - x8
C
C Subject to:
C
C 2.5 <= 3x1 + x2 - 2x4 - x5 - x8
C 2x2 + 1.1x3 <= 2.1
C x3 + x6 = 4.0
C 1.8 <= 2.8x4 -1.2x7 <= 5.0
C 3.0 <= 5.6x1 + x5 + 1.9x8 <= 15.0
C
C and subject to:
C
C 2.5 <= x1
C 0 <= x2 <= 4.1
C 0 <= x3
C 0 <= x4
C 0.5 <= x5 <= 4.0
C 0 <= x6
C 0 <= x7
C 0 <= x8 <= 4.3
C
C NROW is the number of rows in the constraint matrix.
C NCOL is the number of columns in the constraint matrix.
C NEL is the number of elements in the constraint matrix.
C ITYPE is the storage format.
C IRL is the length of the arrays containing row information.
C ICL is the length of the arrays containing column information.
C ICL1 is ICL + 1.
C IEL is the length of the arrays containing element information.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include files with control variable definitions.
IMPLICIT NONE
INCLUDE (OSLI)
INCLUDE (OSLR)
C
C Allocate dspace and other arrays.
INTEGER*4 MAXSPC,IRL,ICL,ICL1,IEL
PARAMETER (MAXSPC=15000,IRL=5,ICL=8,ICL1=9,IEL=14)
REAL*8 DSPACE(MAXSPC)
C
REAL*8 DRLO(IRL),DCLO(ICL),DOBJ(ICL),DELS(IEL),DRUP(IRL),DCUP(ICL)
INTEGER*4 NCOL,NROW,NEL,ITYPE,MCOL(ICL1),MROW(IEL),RTCOD
C
C Define the model.
DATA NROW,NCOL,NEL,ITYPE /5,8,14,2/
C
C Matrix elements.
DATA DELS/3.0D0,5.6D0,1.0D0,2.0D0,1.1D0,1.0D0,-2.0D0,
+ 2.8D0,-1.0D0,1.0D0,1.0D0,-1.2D0,-1.0D0,1.9D0/
C
C Row indices.
DATA MROW/1,5,1,2,2,3,1,4,1,5,3,4,1,5/
C
C Column starts.
DATA MCOL/1,3,5,7,9,11,12,13,15/
C
C Lower bounds on row activities.
DATA DRLO/2.5D0,-1.0D31,4.0D0,1.8D0,3.0D0/
C
C Upper bounds on row activities.
DATA DRUP/1.0D31,2.1D0,4.0D0,5.0D0,1.5D01/
C
C Lower bounds on columns.
DATA DCLO/2.5D0,0.0D0,2*0.0D0,5.0D-1,3*0.0D0/
C
C Upper bounds on columns.
DATA DCUP/1.0D31,4.1D0,2*1.0D31,4.0D0,2*1.0D31,4.3D0/
C
C Objective function coefficients.
DATA DOBJ/1.0D0,3*0.0D0,2.0D0,2*0.0D0,-1.0D0/
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 Set to maximization problem.
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRGET',RTCOD)
RMAXMIN=-1.0D0
CALL EKKRSET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRSET',RTCOD)
C
C Pass the model with matrix stored by columns.
CALL EKKLMDL(RTCOD,DSPACE,ITYPE,NROW,NCOL,NEL,DOBJ,DRLO,DRUP,
+ DCLO,DCUP,MROW,MCOL,DELS)
IF (RTCOD.GT.0) CALL CHKRT('EKKLMDL',RTCOD)
C
C Solve problem using simplex method.
CALL EKKSSLV(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',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
No input data is required to run this program.
C***********************************************************************
C
C EXLPDC
C
C This program demonstrates one use of EKKLPDC. A problem stored
C in MPS format is read in by calling EKKMPS. Next, a call is made to
C EKKLPDC to decompose the problem into a master problem with
C subproblems, and to do one sweep of Dantzig-Wolfe decomposition
C to find an advanced basis. Finally, EKKSSLV is called to solve
C the problem.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include file with real control variable definitions.
INCLUDE (OSLR)
C
C Allocate dspace.
PARAMETER (MAXSPC=1000000)
REAL*8 DSPACE(MAXSPC)
INTEGER*4 RTCOD
COMMON /BIG/DSPACE
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 Read model data from MPS file on unit 98.
CALL EKKMPS(RTCOD,DSPACE,98,2,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKMPS ',RTCOD)
C
C Decompose the problem and get an advanced basis.
C type=2 : one pass of Dantzig-Wolfe decomposition.
C strategy=1 : do not include master rows as constr. for subproblems.
C nblocks=3 : decompose the matrix into 3 blocks. Note that if
C nblocks=0, EKKLPDC determines the number of blocks.
C
CALL EKKLPDC(RTCOD,DSPACE,2,1,3)
IF (RTCOD.GT.0) CALL CHKRT('EKKLPDC',RTCOD)
C
C Call EKKSSLV to solve the problem.
CALL EKKSSLV(RTCOD,DSPACE,1,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',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
You can run this program using "Sample Linear Programming Model Data 6".
C***********************************************************************
C
C EXLPDC2
C
C Dantzig-Wolfe Decomposition Crash
C
C This program reads a problem with a Dantzig-Wolfe (block angular)
C structure from an MPS file. The names of the coupling rows begin
C with 'C'. The names of the non-coupling rows begin with 'B' and the
C block number for each row is found in the first two characters of
C the name.
C
C The name of each of the rows is examined. If the row is a coupling
C row, a 0 is put in the corresponding entry of the row status region.
C Otherwise, the block number is extracted from the name, and this
C number is put into the row status region.
C
C EKKLPDC is called with NBLOCKS=-1, to indicate that a decomposition
C of the rows is given in the row status region. In EKKLPDC, columns
C are assigned to blocks using this information.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include files with control variable definitions.
INCLUDE (OSLN)
INCLUDE (OSLI)
C
C Allocate dspace and other arrays.
INTEGER*4 MAXSPC,IBLOCK
PARAMETER (MAXSPC=20000,IBLOCK=3)
REAL*8 DSPACE(MAXSPC)
INTEGER*4 MSPACE(2*MAXSPC),NBLOCKS,RTCOD
CHARACTER*8 CSPACE(MAXSPC),RNAME
CHARACTER*2 CHARR(IBLOCK),CBLOCKNUM
EQUIVALENCE (CSPACE,DSPACE,MSPACE)
C
DATA CHARR/'01','02','03'/
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 Read model data from MPS file on unit 98.
CALL EKKMPS(RTCOD,DSPACE,98,2,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKMPS ',RTCOD)
C
C Get integer control variables.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
C
C Get index control variables.
CALL EKKNGET(RTCOD,DSPACE,OSLN,OSLNLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKNGET',RTCOD)
C
DO 100 I=1,INUMROWS
RNAME = CSPACE(NROWNAMES+I-1)
IF (RNAME(1:1).EQ.'B') THEN
C This row belongs to a block. Check the name to get the
C block number. This example assumes that the input data have
C only 3 such blocks (IBLOCK=3).
CBLOCKNUM = RNAME(2:3)
DO J=1,IBLOCK
IF (CBLOCKNUM.EQ.CHARR(J)) MSPACE(NROWSTAT+I-1) = J
ENDDO
ELSE
C All other rows will be assigned to block number 0
MSPACE(NROWSTAT+I-1) = 0
ENDIF
100 CONTINUE
C
C Perform decomposition.
C NBLOCKS = -1 : block numbers stored in the row status region.
C
NBLOCKS = -1
CALL EKKLPDC(RTCOD,DSPACE,2,1,NBLOCKS)
C
C Solve the problem using primal simplex.
CALL EKKSSLV(RTCOD,DSPACE,1,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',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
You can run this program using "Sample Linear Programming Model Data 6".
C***********************************************************************
C
C EXMPRSL
C
C This program calls EKKMSLV to solve a mixed-integer programming
C problem. EKKPRSL and EKKMPRE are also used.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include files with control variable definitions.
IMPLICIT NONE
INCLUDE (OSLI)
INCLUDE (OSLR)
INCLUDE (OSLN)
C
C Allocate dspace.
INTEGER*4 MAXSPC
PARAMETER (MAXSPC=900000)
REAL*8 DSPACE(MAXSPC)
INTEGER*4 MSPACE(2*MAXSPC),RTCOD,NUMR8,IND2,INDR,IND,INDI
COMMON/BIG/DSPACE
EQUIVALENCE(DSPACE,MSPACE)
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 Set up for one model
CALL EKKDSCM(RTCOD,DSPACE,1,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
C
C Set control variable Imaxrows for spare rows.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
IMAXROWS = -1000
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKISET',RTCOD)
C
C Read 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 Set to maximization problem.
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRGET',RTCOD)
RMAXMIN=-1.0D0
CALL EKKRSET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRSET',RTCOD)
C
C Presolve the LP.
CALL EKKPRSL(RTCOD,DSPACE,15,3)
IF (RTCOD.GT.0) CALL CHKRT('EKKPRSL',RTCOD)
C
C Solve the LP.
CALL EKKSSLV(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
C
C Presolve the MIP.
CALL EKKMPRE(RTCOD,DSPACE,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKMPRE',RTCOD)
C
C Solve the MIP.
CALL EKKMSLV(RTCOD,DSPACE,1,35,50)
IF (RTCOD.GT.0) CALL CHKRT('EKKMSLV',RTCOD)
C
C Get index and integer control variables.
CALL EKKNGET(RTCOD,DSPACE,OSLN,OSLNLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKNGET',RTCOD)
C
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
C
C NUMR8 is the number of REAL*8 words needed to store indices.
C INUMINTS is the number of REAL*8 words needed to store values.
C
NUMR8=INUMINTS/2
IF (MOD(INUMINTS,2).NE.0) NUMR8=NUMR8+1
C
C Reserve room in dspace to store indices/values of integer variables.
CALL EKKHIS(RTCOD,DSPACE,NUMR8+INUMINTS,IND)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS',RTCOD)
C
C INDI is the index into DSPACE for the indices.
C INDR is the index into DSPACE for the values.
C
INDI=IND
INDR=INDI+NUMR8
C
CALL SAVINT(DSPACE(NCOLSOL),MSPACE(NINTINFO),
+ MSPACE(2*INDI-1),DSPACE(INDR),INUMINTS)
C
C Postsolve the MIP.
CALL EKKPSSL(RTCOD,DSPACE,15)
IF (RTCOD.GT.0) CALL CHKRT('EKKPSSL',RTCOD)
C
C Get current control variables and fix integer variables.
CALL EKKNGET(RTCOD,DSPACE,OSLN,OSLNLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKNGET',RTCOD)
C
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
C
CALL SETINT(DSPACE(NCOLUPPER),DSPACE(NCOLLOWER),
+ MSPACE(2*INDI-1),DSPACE(INDR),INUMINTS)
C
C Solve again to get BFS to the original problem.
CALL EKKSSLV(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',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 saves the values of integer variables.
C***********************************************************************
C
SUBROUTINE SAVINT(DSOL,INTINFO,INTS,VALS,INUMINTS)
C
REAL*8 DSOL(*),VALS(*)
INTEGER*4 INTINFO(4,*),INTS(*),INUMINTS
C
DO 10 I=1,INUMINTS
INTS(I)=INTINFO(1,I)
VALS(I)=DSOL(INTS(I))
10 CONTINUE
RETURN
END
C
C***********************************************************************
C This subroutine sets the bounds of integer variables
C to the correct integer solution values.
C***********************************************************************
C
SUBROUTINE SETINT(DUPPER,DLOWER,INTS,VALS,INUMINTS)
C
REAL*8 DUPPER(*),DLOWER(*),VALS(*)
INTEGER*4 INTS(*),INUMINTS
C
DO 10 I=1,INUMINTS
DUPPER(INTS(I))=VALS(I)
DLOWER(INTS(I))=VALS(I)
10 CONTINUE
RETURN
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
You can run this program using "Sample Mixed Integer Programming Model Data 1".
C***********************************************************************
C
C EXMPS
C
C This program reads a maximization problem from an MPS file, sets
C the appropriate control variable to indicate that it is a
C maximization problem, solves the problem with the simplex method,
C and prints the solution.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include file with real control variable definitions.
IMPLICIT NONE
INCLUDE (OSLR)
C
C Allocate dspace.
INTEGER*4 MAXSPC,RTCOD
PARAMETER (MAXSPC=200000)
REAL*8 DSPACE(MAXSPC)
COMMON/BIG/DSPACE
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 Set to maximization problem.
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRGET',RTCOD)
RMAXMIN=-1.0D0
CALL EKKRSET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRSET',RTCOD)
C
C Read model data from MPS file on unit 98.
CALL EKKMPS(RTCOD,DSPACE,98,2,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKMPS ',RTCOD)
C
C Solve problem using primal simplex method.
CALL EKKSSLV(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',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
You can run this program using "Sample Linear Programming Model Data 1".
C***********************************************************************
C
C EXMSAV
C
C This program reads a problem from an MPS file, scales it, and solves
C the problem with the simplex method. Prior to solving the problem
C message number 1 (EKK0001I) options are saved and then changed to
C suppress the printing of the message number. After solving the
C problem, message number 1 options are restored.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include file with real control variable definitions.
IMPLICIT NONE
INCLUDE (OSLR)
C
C Allocate dspace and other arrays.
INTEGER*4 MAXSPC,RTCOD,TABENT(2)
PARAMETER (MAXSPC=200000)
REAL*8 DSPACE(MAXSPC)
COMMON/BIG/DSPACE
C
C Describe application and specify that there is 1 model.
CALL EKKDSCA(RTCOD,DSPACE,MAXSPC,1)
C
C Set to maximization problem.
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRGET',RTCOD)
RMAXMIN=-1.0D0
CALL EKKRSET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRSET',RTCOD)
C
C Read model data from MPS file on unit 98
CALL EKKMPS(RTCOD,DSPACE,98,2,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKMPS ',RTCOD)
C
C Scale the coefficient matrix.
CALL EKKSCAL(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKSCAL',RTCOD)
C
C Save the current message option settings for message 1.
CALL EKKMSAV(RTCOD,DSPACE,1,TABENT)
IF (RTCOD.GT.0) CALL CHKRT('EKKMSAV',RTCOD)
C
C Modify message settings to suppress the printing of EKK0001I.
CALL EKKMSET(RTCOD,DSPACE,1,0,0,0,0,0,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKMSET',RTCOD)
C
C Solve problem using simplex method.
CALL EKKSSLV(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
C
C Restore the message option settings for message number 1 to the
C settings they had when EKKMSAV was called.
CALL EKKMSTR(RTCOD,DSPACE,1,TABENT)
IF (RTCOD.GT.0) CALL CHKRT('EKKMSTR',RTCOD)
C
C Print the solution.
CALL EKKPRTS(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKPRTS',RTCOD)
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
You can run this program using "Sample Linear Programming Model Data 1".
C***********************************************************************
C
C EXMSLV
C
C This program reads a maximization problem from an MPS file, sets
C the appropriate real control variable to indicate that it is a
C maximization problem, sets the appropriate integer control
C variable required for branch and bound preprocessing, calls the
C branch and bound preprocessing routine, then solves the problem
C with the branch and bound method, and lastly prints the results.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include files with control variable definitions.
IMPLICIT NONE
INCLUDE (OSLI)
INCLUDE (OSLR)
C
C Allocate dspace.
INTEGER*4 MAXSPC,RTCOD
PARAMETER (MAXSPC=1000000)
REAL*8 DSPACE(MAXSPC)
COMMON/BIG/DSPACE
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 as having 1 block.
CALL EKKDSCM(RTCOD,DSPACE,1,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
C
C Set Imaxrows control variable to allow for 1000 spare rows.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
IMAXROWS = -1000
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKISET',RTCOD)
C
C Set to maximization problem.
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRGET',RTCOD)
RMAXMIN=-1.0D0
CALL EKKRSET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRSET',RTCOD)
C
C Read model data from MPS file on unit 98.
C Unit 9 will used to store branch and bound information.
CALL EKKMPS(RTCOD,DSPACE,98,2,9)
IF (RTCOD.GT.0) CALL CHKRT('EKKMPS ',RTCOD)
C
C Preprocess the MIP Branch-and-Bound Tree.
CALL EKKMPRE(RTCOD,DSPACE,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKMPRE',RTCOD)
C
C Solve the MIP and put matrix and basis data on
C units 35 and 50 respectively.
CALL EKKMSLV(RTCOD,DSPACE,1,35,50)
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
You can run this program using "Sample Linear Programming Model Data 1".
C***********************************************************************
C
C EXMSLV2
C
C This program solves a mixed-integer problem and uses the user
C exit routines EXCHNU, EXBRNU, and EXEVNU to modify the node
C selection, branching technique, and node evaluation technique
C that would be selected by default by EKKMSLV.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include files with control variable definitions.
IMPLICIT NONE
INCLUDE (OSLI)
INCLUDE (OSLR)
C
C Allocate dspace.
INTEGER*4 MAXSPC,RTCOD
PARAMETER (MAXSPC=1000000)
REAL*8 DSPACE(MAXSPC)
COMMON/BIG/DSPACE
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 as having 1 block.
CALL EKKDSCM(RTCOD,DSPACE,1,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
C
C Read model data from MPS file at unit 98.
C Unit 15 will used to store branch and bound information.
CALL EKKMPS(RTCOD,DSPACE,98,2,15)
IF (RTCOD.GT.0) CALL CHKRT('EKKMPS ',RTCOD)
C
C Scale the coefficient matrix.
CALL EKKSCAL(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKSCAL',RTCOD)
C
C Create a vector copy of the matrix.
CALL EKKNWMT(RTCOD,DSPACE,3)
IF (RTCOD.GT.0) CALL CHKRT('EKKNWMT',RTCOD)
C
C Solve problem using simplex method.
CALL EKKSSLV(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
C
C Modify a number of integer control variables.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
C Switch off printing of simplex log.
ILOGLEVEL=0
C Stop at first solution.
IMAXSOLS=1
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKISET',RTCOD)
C
C Choose a pessimistic target so that code will go as fast as
C possible to any solution. Since RDEGSCALE is zero all estimates
C will be scaled so that the continuous estimate is RTARGET. Since
C RTARGET is pessimistic, each branch should be cheaper than expected,
C and this can speed up the search for a feasible solution.
C
C Modify a number of real control variables.
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRGET',RTCOD)
RDEGSCALE = 0.0D0
RTARGET = 1000.0D0
CALL EKKRSET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRSET',RTCOD)
C
C Solve mixed-integer programming problem.
CALL EKKMSLV(RTCOD,DSPACE,1,35,50)
IF (RTCOD.GT.0) CALL CHKRT('EKKMSLV',RTCOD)
C
C Now that a solution has been found, the scaling can be reduced
C so that the objective function is given more weight.
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRGET',RTCOD)
RDEGSCALE=1.0D-2*RDEGSCALE
CALL EKKRSET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRSET',RTCOD)
C
C Do not stop until the end.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
IMAXSOLS=999999
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKISET',RTCOD)
C
C Solve mixed-integer programming problem.
CALL EKKMSLV(RTCOD,DSPACE,2,35,50)
IF (RTCOD.GT.0) CALL CHKRT('EKKMSLV',RTCOD)
C
C Modify the print mask.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
IPRTINFOMASK=511
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKISET',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
You can run this program using "Sample Mixed Integer Programming Model Data 2".
C***********************************************************************
C
C EXMSLV3
C
C This driver finds the minimum value (approximately) of a polynomial
C of degree 3 in two variables. x and y may vary between -2 and +2.
C Although this example is linear with a nonlinear objective, the same
C method may be applied with nonlinear constraints and the problem
C need not be convex or even continuous. This driver uses a piece-wise
C linear approximation of the objective function. It is intended for
C use with the user exit sample subroutines EXNODU and EXBRNU2.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include files with control variable definitions.
IMPLICIT REAL*8 (D)
INCLUDE (OSLR)
INCLUDE (OSLI)
INCLUDE (OSLN)
C
C Allocate dspace and other arrays.
PARAMETER (MAXSPC=1000000)
REAL*8 DSPACE(MAXSPC)
INTEGER*4 MSPACE(2*MAXSPC),RTCOD
EQUIVALENCE(DSPACE,MSPACE)
COMMON/BIG/DSPACE
C
C Coefficients for each term.
C DCOEFF(1,0) is coefficient of linear X term etc.
PARAMETER (NDEGREE=3)
REAL*8 DCOEFF(0:NDEGREE,0:NDEGREE)
C
C Number of grid points for x and y; the example below is every 0.1
PARAMETER (NGRID=41)
C We need NGRID for x and 2*NDEGREE*NGRID for y + 2 for result.
PARAMETER (NCOL=NGRID+2*NDEGREE*NGRID+2)
C We need two rows for x and 3*NDEGREE rows for y.
PARAMETER (NROW=2+3*NDEGREE)
C Arrays for bounds and costs.
REAL*8 DRLO(NROW),DRUP(NROW)
REAL*8 DCLO(NCOL),DCUP(NCOL),DCOST(NCOL)
REAL*8 XVAL,YVAL
C Array to generate names (not necessary but makes it easier
C for user to see what is happening).
CHARACTER*12 CROW(NROW),CCOL(NCOL)
C Arrays for SOS variables and sets (one set per row).
REAL*8 DREFRW(NCOL)
C We can use same array for two purposes in IMDL.
INTEGER*4 MSEQ(NCOL),MPRI(NROW),MSETS(NROW+1),MTYPE(NROW)
C
C This example is 2 X**2 Y + X Y**2 + 25 X**2 +100 Y**2
C + 20X - 200Y
DATA DCOEFF/ 0.0D0, 2.0D1, 2.5D1, 0.0D0,
+ -2.0D2, 0.0D0, 2.0D0, 0.0D0,
+ 1.0D2, 1.0D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.0D0, 0.0D0, 0.0D0/
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 as having 1 block.
CALL EKKDSCM(RTCOD,DSPACE,1,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
C
C Build up matrix. Put in as triplets directly into dspace.
CALL EKKNGET(RTCOD,DSPACE,OSLN,OSLNLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKNGET',RTCOD)
C
C Compute maximum number of elements and where they may go.
NELMAX=(NLASTFREE-NFIRSTFREE)/2
IE=NFIRSTFREE
IC=IE+NELMAX
C Will be using mspace so change.
IC=2*IC-1
IR=IC+NELMAX
CALL MATRIX(DSPACE(IE),MSPACE(IC),MSPACE(IR),CROW,CCOL,
+ DRLO,DRUP,DCLO,DCUP,DCOST,DCOEFF,NGRID,NELMAX,NEL)
C
C Load model into dspace. Some arrays already in dspace may be
C moved down to the low end of dspace.
CALL EKKLMDL(RTCOD,DSPACE,1,NROW,NCOL,NEL,DCOST,DRLO,DRUP,
+ DCLO,DCUP,MSPACE(IR),MSPACE(IC),DSPACE(IE))
IF (RTCOD.GT.0) CALL CHKRT('EKKLMDL',RTCOD)
C
C Make column copy.
CALL EKKNWMT(RTCOD,DSPACE,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKNWMT',RTCOD)
C
C Put in names - 12 characters
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
INUMCHAR=12
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKSGET',RTCOD)
CALL EKKNAME(RTCOD,DSPACE,NROW,CROW,1,NCOL,CCOL,1,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKNAME',RTCOD)
C
C Put variables into ordinary S1 sets.
C (S2 might give slightly better answer)
C Build up arrays - doing x and y in same loop.
ICOL=0
DO ISET=1,2*NDEGREE+1
MTYPE(ISET)=1
C Do X first and then in degree order.
MPRI(ISET)=ISET
MSETS(ISET)=ICOL+1
C Put in correct reference entry (value of x or y)
C (could use 1,2 etc BUT this way we can use irregular grid).
DREF=-2.0D0
DINCR=(2.0D0-(-2.0D0))/DFLOAT(NGRID-1)
DO I=1,NGRID
ICOL=ICOL+1
MSEQ(ICOL)=ICOL
DREFRW(ICOL)=DREF
DREF=DREF+DINCR
ENDDO
ENDDO
C fill in last MSETS
MSETS(NROW+1)=ICOL+1
C
C Describe Integer structure (default down pseudocosts).
C (last two variables are x and y - continuous)
CALL EKKIMDL(RTCOD,DSPACE,NCOL-2,MSEQ,1+2*NDEGREE,MTYPE,
+ MPRI,NCOL-2,MSETS,MSEQ,0.0D0,DREFRW)
IF (RTCOD.GT.0) CALL CHKRT('EKKIMDL',RTCOD)
C
C Solve.
CALL EKKSSLV(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
C
C Print solution (selectively).
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
ISOLMASK=6
IMIPLENGTH=20
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKISET',RTCOD)
CALL EKKPRTS(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKPRTS',RTCOD)
C
C Branch and Bound (The user may find it instructive to run this
C without EKKNODU and see what happens).
CALL EKKMSLV(RTCOD,DSPACE,1,0,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKMSLV',RTCOD)
C
C Print solution again
CALL EKKPRTS(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKPRTS',RTCOD)
C
C Print values of x and y
CALL EKKNGET(RTCOD,DSPACE,OSLN,OSLNLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKNGET',RTCOD)
XVAL=DSPACE(NCOLSOL+NCOL-2)
YVAL=DSPACE(NCOLSOL+NCOL-1)
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRGET',RTCOD)
DO I=0,NDEGREE
PRINT 1,(DCOEFF(J,I),J=0,NDEGREE)
1 FORMAT(6F12.4)
ENDDO
PRINT 2,XVAL,YVAL,ROBJVALUE
2 FORMAT(' Minimum at X=',F12.4,' ,Y=',F12.4,' Objective',F20.4)
STOP
END
C
C***********************************************************************
C Generate matrix
C***********************************************************************
C
SUBROUTINE MATRIX(DELS,MCOL,MROW,CROW,CCOL,
+ DRLO,DRUP,DCLO,DCUP,DCOST,DCOEFF,NGRID,NELMAX,NEL)
* ----------------------------------------------------
IMPLICIT REAL*8 (D)
INCLUDE (OSLR)
INCLUDE (OSLI)
INCLUDE (OSLN)
C Coefficients for each term
PARAMETER (NDEGREE=3)
REAL*8 DCOEFF(0:NDEGREE,0:NDEGREE)
C Arrays for bounds and costs
REAL*8 DRLO(*),DRUP(*)
REAL*8 DCLO(*),DCUP(*),DCOST(*)
C Array to generate names (not necessary but makes it easier
C for user to see what is happening)
CHARACTER*12 CROW(*),CCOL(*),CTEMP
INTEGER*4 MCOL(*),MROW(*)
REAL*8 DELS(*)
C We need NGRID for x and 2*NDEGREE*NGRID for y
NCOL=NGRID+2*NDEGREE*NGRID+2
C We need two rows for x and 3*NDEGREE rows for y
NROW=2+3*NDEGREE
C Fill in all column bounds
DO ICOL=1,NCOL-2
DCLO(ICOL)=0.0D0
DCUP(ICOL)=1.0D31
ENDDO
C Make two result variables free
DCLO(NCOL-1)=-1.0D31
DCUP(NCOL-1)=1.0D31
DCOST(NCOL-1)=0.0D0
DCLO(NCOL)=-1.0D31
DCUP(NCOL)=1.0D31
DCOST(NCOL)=0.0D0
C two rows for X - convexity row and result
DRLO(1)=1.0D0
DRUP(1)=1.0D0
CROW(1)='X_convexity'
DRLO(2)=0.0D0
DRUP(2)=0.0D0
DREFX=-2.0D0
CROW(2)='X_value_row'
DINCRX=(2.0D0-(-2.0D0))/DFLOAT(NGRID-1)
NEL=0
DO I=1,NGRID
C Convexity entry is 1
NEL=NEL+1
MROW(NEL)=1
MCOL(NEL)=I
DELS(NEL)=1.0D0
C result
NEL=NEL+1
MROW(NEL)=2
MCOL(NEL)=I
DELS(NEL)=DREFX
C Cost - X only term
DTOT=DCOEFF(0,0)
DVAL=1.0D0
DO J=1,NDEGREE
DVAL=DVAL*DREFX
DTOT=DTOT+DVAL*DCOEFF(J,0)
ENDDO
DCOST(I)=DTOT
WRITE(CTEMP,1) DREFX
1 FORMAT('Xat',F5.2)
IF(DREFX.GT.-1.0D-6) CTEMP(4:4)='+'
CCOL(I)=CTEMP
DREFX=DREFX+DINCRX
ENDDO
C and put in X
NEL=NEL+1
MROW(NEL)=2
MCOL(NEL)=NCOL-1
CCOL(NCOL-1)='X_value'
DELS(NEL)=-1.0D0
CCOL(NCOL)='Y_value'
C Now Y sets - two sets per degree of X and three rows
IROW=2
ICOL=-NGRID
DO IDEG=1,NDEGREE
ICONV=IROW+1
WRITE(CTEMP,2) IDEG
2 FORMAT('Convexity_',I2.2)
CROW(ICONV)=CTEMP
IYROW=IROW+2
WRITE(CTEMP,3) IDEG
3 FORMAT('Y_value_',I2.2)
CROW(IYROW)=CTEMP
IXYROW=IROW+3
WRITE(CTEMP,4) IDEG
4 FORMAT('X_power_',I2.2)
CROW(IXYROW)=CTEMP
DRLO(ICONV)=1.0D0
DRUP(ICONV)=1.0D0
IROW=IROW+3
C base for max
ICOL=ICOL+2*NGRID
ICOL2=ICOL+NGRID
DREFY=-2.0D0
DINCRY=(2.0D0-(-2.0D0))/DFLOAT(NGRID-1)
C lower and upper limits on x**ideg
IF(IAND(IDEG,1).EQ.0) THEN
DLOVAL=0.0D0
DHIVAL=2.0D0**IDEG
ELSE
DLOVAL=-2.0D0**IDEG
DHIVAL=2.0D0**IDEG
ENDIF
C And point back to correct power of x
DREFX=-2.0D0
DINCRX=(2.0D0-(-2.0D0))/DFLOAT(NGRID-1)
DO I=1,NGRID
NEL=NEL+1
MROW(NEL)=IXYROW
MCOL(NEL)=I
DELS(NEL)=-DREFX**IDEG
DREFX=DREFX+DINCRX
ENDDO
DO I=1,NGRID
C Convexity
NEL=NEL+1
MROW(NEL)=ICONV
MCOL(NEL)=I+ICOL
WRITE(CTEMP,5) 'L_',IDEG,DREFY
C note on naming coventions
C X_nn gives power of X involved
C L_ or U_ refers to the minimum or maximum value of X_nn
C last term gives value of Y
5 FORMAT(A2,'X_',I2.2,'_',F5.2)
IF(DREFY.GT.-1.0D-6) CTEMP(8:8)='+'
CCOL(I+ICOL)=CTEMP
DELS(NEL)=1.0D0
NEL=NEL+1
MROW(NEL)=ICONV
MCOL(NEL)=I+ICOL2
CTEMP(1:1)='U'
CCOL(I+ICOL2)=CTEMP
DELS(NEL)=1.0D0
C result
NEL=NEL+1
MROW(NEL)=IYROW
MCOL(NEL)=I+ICOL
DELS(NEL)=DREFY
NEL=NEL+1
MROW(NEL)=IYROW
MCOL(NEL)=I+ICOL2
DELS(NEL)=DREFY
C link so that we have x to the correct power
NEL=NEL+1
MROW(NEL)=IXYROW
MCOL(NEL)=I+ICOL
DELS(NEL)=DLOVAL
NEL=NEL+1
MROW(NEL)=IXYROW
MCOL(NEL)=I+ICOL2
DELS(NEL)=DHIVAL
C Cost for X**IDEG and all Y costs
DTOT=0.0D0
DVAL=1.0D0
DO J=1,NDEGREE
DVAL=DVAL*DREFY
DTOT=DTOT+DVAL*DCOEFF(IDEG,J)
ENDDO
DCOST(I+ICOL)=DLOVAL*DTOT
DCOST(I+ICOL2)=DHIVAL*DTOT
C add in Y only part of objective on X**1 set
IF(IDEG.EQ.1) THEN
DTOT=0.0D0
DVAL=1.0D0
DO J=1,NDEGREE
DVAL=DVAL*DREFY
DTOT=DTOT+DVAL*DCOEFF(0,J)
ENDDO
DCOST(I+ICOL)=DCOST(I+ICOL)+DTOT
DCOST(I+ICOL2)=DCOST(I+ICOL2)+DTOT
ENDIF
DREFY=DREFY+DINCRY
ENDDO
C and put in Y
NEL=NEL+1
MROW(NEL)=IYROW
MCOL(NEL)=NCOL
DELS(NEL)=-1.0D0
ENDDO
C
C Check space availability.
IF(NEL.GT.NELMAX) THEN
WRITE(6,*)'Increase size of DSPACE and recompile program'
WRITE(6,*)'Stopping your application now'
STOP
ENDIF
RETURN
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
No input data is required to run this program.
C***********************************************************************
C
C EXNAME
C
C This program illustrates how EKKBASO can be used to write
C basis information for a problem that is initialized by EKKDSCB.
C
C The program builds a model by reading a small MPS file to
C initialize the index control variables for row and column names.
C This file does not contain any model information. It is used
C to force allocation of storage for row and column names.
C
C The problem data for the model is initialized by calling EKKDSCB.
C Row and column names are initialized in the work area by using the
C index control variables to indicate the location of the first row
C name, first column name, etc.
C
C Basis information from the resulting model can be written
C with EKKBASO and read with EKKBASI. A model must have names
C assigned to its rows and columns before EKKBASO may be called.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include files with control variable definitions.
IMPLICIT REAL*8 (D)
INCLUDE (OSLI)
INCLUDE (OSLN)
C
C Allocate dspace and other arrays.
PARAMETER (MAXSPC=15000,MAXNC=2,MAXNR=3,MAXNEL=6)
REAL*8 DSPACE(MAXSPC)
CHARACTER*8 CSPACE(MAXSPC),QOUT
EQUIVALENCE (DSPACE,CSPACE)
INTEGER*4 NC,NR,NEL,MCOL(MAXNEL),MROW(MAXNEL),RTCOD
REAL*8 COST(MAXNC),DELS(MAXNEL),DLOROW(MAXNR),DLOCOL(MAXNC),
+ DUPROW(MAXNR),DUPCOL(MAXNC)
C
C Define problem data.
DATA MROW/1,1,2,2,3,3/MCOL/1,2,1,2,1,2/
DATA DELS/1.0D0,-1.0D0,-1.0D0,1.0D0,-1.0D0,-1.0D0/
DATA DLOROW/-1.0D0,-1.0D0,-2.0D0/DUPROW/3*1.0D31/
DATA DLOCOL/2*0.0D0/DUPCOL/2*1.0D31/COST/-2.0D0,-6.0D0/
C
NR = MAXNR
NC = MAXNC
NEL = MAXNEL
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 as having 2 blocks.
CALL EKKDSCM(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
C
C Set control variables to allow for 50 spare rows and columns.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
IMAXCOLS=-50
IMAXROWS=-50
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKISET',RTCOD)
C
C Read an MPS file on unit 98 with 1 row, 1 column, and 1 element
C to establish storage for row and column names.
CALL EKKMPS(RTCOD,DSPACE,98,1,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKMPS ',RTCOD)
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
INUMCOLS=2
INUMROWS=3
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKISET',RTCOD)
C
C Set up row and column names, bounds, and costs.
CALL EKKNGET(RTCOD,DSPACE,OSLN,OSLNLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKNGET',RTCOD)
50 FORMAT (I7.7)
QOUT(1:1)='R'
DO 60 I1=1,NR
WRITE (QOUT(2:8),FMT=50) I1
CSPACE(NROWNAMES+I1-1)=QOUT
DSPACE(NROWUPPER+I1-1)=DUPROW(I1)
DSPACE(NROWLOWER+I1-1)=DLOROW(I1)
60 CONTINUE
QOUT(1:1)='C'
DO 70 I1=1,NC
WRITE (QOUT(2:8),FMT=50) I1
CSPACE(NCOLNAMES+I1-1)=QOUT
DSPACE(NCOLUPPER+I1-1)=DUPCOL(I1)
DSPACE(NCOLLOWER+I1-1)=DLOCOL(I1)
DSPACE(NOBJECTIVE+I1-1)=COST(I1)
70 CONTINUE
C
C Write problem matrix data into dspace using EKKDSCB.
CALL EKKDSCB(RTCOD,DSPACE,1,1,MROW,MCOL,DELS,0,0,NC,NEL)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCB',RTCOD)
C
C Crash - create starting basis.
CALL EKKCRSH(RTCOD,DSPACE,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKCRSH',RTCOD)
C
C Write current basis to a file on unit 10.
CALL EKKBASO(RTCOD,DSPACE,10,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKBASO',RTCOD)
C
C Solve problem using primal simplex method.
CALL EKKSSLV(RTCOD,DSPACE,1,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
C
C Print solution.
CALL EKKPRTS(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKPRTS',RTCOD)
C
C Read basis with EKKBASI and solve again using the dual algorithm.
C Note: the file on unit 10 created by EKKBASO has not been rewound,
C and a FORTRAN REWIND can not be used to accomplish this.
EKKFREW (10)
CALL EKKBASI(RTCOD,DSPACE,10)
IF (RTCOD.GT.0) CALL CHKRT('EKKBASI',RTCOD)
C
C Solve problem using dual simplex method.
CALL EKKSSLV(RTCOD,DSPACE,2,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
C
C Print solution.
CALL EKKPRTS(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKPRTS',RTCOD)
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
You can run this program using "Sample Linear Programming Model Data 2".
Sample input files that may be used with the sample programs can be found in Sample MPS Input Files The files that may be used with a particular sample program are indicated after each program. In addition to these files, there may also be additional sample input files distributed with the Optimization Library code.
(6) There is one major difference between these sample programs and the code fragments throughout this document. The sample programs all have return code checking after each Optimization Libarary subroutine call. While this is not necessary, it is highly recommended for actual application programs (as opposed to examples), because it can save significant time in debugging.
[ Top of Page | Previous Page | Next Page | Table of Contents ]