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 application 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 EXBASI
C
C This program reads a linear programming problem from a file in MPS
C format and reads a starting basis from an MPS basis file (generated
C by EKKBASO). It then solves the problem using the advanced starting
C basis and prints the solution.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Allocate dspace.
IMPLICIT NONE
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 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 Read basis data from file on unit 11.
CALL EKKBASI(RTCOD,DSPACE,11)
IF (RTCOD.GT.0) CALL CHKRT('EKKBASI',RTCOD)
C
C 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)
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" and the output from "Sample FORTRAN Program EXBASO".
C***********************************************************************
C
C EXBASO
C
C This program reads an MPS file, performs 10 simplex iterations, and
C saves the basis as a file in MPS format for future use.
C EKKSSLV is called again to solve the problem to completion.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include file with integer control variable definitions.
IMPLICIT NONE
INCLUDE (OSLI)
C
C Allocate dspace.
INTEGER*4 MAXSPC,RTCOD
PARAMETER (MAXSPC=200000)
REAL*8 DSPACE(MAXSPC)
COMMON/BIG/DSPACE
C
C Describe the 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 Set control variable Imaxiter to stop EKKSSLV after 3 iterations.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
IMAXITER=3
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKISET',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 After 10 iterations, EKKSSLV stops.
C Write the current basis to a file on unit 11 in MPS format.
CALL EKKBASO(RTCOD,DSPACE,11,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKBASO',RTCOD)
C
C Reset Imaxiter.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
IMAXITER=999999
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKISET',RTCOD)
C
C Call EKKSSLV again to solve to completion.
CALL EKKSSLV(RTCOD,DSPACE,1,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
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 EXBSLV
C
C This program reads a LP maximization problem from an MPS file, and
C solves the problem with the Interior-Point Barrier method using the
C Primal-Dual algorithm.
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 control variable to solve a 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 Presolve the problem.
CALL EKKPRSL(RTCOD,DSPACE,15,3)
IF (RTCOD.GT.0) CALL CHKRT('EKKPRSL',RTCOD)
C
C Solve using Interior-Point Primal-Dual (Predictor-Corrector).
CALL EKKBSLV(RTCOD,DSPACE,3,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKBSLV',RTCOD)
C
C Postsolve - maps solution back to original variables.
CALL EKKPSSL(RTCOD,DSPACE,15)
IF (RTCOD.GT.0) CALL CHKRT('EKKPSSL',RTCOD)
C
C Call EKKSSLV to ensure dual feasibility.
CALL EKKSSLV(RTCOD,DSPACE,1,3)
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 EXCOPY
C
C This program demonstrates how library subroutines can be used to
C print the current storage map, "push" the current storage map for
C later use, make a copy of the current constraint matrix, reference
C control variables, "pop" the storage map, and finally, solve the
C problem with the simplex method.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include files with control variable definitions.
IMPLICIT NONE
INCLUDE (OSLR)
INCLUDE (OSLN)
INCLUDE (OSLI)
C
C Allocate dspace.
INTEGER*4 MAXSPC
PARAMETER (MAXSPC=200000)
REAL*8 DSPACE(MAXSPC)
INTEGER*4 MSPACE(2*MAXSPC),RTCOD,I
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 control variable to solve a 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 Print current storage map.
CALL EKKSMAP(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKSMAP',RTCOD)
C
C Save current storage pointers.
CALL EKKPSHS(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKPSHS',RTCOD)
C
C Make a copy of the matrix stored by rows.
CALL EKKCOPY(RTCOD,DSPACE,3)
IF (RTCOD.GT.0) CALL CHKRT('EKKCOPY',RTCOD)
C
C Get index and integer control variables.
CALL EKKNGET(RTCOD,DSPACE,OSLN,OSLNLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKNGET',RTCOD)
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
C
C Write out some information related to matrix created by EKKCOPY.
WRITE(6,*)' Row Number Row Start'
DO I=NROWRC,NROWRC+INUMROWS-1
WRITE(6,9000) I-NROWRC+1, MSPACE(I)
ENDDO
9000 FORMAT (5X,I7,7X,I7)
C
C Print the current storage map.
CALL EKKSMAP(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKSMAP',RTCOD)
C
C Restore storage pointers.
CALL EKKPOPS(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKPOPS',RTCOD)
C
C Print the current storage map.
CALL EKKSMAP(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKSMAP',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 EXDANWOL
C
C This program is an implementation of the Dantzig-Wolfe decomposition
C algorithm, suitable for very small problems. Note that a complete
C implementation of the Dantzig-Wolfe algorithm is already available
C in the routine named EKKLPDC. The purpose of this program is to
C demonstrate how library routines can be combined to solve a reasonably
C complex problem.
C
C The constraint matrix is assumed to have the following form:
C
C --------------------
C | A1 | A2 |
C --------------------
C | |
C | B1 |
C | |
C --------------------
C | |
C | B2 |
C | |
C | |
C -----------
C
C A1 is a MAXMST by NCOL(1) matrix
C B1 is a NROW(1) by NCOL(1) matrix
C A2 is a MAXMST by NCOL(2) matrix
C B2 is a NROW(2) by NCOL(2) matrix
C where MAXMST, NCOL(*), and NROW(*) are declared below.
C
C The upper left-hand element of B2 has indices
C (MAXMST+NROW(1)+1,NCOL(1)+1) in the original formulation, but
C this program reads elements of the constraint matrix in a
C compact form that treats each diagonal block separately, and
C juxtaposes each diagonal block with its corresponding block
C in the coupling rows:
C
C ---------- -----------
C | A1 | | A2 |
C ---------- -----------
C | | | |
C | B1 | | B2 |
C | | | |
C ---------- | |
C -----------
C
C In the input file, the upper left-hand element of A2 has indices
C (1,1), and the upper left-hand element of B2 has indices
C (MAXMST+1,1). EKKLMDL is called once for each of these
C "subproblems." There is also a call to EKKLMDL that creates an
C empty master problem with 0 elements in the constraint matrix.
C The following network problem:
C
C min < 1 1 5 1 1 5 * x
C
C s.t. | -1 1 0 1 -1 0 | | 0 |
C | 0 -1 -1 0 0 0 | | -4 |
C | 1 0 1 0 0 0 |*x = | 4 |
C | 0 0 0 -1 0 -1 | | -4 |
C | 0 0 0 0 1 1 | | 4 |
C
C x = 0
C
C can be input as follows:
C
C 0.00E00 0.00E00
C 2 3 6
C -4.0E00 -4.0E00
C 4.0E00 4.0E00
C 0.0E00 100.0E0 1.0E00
C 0.0E00 100.0E0 1.0E00
C 0.0E00 100.0E0 5.0E00
C 1 1 -1.0E00
C 1 3 1.0E00
C 2 1 1.0E00
C 2 2 -1.0E00
C 3 2 -1.0E00
C 3 3 1.0E00
C 2 3 6
C -4.0E00 -4.0E00
C 4.0E00 4.0E00
C 0.0E00 100.0E0 1.0E00
C 0.0E00 100.0E0 1.0E00
C 0.0E00 100.0E0 5.0E00
C 1 1 1.0E00
C 1 2 -1.0E00
C 2 1 -1.0E00
C 2 3 1.0E00
C 3 2 -1.0E00
C 3 3 1.0E00
C
C The first row is the only coupling row, and the optimal objective
C value for the master problem is 16.
C
C***********************************************************************
C
PROGRAM MAIN
C
IMPLICIT REAL*8 (D)
C
INCLUDE (OSLI)
INCLUDE (OSLR)
INCLUDE (OSLN)
C
C Space to Use
PARAMETER (MAXSPC=150000)
C Actual Number of Rows in Master (without Subproblems)
PARAMETER (MAXMST=1)
C Actual Number of subproblems
PARAMETER (MAXSUB=2)
C Actual Number of Rows in Master (with Convexity Rows)
PARAMETER (MAXRWM=MAXMST+MAXSUB)
C Maximum Number of Rows in Each Subproblem
PARAMETER (MAXR=4)
C Maximum Number of Columns in Each Subproblem
PARAMETER (MAXC=10)
C Maximum Number of Elements in Each Subproblem
PARAMETER (MAXE=80)
C Maximum Number of Proposals
PARAMETER (MAXPRP=2*MAXRWM+2*MAXSUB)
C Lower Bounds on Row Activities for Master
REAL*8 DLOM(MAXRWM)
C Upper Bounds on Row Activities for Master
REAL*8 DUPM(MAXRWM)
C Lower Bounds on Row Activities for Each Subproblem
REAL*8 DLOR(MAXMST+MAXR,MAXSUB)
C Upper Bounds on Row Activities for Each Subproblem
REAL*8 DUPR(MAXMST+MAXR,MAXSUB)
C Lower Bounds on Column Activities for Each Subproblem
REAL*8 DLOC(MAXC,MAXSUB)
C Upper Bounds on Column Activities for Each Subproblem
REAL*8 DUPC(MAXC,MAXSUB)
C Original Costs for Column Activities for Each Subproblem
REAL*8 DCOST(MAXC,MAXSUB)
C Elements -- Stored as Triplets for Simplicity
C To simplify coding, all elements are kept in one block and
C rows are made free, although this is slightly less efficient.
REAL*8 DELS(MAXE,MAXSUB)
INTEGER MROW(MAXE,MAXSUB)
INTEGER MCOL(MAXE,MAXSUB)
C Work Regions
REAL*8 DWORK1(100),DWORK2(100),DWORK3(100)
INTEGER MPTR(100)
C Finally, some dimensions for each subproblem.
INTEGER NROW(MAXSUB)
INTEGER NCOL(MAXSUB)
INTEGER NELS(MAXSUB)
C And last, status for each subproblem to check changes.
INTEGER MCHANG(MAXSUB)
C Work Area
REAL*8 DSPACE(MAXSPC)
INTEGER MSPACE(2*MAXSPC)
EQUIVALENCE (MSPACE,DSPACE)
C
INTEGER*4 RTCOD,JRTCOD,KRTCOD
DATA RTCOD,JRTCOD,KRTCOD /0,0,0/
C
C***********************************************************************
C
C Read in data.
C Row Bounds for Master
DO 500 IROW = 1,MAXMST
READ(98,FMT=*) DLOM(IROW),DUPM(IROW)
500 CONTINUE
C Convexity Rows for Master
DO 501 IROW = MAXMST+1,MAXMST+MAXSUB
DLOM(IROW)=1.0D0
DUPM(IROW)=1.0D0
501 CONTINUE
NMAX=0
C
DO 502 ISUB = 1,MAXSUB
C Dimensions of Each Subproblem
READ(98,FMT=*) NROW(ISUB),NCOL(ISUB),NELS(ISUB)
C Modify number of rows to put master ones first.
NROW(ISUB)=NROW(ISUB)+MAXMST
C Get maximum number of rows in any problem (including master).
NMAX=MAX(NMAX,NROW(ISUB))
C Row Data
DO 503 IROW = 1,MAXMST
DLOR(IROW,ISUB)=-1.0D31
DUPR(IROW,ISUB)=1.0D31
503 CONTINUE
DO 504 IROW = MAXMST+1,NROW(ISUB)
READ(98,FMT=*) DLOR(IROW,ISUB),DUPR(IROW,ISUB)
504 CONTINUE
C Column Data
DO 505 ICOL = 1,NCOL(ISUB)
READ(98,FMT=*) DLOC(ICOL,ISUB),DUPC(ICOL,ISUB),
+ DCOST(ICOL,ISUB)
505 CONTINUE
C Elements
DO 506 IEL = 1,NELS(ISUB)
READ(98,FMT=*) MCOL(IEL,ISUB),MROW(IEL,ISUB),
+ DELS(IEL,ISUB)
506 CONTINUE
502 CONTINUE
C
C***********************************************************************
C
C Describe work space and allow room for matrices.
CALL EKKDSCA(RTCOD,DSPACE,MAXSPC,MAXSUB+1)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCA',RTCOD)
C
C Describe empty master -- allowing extra space for elements.
CALL EKKDSCM(RTCOD,DSPACE,MAXSUB+1,10)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
C Use any arrays for column costs, etc.
C Only DLOM and DUPM will be used.
CALL EKKLMDL(RTCOD,DSPACE,1,MAXRWM,MAXPRP,0,DCOST,DLOM,DUPM,
+ DCOST,DCOST,MROWM,MCOLM,DELSM)
IF (RTCOD.GT.0) CALL CHKRT('EKKLMDL',RTCOD)
C Reset number of columns.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
INUMCOLS=0
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKISET',RTCOD)
C Now, clean up master for aesthetic purposes.
CALL EKKNGET(RTCOD,DSPACE,OSLN,OSLNLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKNGET',RTCOD)
DO 507 ICOL=1,MAXPRP
DSPACE(ICOL+NOBJECTIVE-1)=0.0D0
DSPACE(ICOL+NCOLLOWER-1)=0.0D0
DSPACE(ICOL+NCOLUPPER-1)=1.0D31
507 CONTINUE
C Save base of costs for master.
ICOSTB=NOBJECTIVE-1
C Save where slack reduced costs will be.
IDJBASE=NROWDUALS-1
C Save status of first.
CALL EKKPTMI(RTCOD,DSPACE,MAXSUB+1)
IF (RTCOD.GT.0) CALL CHKRT('EKKPTMI',RTCOD)
C Declare subproblems.
DO 508 ISUB = 1,MAXSUB
CALL EKKDSCM(RTCOD,DSPACE,ISUB,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
CALL EKKLMDL(RTCOD,DSPACE,1,NROW(ISUB),NCOL(ISUB),NELS(ISUB),
+ DCOST(1,ISUB),DLOR(1,ISUB),DUPR(1,ISUB),DLOC(1,ISUB),
+ DUPC(1,ISUB),MROW(1,ISUB),MCOL(1,ISUB),DELS(1,ISUB))
IF (RTCOD.GT.0) CALL CHKRT('EKKLMDL',RTCOD)
CALL EKKPTMI(RTCOD,DSPACE,ISUB)
IF (RTCOD.GT.0) CALL CHKRT('EKKPTMI',RTCOD)
MCHANG(ISUB)=-1
508 CONTINUE
C
C
NPROP=0
DO 509 ITIME = 1,999999
C Solve master (keeping reutrn code).
CALL EKKGTMI(RTCOD,DSPACE,MAXSUB+1)
IF (RTCOD.GT.0) CALL CHKRT('EKKGTMI',RTCOD)
C Do not solve first time, since the master is empty.
IF(ITIME.NE.1) CALL EKKSSLV(RTCOD,DSPACE,1,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
CALL EKKNGET(RTCOD,DSPACE,OSLN,OSLNLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKNGET',RTCOD)
CALL EKKPTMI(RTCOD,DSPACE,MAXSUB+1)
IF (RTCOD.GT.0) CALL CHKRT('EKKPTMI',RTCOD)
C If infeasible, use auxiliary region.
JRTCOD=IPROBSTAT
C Compute costs for subproblems and solve.
C Move reduced costs for master into region.
DO 510 IROW=1,NMAX
DWORK3(IROW)=0.0D0
510 CONTINUE
C If infeasible, use auxiliary region.
C .LE. test allows for first time.
IF(JRTCOD.LE.0) THEN
DO 511 IROW=1,MAXMST
DWORK3(IROW)=DSPACE(IDJBASE+IROW)
511 CONTINUE
ELSE
DO 512 IROW=1,MAXMST
DWORK3(IROW)=DSPACE(NROWAUX-1+IROW)
512 CONTINUE
ENDIF
C
NMOD=0
C
DO 513 ISUB = 1,MAXSUB
C
CALL EKKGTMI(RTCOD,DSPACE,ISUB)
IF (RTCOD.GT.0) CALL CHKRT('EKKGTMI',RTCOD)
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
CALL EKKNGET(RTCOD,DSPACE,OSLN,OSLNLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKNGET',RTCOD)
C If not feasible, use a piece of the feasible objective.
IF(JRTCOD.EQ.0) THEN
DRATIO=1.0D0
ELSE
DRATIO=1.0D-8
ENDIF
DO 514 ICOL = 1,INUMCOLS
DSPACE(NOBJECTIVE+ICOL-1)=DCOST(ICOL,ISUB)
514 CONTINUE
C Change costs.
CALL EKKGEMV(RTCOD,DSPACE,2,1.0D0,DWORK3,DRATIO,
+ DSPACE(NOBJECTIVE))
IF (RTCOD.GT.0) CALL CHKRT('EKKGEMV',RTCOD)
C Solve subproblem.
ITS=IITERNUM
CALL EKKSSLV(RTCOD,DSPACE,1,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
C Save status
KRTCOD=IPROBSTAT
C
C Add in proposal if possible
IF(ITS.LT.IITERNUM.OR.MCHANG(ISUB).NE.KRTCOD.OR.KRTCOD.NE.0)
+ THEN
MCHANG(ISUB)=KRTCOD
C
NMOD=NMOD+1
C
C Find space for proposal.
IF(NPROP.LT.MAXPRP) THEN
NPROP=NPROP+1
IPROP=NPROP
ELSE
C There would be coding here to overwrite an existing
C nonbasic column.
ENDIF
IF(KRTCOD.EQ.0) THEN
C Coding is simple if the subproblem is optimal.
C Move solution so we can use the same coding afterwards.
DO 515 I=1,INUMCOLS
DWORK1(I)=DSPACE(NCOLSOL+I-1)
515 CONTINUE
ELSE
C Auxiliary region contains ray.
CALL EKKNGET(RTCOD,DSPACE,OSLN,OSLNLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKNGET',RTCOD)
C Unbounded, so create a ray.
DO 516 I=1,INUMCOLS
DWORK1(I)=DSPACE(NCOLAUX-1+I)
516 CONTINUE
ENDIF
C Compute cost of proposal.
DCOSTX=0.0D0
DO 517 ICOL = 1,NCOL(ISUB)
DCOSTX=DCOSTX+DCOST(ICOL,ISUB)*DWORK1(ICOL)
517 CONTINUE
C Get contribution in DWORK2 (including subproblem).
DO 518 IROW = 1,NMAX
DWORK2(IROW)=0.0D0
518 CONTINUE
CALL EKKGEMV(RTCOD,DSPACE,1,1.0D0,DWORK1,1.0D0,DWORK2)
IF (RTCOD.GT.0) CALL CHKRT('EKKGEMV',RTCOD)
C Pack down.
NOUT=0
DO 519 IROW = 1,MAXMST
IF(ABS(DWORK2(IROW)).GT.1.0D-9) THEN
NOUT=NOUT+1
DWORK2(NOUT)=DWORK2(IROW)
MPTR(NOUT)=IROW
ENDIF
519 CONTINUE
C Add 1.0 in convexity row, unless a ray.
IF(KRTCOD.EQ.0) THEN
NOUT=NOUT+1
DWORK2(NOUT)=1.0D0
MPTR(NOUT)=MAXMST+ISUB
ENDIF
C Save commons since the subproblem is finished.
CALL EKKPTMI(RTCOD,DSPACE,ISUB)
IF (RTCOD.GT.0) CALL CHKRT('EKKPTMI',RTCOD)
C Add proposal.
NMOD=NMOD+1
CALL EKKGTMI(RTCOD,DSPACE,MAXSUB+1)
IF (RTCOD.GT.0) CALL CHKRT('EKKGTMI',RTCOD)
CALL EKKCOL(RTCOD,DSPACE,1,IPROP,NOUT,DWORK2,MPTR)
IF (RTCOD.GT.0) CALL CHKRT('EKKCOL ',RTCOD)
DSPACE(ICOSTB+IPROP)=DCOSTX
CALL EKKPTMI(RTCOD,DSPACE,MAXSUB+1)
IF (RTCOD.GT.0) CALL CHKRT('EKKPTMI',RTCOD)
ELSE
C Save commons since the subproblem is finished.
CALL EKKPTMI(RTCOD,DSPACE,ISUB)
IF (RTCOD.GT.0) CALL CHKRT('EKKPTMI',RTCOD)
ENDIF
513 CONTINUE
C See if there are any changes.
IF(NMOD.EQ.0) GOTO 6000
509 CONTINUE
C Solve master again, and report on results.
6000 CALL EKKGTMI(RTCOD,DSPACE,MAXSUB+1)
IF (RTCOD.GT.0) CALL CHKRT('EKKGTMI',RTCOD)
CALL EKKSSLV(RTCOD,DSPACE,1,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
C
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRGET',RTCOD)
WRITE (6,*) 'The value of the objective function is: ',
& ROBJVALUE
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 the data indicated in the header of the program.
C***********************************************************************
C
C EXDSCB
C
C This program solves the following maximization problem:
C
C Maximize 4*x4 + 0.1*x5 + 6*x10 + 0.15*x11 + 8*x16 + 0.15*x17
C + 6*x22 + 0.15*x23 + 3*x26 + 0.1*x27
C + 3*x29 + 0.1*x30
C
C Subject to: Dx = b; x = 0
C
C where trans(b) = (100,50,0,0,0,0,0,0,0,0,0,0)
C
C and the matrix D has the form:
C
C --------
C | A |
C | |
C -------+-------
C | | A |
C | B | |
C | |------+-------
C | | | A |
C -------| B | |
C | |------+-------
C | | | A |
C -------| B | |
C | |------+---------
C | | | |
C -------| B | C |
C | | |
C | | |
C -----------------
C
C A is a 2 X 6 matrix stored by indices.
C
C __ __
C | 1 1 1 1 0 0 |
C A = | |
C | 3 0 0 0 1 1 |
C -- --
C
C B is a 4 X 6 matrix stored by columns.
C
C __ __
C | 0 0 -1 0 0 0 |
C | |
C | 0 0 0 0 0 -1 |
C B = | |
C |-4 -1 0 0 0 0 |
C | |
C | 0 -10 0 0 0 0 |
C -- --
C
C C is a 4 X 6 matrix stored by indices.
C
C __ __
C | 1 1 0 0 0 0 |
C | |
C | 0 0 1 1 0 0 |
C C = | |
C |-1 0 0 0 1 0 |
C | |
C | 0 0 0 -1 0 1 |
C -- --
C
C NROW is the total number of rows in the composite matrix.
C NCOL is the total number of columns in the composite matrix.
C NA is the number of elements in A.
C NACOL is the number of columns in A.
C A is the matrix elements of block A.
C IA is the row indices of block A.
C JA is the column indices of block A.
C NB is the number of elements in B.
C NBCOL is the number of columns in B.
C B is the matrix elements of block B.
C IB is the row indices of block B.
C JB is the column starts of block B.
C NC is the number of elements in C.
C NCCOL is the number of columns in C.
C C is the matrix elements of block C.
C IC is the row indices of block C.
C JC is the column indices of block C.
C DOBJ is the objective row.
C DRLO is the row lower bounds.
C DRUP is the row upper bounds.
C DCLO is the column lower bounds.
C DCUP is the column upper bounds.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include files with control variable definitions.
INCLUDE (OSLR)
INCLUDE (OSLI)
C
C Allocate dspace and other arrays.
INTEGER*4 MAXSPC
PARAMETER (MAXSPC=15000)
REAL*8 DSPACE(MAXSPC)
INTEGER*4 IA(10),JA(10),IB(10),JB(10),IC(10),JC(10),RTCOD,I
REAL*8 A(10),B(10),C(10),DRLO(15),DRUP(15),DCLO(30),DCUP(30),
+ DOBJ(30)
DATA NROW,NCOL/12,30/NACOL,NA,IATYPE/6,7,1/
DATA NBCOL,NB,IBTYPE/6,5,2/NCCOL,NC,ICTYPE/6,8,1/
C
C Matrix elements.
DATA A /1.0D0,3.0D0,5*1.0D0,3*0.0D0/
DATA B /-4.0D0,-1.0D0,-1.0D1,2*-1.0D0,5*0.0D0/
DATA C /1.0D0,-1.0D0,3*1.0D0,-1.0D0,2*1.0D0,2*0.0D0/
C
C Row indices.
DATA IA/1,2,3*1,2*2,3*0/IB/3,3,4,1,2,5*0/IC/1,3,1,2,2,4,3,4,2*0/
C
C Column indices (starts).
DATA JA/1,1,2,3,4,5,6,3*0/JB/1,2,4,5,5,5,6,3*0/
DATA JC/1,1,2,3,4,4,5,6,2*0/
C
C Lower/upper bounds on row activities.
DATA DRLO/1.0D02,5.0D01,13*0.0D0/DRUP/1.0D02,5.0D01,13*0.0D0/
C
C Lower/upper bounds on columns.
DATA DCLO/30*0.0D0/DCUP/30*1.0D31/
C
C Objective function coefficients.
DATA DOBJ /3*0.0D0,4.0D0,1.0D-1,4*0.0D0,6.0D0,1.5D-1,
+ 4*0.0D0,8.0D0,1.5D-1,4*0.0D0,6.0D0,1.5D-1,
+ 2*0.0D0,3.0D0,1.0D-1,0.0D0,3.0D0,1.0D-1/
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 as having 9 blocks.
CALL EKKDSCM(RTCOD,DSPACE,1,9)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
C
C Set control variable to solve a 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 Set up the model.
CALL EKKLMDL(RTCOD,DSPACE,1,NROW,NCOL,0,DOBJ,DRLO,DRUP,
+ DCLO,DCUP,0,0,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKLMDL',RTCOD)
C
C Describe A blocks.
DO 100 I=1,4
CALL EKKDSCB(RTCOD,DSPACE,IATYPE,0,IA,JA,A,
+ (I-1)*2,(I-1)*6,NACOL,NA)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCB',RTCOD)
100 CONTINUE
C
C Describe B blocks.
DO 200 I=1,4
CALL EKKDSCB(RTCOD,DSPACE,IBTYPE,0,IB,JB,B,
+ I*2,(I-1)*6,NBCOL,NB)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCB',RTCOD)
200 CONTINUE
C
C Describe C block.
CALL EKKDSCB(RTCOD,DSPACE,ICTYPE,0,IC,JC,C,
+ 8,24,NCCOL,NC)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCB',RTCOD)
C
C Create a column copy of the matrix.
CALL EKKNWMT(RTCOD,DSPACE,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKNWMT',RTCOD)
C
C Write the model to file on unit 18 in MPS format.
CALL EKKBCDO(RTCOD,DSPACE,18,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKBCDO',RTCOD)
C
C Solve problem using simplex method.
CALL EKKSSLV(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
C
C Set to print columns with nonzero activities.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
ISOLMASK=6
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
No input data is required to run this program.
C***********************************************************************
C
C EXDSCM2
C
C This program solves three minimization problems and uses the
C resulting optimal solutions to construct the objective function
C of a fourth problem. This fourth problem is solved as a maximization
C 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,I
PARAMETER (MAXSPC=20000)
REAL*8 DSPACE(MAXSPC),OBJSAV(3)
C
C Describe application and specify that there are 4 models.
CALL EKKDSCA(RTCOD,DSPACE,MAXSPC,4)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCA',RTCOD)
C
C First three models: Find minimum costs for three raw materials.
C Model data for all 4 models are in MPS format and stored together
C in one file. After a model is read, the file pointer will be
C positioned at the beginning of the next model.
C
DO 10 I=1,3
CALL EKKDSCM(RTCOD,DSPACE,I,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
C Read in model data on unit 98.
CALL EKKMPS(RTCOD,DSPACE,98,1,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKMPS ',RTCOD)
C
C Solve the current model.
CALL EKKSSLV(RTCOD,DSPACE,1,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
C
C Save optimal objective value.
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRGET',RTCOD)
OBJSAV(I)=ROBJVALUE
10 CONTINUE
C
C Describe the fourth model.
CALL EKKDSCM(RTCOD,DSPACE,4,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
C
C Read in model 4 data.
CALL EKKMPS(RTCOD,DSPACE,98,1,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKMPS ',RTCOD)
C
C Get index control variables.
CALL EKKNGET(RTCOD,DSPACE,OSLN,OSLNLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKNGET',RTCOD)
C
C Set first three costs to the negative of the optimal objective
C functions of models 1,2, and 3.
DO 20 I=1,3
DSPACE(NOBJECTIVE+I-1)=-OBJSAV(I)
20 CONTINUE
C
C Solve the fourth model to maximize profits.
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)
CALL EKKSSLV(RTCOD,DSPACE,1,1)
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 3".
C***********************************************************************
C
C EXDUAL
C
C This program reads a linear program from an MPS file,
C solves the problem with the simplex method, and then evaluates
C the primal and dual objective functions using information
C stored in DSPACE during the call to EKKSSLV. If an optimal
C solution is found during the call to EKKSSLV, the corresponding
C primal and dual objective values will agree.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Allocate dspace.
INTEGER*4 MAXSPC,RTCOD
PARAMETER (MAXSPC=75000)
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 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 model using primal simplex method.
CALL EKKSSLV(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
C
C Evaluate the primal and dual objective functions.
CALL EVAL(DSPACE)
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 This routine evaluates the primal and dual objective functions.
C***********************************************************************
SUBROUTINE EVAL(DSPACE)
C
C Bring in include files with control variable definitions.
INCLUDE (OSLI)
INCLUDE (OSLR)
INCLUDE (OSLN)
REAL*8 DSPACE(*),PRIMAL,DUAL,ZDIFF,ZEPS
INTEGER*4 I
C
ZEPS = 0.00000001D0
C
CALL EKKNGET(IRTCOD,DSPACE,OSLN,OSLNLN)
CALL EKKIGET(IRTCOD,DSPACE,OSLI,OSLILN)
CALL EKKRGET(IRTCOD,DSPACE,OSLR,OSLRLN)
C
C Calculate primal objective function.
PRIMAL = 0.0D0
DO 400 I=1,INUMCOLS
PRIMAL = PRIMAL + DSPACE(NOBJECTIVE+I-1)*DSPACE(NCOLSOL+I-1)
400 CONTINUE
C
C Calculate dual objective function.
C Compute the inner-product with the row duals.
DUAL = 0.0D0
DO 600 I=1,INUMCOLS
ZDIFF = ABS(DSPACE(NCOLLOWER+I-1)-DSPACE(NCOLUPPER+I-1))
C
C Check if the variable is fixed.
IF (ZDIFF.LT.(2*ZEPS)) THEN
DUAL = DUAL + DSPACE(NCOLRCOSTS+I-1)*DSPACE(NCOLUPPER+I-1)
ELSE
ZDIFF = ABS(DSPACE(NCOLSOL+I-1)-DSPACE(NCOLLOWER+I-1))
C
C Check if the variable is at lower bound.
IF (ZDIFF.LT.ZEPS)
+ DUAL = DUAL + DSPACE(NCOLRCOSTS+I-1)*DSPACE(NCOLLOWER+I-1)
ZDIFF = ABS(DSPACE(NCOLSOL+I-1)-DSPACE(NCOLUPPER+I-1))
C
C Check if the variable is at upper bound (and corr. dual is negated).
IF (ZDIFF.LT.ZEPS)
+ DUAL = DUAL + DSPACE(NCOLRCOSTS+I-1)*DSPACE(NCOLUPPER+I-1)
ENDIF
600 CONTINUE
C
C Compute the inner-product with the reduced costs.
DO 500 I=1,INUMROWS
ZDIFF = ABS(DSPACE(NROWUPPER+I-1)-DSPACE(NROWLOWER+I-1))
C
C Check if the constraint is an equality.
IF (ZDIFF.LT.(2*ZEPS)) THEN
DUAL = DUAL - DSPACE(NROWDUALS+I-1)*DSPACE(NROWUPPER+I-1)
ELSE
ZDIFF = ABS(DSPACE(NROWACTS+I-1)-DSPACE(NROWLOWER+I-1))
C
C Check if the row activity is at lower bound (and corr. dual is neg).
IF (ZDIFF.LT.ZEPS)
+ DUAL = DUAL - DSPACE(NROWDUALS+I-1)*DSPACE(NROWLOWER+I-1)
ZDIFF = ABS(DSPACE(NROWACTS+I-1)-DSPACE(NROWUPPER+I-1))
C
C Check if the row activity is at upper bound.
IF (ZDIFF.LT.ZEPS)
+ DUAL = DUAL - DSPACE(NROWDUALS+I-1)*DSPACE(NROWUPPER+I-1)
ENDIF
500 CONTINUE
C
WRITE (6,912) 'NAME PRIMAL DUAL'
WRITE (6,913) CNAME,PRIMAL,DUAL
912 FORMAT(1X,A)
913 FORMAT(1X,A8,F13.4,F13.4)
RETURN
END
C***********************************************************************
C
C EXFRONT
C
C This program solves the parametric quadratic programming problem
C given by:
C min xQx
C st ex = 1
C ax = p
C x = 0
C
C where e is a row vector of 1's, a is a real row vector, and p ranges
C from llimit to ulimit. The "efficient frontier" is printed out
C during successive calls to EKKITRU.
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,MAXVARS,MAXQELS
PARAMETER (MAXSPC=30000,MAXVARS=25,MAXQELS=25)
REAL*8 DSPACE(MAXSPC),A(MAXVARS),LVB(MAXVARS),UVB(MAXVARS),
+ COST(MAXVARS),LRB(2),URB(2),CELS(2*MAXQELS),QELS(MAXQELS),
+ VPERT(MAXVARS),RPERT(2),LOWPERT,HIGHPERT,LLIMIT,ULIMIT
INTEGER*4 CIIND(2*MAXQELS),CJIND(2*MAXQELS),QIIND(MAXQELS),
+ QJIND(MAXQELS),NUMVARS,NUMQELS,RTCOD,J
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. Five blocks are needed for QP.
CALL EKKDSCM(RTCOD,DSPACE,1,5)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
C
NUMVARS = 3
C
C Load A() vector.
A(1) = 1.0D0
A(2) = 2.0D0
A(3) = 4.0D0
C
C Load in the constraint that says that the one-norm of the
C variables must equal 1. Set linear cost function to 0.
C Set cost perturbation vector to 0.
DO J=1,NUMVARS
CELS(J) = 1.0D0
CIIND(J) = 1
CJIND(J) = J
COST(J) = 0.0D0
VPERT(J) = 0.0D0
ENDDO
C
C Load in the constraint that says that the inner-product of
C A() and X() must equal p.
DO J=1,NUMVARS
CELS(J+NUMVARS) = A(J)
CIIND(J+NUMVARS) = 2
CJIND(J+NUMVARS) = J
ENDDO
C
C Load in the bounds for the perturbation.
LOWPERT = 1.25D0
HIGHPERT = 2.80D0
C
C The perturbation vector has a 0 in the first component, because
C the first constraint will not be changed; the second component will.
RPERT(1) = 0.0D0
RPERT(2) = 1.0D0
C
C Load in the variable bounds.
LVB(1) = 0.0D0
LVB(2) = 0.0D0
LVB(3) = 0.0D0
UVB(1) = 100.0D0
UVB(2) = 0.4D0
UVB(3) = 0.5D0
C
C Load in the row bounds.
LRB(1) = 1.0D0
LRB(2) = LOWPERT
URB(1) = 1.0D0
URB(2) = LOWPERT
C
C Pass linear model with matrix stored by indices.
CALL EKKLMDL(RTCOD,DSPACE,1,2,NUMVARS,2*NUMVARS,COST,LRB,URB,
+ LVB,UVB,CIIND,CJIND,CELS)
NUMQELS = NUMVARS
C
C Load in a diagonal Q matrix.
DO J=1,NUMVARS
QELS(J) = 2.0D0
QIIND(J) = J
QJIND(J) = J
ENDDO
C
C Pass quadratic matrix stored by indices.
CALL EKKQMDL(RTCOD,DSPACE,1,NUMQELS,QIIND,QJIND,QELS)
C
C Define the limits of the parametric adjustment vectors.
LLIMIT = 0.0D0
ULIMIT = HIGHPERT - LOWPERT
C
C Solve parametric QP problem.
CALL EKKQPAR(RTCOD,DSPACE,RPERT,VPERT,LLIMIT,ULIMIT)
IF (RTCOD.GT.0) CALL CHKRT('EKKQPAR',RTCOD)
C
C Get the value of the objective function.
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRGET',RTCOD)
WRITE (6,900) ROBJVALUE
900 FORMAT (' The objective function value is ',D20.7)
C
STOP
END
C
C***********************************************************************
C This user exit routine prints out the "efficient frontier".
C IREASON = 9 after each optimal solution is found by EKKQPAR
C***********************************************************************
C
SUBROUTINE EKKITRU(DSPACE,MSPACE,IREASON,ISTAT)
C
REAL*8 DSPACE(*)
INTEGER*4 MSPACE(*),IREASON,ISTAT,RTCOD
INCLUDE (OSLI)
INCLUDE (OSLR)
INCLUDE (OSLN)
C
IF (IREASON.EQ.9) THEN
CALL EKKNGET(RTCOD,DSPACE,OSLN,OSLNLN)
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
C
WRITE (6,*) ' lambda = ',OSLR(34)
WRITE (6,*) ' objective = ',OSLR(18)
WRITE (6,*) ' x1 = ',DSPACE(NCOLSOL+0)
WRITE (6,*) ' x2 = ',DSPACE(NCOLSOL+1)
WRITE (6,*) ' x3 = ',DSPACE(NCOLSOL+2)
WRITE (6,*) ' iternum = ',IITERNUM
WRITE (6,*) ' iqparnumiter = ',IQPARNUMITER
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 EXGES
C
C This program prints the simplex tableau for all structural columns
C of a linear programming 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,MAXNR
PARAMETER (MAXSPC=500000,MAXNR=5000)
REAL*8 DSPACE(MAXSPC),DCOLUMN(MAXNR),DVAL
INTEGER*4 MSPACE(2*MAXSPC),ICOL,IROW,KS,KE,K,RTCOD
EQUIVALENCE (DSPACE,MSPACE)
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 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 Invert.
CALL EKKINVT(RTCOD,DSPACE,1,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKINVT',RTCOD)
C
C Get integer and index control variables.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
CALL EKKNGET(RTCOD,DSPACE,OSLN,OSLNLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKNGET',RTCOD)
C
IF (INUMROWS.GT.MAXNR) THEN
WRITE(6,*)'Increase the MAXNR parameter and recompile program'
WRITE(6,*)'Stopping your program now'
STOP 16
ENDIF
C
C Scan through the columns (Could also use EKKCOL).
DO ICOL=1,INUMCOLS
C First zero region
DO IROW=1,INUMROWS
DCOLUMN(IROW)=0.0D0
ENDDO
C Pick up column of matrix
KS=MSPACE(NBLOCKCOL+ICOL-1)
KE=MSPACE(NBLOCKCOL+ICOL)-1
DO K=KS,KE
IROW=MSPACE(NBLOCKROW+K-1)
DVAL=DSPACE(NBLOCKELEM+K-1)
DCOLUMN(IROW)=DVAL
ENDDO
C Update column to get tableau form of simplex method
CALL EKKGES(RTCOD,DSPACE,1,DCOLUMN)
C Print column of tableau
WRITE(6,1000) ICOL,DSPACE(NCOLRCOSTS+ICOL-1)
1000 FORMAT(' Column',I8,' Reduced cost',F20.6)
DO IROW=1,INUMROWS
WRITE(6,2000) IROW,DCOLUMN(IROW)
2000 FORMAT(I8,F20.6)
ENDDO
ENDDO
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 EXIMDL
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.
IMPLICIT NONE
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 NINTS,NSETS,NTSIZE
COMMON/BIG/DSPACE
C
C Define the model.
INTEGER*4 NROW,NCOL,NEL,ITYPE
DATA NROW,NCOL,NEL,ITYPE/4,4,10,1/
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 Number of 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.
DATA NSETS/3/
C
C Set priorities.
INTEGER*4 PRI(3)
DATA PRI/3*1000/
C
C Total size of sets and variables.
DATA NTSIZE/3/
C
C Indices of sets.
INTEGER*4 NSETIN(4)
DATA NSETIN/1,2,3,4/
C
C Variable numbers of the variables in sets.
INTEGER*4 NSSETS(3)
DATA NSSETS/1,2,3/
C
C Pseudo costs.
REAL*8 DNPCOST(ICL),UPPCOST(ICL)
DATA DNPCOST/ICL*5.0D-03/ UPPCOST/ICL*5.0D-03/
C
C Types of sets for EKKIMDL call
INTEGER*4 IMDLTP(3)
DATA IMDLTP/3*4/
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
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.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
IMAXINTS = 3
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
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.
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,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
No input data is required to run this program.
C***********************************************************************
C
C EXIMDL2
C
C This program solves the following pure integer problem:
C
C Min Z = 28x11 + 84x12 + 112x13 + 112x14 + 60x21 + 20x22
C + 50x23 + 50x24 + 96x31 + 60x32 + 24x33 + 60x34
C + 64x41 + 40x42 + 40x43 + 16x44 + 50y1 + 50y2
C + 50y3 + 50y4
C
C Subject to:
C
C x11 + x12 + x13 + x14 = 1
C x21 + x22 + x23 + x24 = 1
C x31 + x32 + x33 + x34 = 1
C x41 + x42 + x43 + x44 = 1
C 0 <= -x11 + y1 <= 1
C 0 <= -x21 + y1 <= 1
C 0 <= -x31 + y1 <= 1
C 0 <= -x41 + y1 <= 1
C 0 <= - x12 + y2 <= 1
C 0 <= - x22 + y2 <= 1
C 0 <= - x32 + y2 <= 1
C 0 <= - x42 + y2 <= 1
C 0 <= - x13 + y3 <= 1
C 0 <= - x23 + y3 <= 1
C 0 <= - x33 + y3 <= 1
C 0 <= - x43 + y3 <= 1
C 0 <= - x14 + y4 <= 1
C 0 <= - x24 + y4 <= 1
C 0 <= - x34 + y4 <= 1
C 0 <= - x44 + y4 <= 1
C
C All xij and yj are 0,1 variables.
C NOTE: There are 20 columns in the constraint matrix.
C The list of variables and corresponding variable numbers:
C
C x11 is #1 x12 is #2 x13 is #3 x14 is #4 y1 is #17
C x21 is #5 x22 is #6 x23 is #7 x24 is #8 y2 is #18
C x31 is #9 x32 is #10 x33 is #11 x34 is #12 y3 is #19
C x41 is #13 x42 is #14 x43 is #15 x44 is #16 y4 is #20
C
C Optimal solution: Z = 242; y1=1,y3=1,x11=1,x23=1,x33=1,x43=1
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 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 integer sets plus integer variables.
C NSSETS is the variable numbers of variables in sets.
C NSETIN is the indices into NSSETS for set definitions.
C IMDLTP is the types of sets of integer variables.
C PRI is the priorities.
C DNPC is the down pseudocosts.
C UPPC is the reference row entries.
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)
INCLUDE (OSLC)
C
C Allocate dspace and other arrays.
PARAMETER (MAXDSP=1000000,IRL=20,ICL=20,ICL1=21,IEL=48)
REAL*8 DSPACE(MAXDSP)
COMMON/BIG/DSPACE
REAL*8 DRLO(IRL),DCLO(ICL),DOBJ(ICL),DELS(IEL)
REAL*8 DRUP(IRL),DCUP(ICL),DNPC(ICL),UPPC(ICL)
INTEGER*4 MROW(IEL),MCOL(ICL1),NROW,NCOL,NEL,ITYPE,MINTS(ICL),
+ NINTS,NSETS,PRI(8),NTSIZE,NSETIN(9),NSSETS(ICL),IMDLTP(8),RTCOD
C
C Define the model.
DATA NROW,NCOL,NEL,ITYPE/IRL,ICL,IEL,2/
C
C Coefficients of the constraint matrix.
DATA DELS/1.0D0,-1.0D0,1.0D0,-1.0D0,1.0D0,-1.0D0,1.0D0,-1.0D0,
+ 1.0D0,-1.0D0,1.0D0,-1.0D0,1.0D0,-1.0D0,1.0D0,-1.0D0,
+ 1.0D0,-1.0D0,1.0D0,-1.0D0,1.0D0,-1.0D0,1.0D0,-1.0D0,
+ 1.0D0,-1.0D0,1.0D0,-1.0D0,1.0D0,-1.0D0,1.0D0,-1.0D0,
+ 16*1.0D0/
C
C Row indices.
DATA MROW/ 1, 5, 1, 9, 1,13, 1,17, 2, 6,
+ 2,10, 2,14, 2,18, 3, 7, 3,11,
+ 3,15, 3,19, 4, 8, 4,12, 4,16,
+ 4,20, 5, 6, 7, 8, 9,10,11,12,
+ 13,14,15,16,17,18,19,20/
C
C Column starts.
DATA MCOL/ 1, 3, 5, 7, 9,11,13,15,17,19,
+ 21,23,25,27,29,31,33,37,41,45,49/
C
C Lower bounds on row activities.
DATA DRLO/4*1.0D0,16*0.0D0/
C
C Upper bounds on row activities.
DATA DRUP/IRL*1.0D0/
C
C Lower bounds on columns.
DATA DCLO/ICL*0.0D0/
C
C Upper bounds on columns.
DATA DCUP/ICL*1.0D31/
C
C Objective function coefficients.
DATA DOBJ/2.8D1, 8.4D1,1.12D2,1.12D2, 6.0D1, 2.0D1,
+ 5.0D1, 5.0D1, 9.6D1, 6.0D1, 2.4D1, 6.0D1,
+ 6.4D1, 4.0D1, 4.0D1, 1.6D1, 4*5.0D1/
C
C Number of integer variables.
DATA NINTS/20/
C
C Variable numbers of the integer variables.
DATA MINTS/ 1, 2, 3, 4, 5, 6, 7, 8, 9,10,
+ 11,12,13,14,15,16,17,18,19,20/
C
C Number of sets of integer variables.
DATA NSETS/8/
C
C Priorities.
DATA PRI/8*1000/
C
C Total size of sets and integer variables.
DATA NTSIZE/IRL/
C
C Indices of sets.
DATA NSETIN/1,5,9,13,17,18,19,20,21/
C
C Variable numbers of the variables in sets.
DATA NSSETS/ 1, 2, 3, 4, 5, 6, 7, 8, 9,10,
+ 11,12,13,14,15,16,17,18,19,20/
C
C Pseudo costs.
DATA DNPC/ICL*5.0D-03/
DATA UPPC/ICL*0.0 /
C
C Types of sets for CALL to EKKIMDL.
DATA IMDLTP/4*3,4*4/
C
C
C Describe application and specify that there is 1 model.
CALL EKKDSCA(RTCOD,DSPACE,MAXDSP,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 twenty integer variables.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
IMAXINTS = 20
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKISET',RTCOD)
C
C Pass the model with the matrix stored by column-major order.
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 Specify the integer parts of a mixed integer programming problem.
CALL EKKIMDL(RTCOD,DSPACE,NINTS,MINTS,NSETS,IMDLTP,PRI,NTSIZE,
+ NSETIN,NSSETS,DNPC,UPPC)
IF (RTCOD.GT.0) CALL CHKRT('EKKIMDL',RTCOD)
C
C Solve the model using the mixed-integer programming routine.
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
No input data is required to run this program.
C*********************************************************************
C
C EXIMDL3
C
C This program solves the following problem:
C
C Maximize 4x1 - 2x2 + 7x3 - x4 + 2x5 -2x6 + 3x7 - x8
C
C Subject to:
C
C x1 + 5x3 - x5 + x7 <= 900
C x1 + x2 - x3 -2x6 <= 650
C 6x1 - 5x2 + x6 -2x8 <= 520
C -x1 + 2x3 - 2x4 + x5 + x7 <= 990
C
C
C And subject to:
C
C 0 <= x1 <= 1.0D+4 ; x1 integer variable
C 0 <= x2 <= 1.0D+4
C 0 <= x3 <= 1.0D+4
C 0 <= x4 <= 1.0D+4 ; x4 integer variable
C 0 <= x5 <= 1.0D+4 ; x5 integer variable
C 0 <= x6 <= 2.0D+4 ;
C 0 <= x7 <= 2.0D+4 ; x7 integer variable
C 0 <= x8 <= 2.0D+4 ;
C
C In this example, all the integer variables are grouped into 1 set
C of regular integer variables (type = 4)
C The optimal objective function has a value of 42918.2
C corresponding to the following solution:
C x1=87, x2=0.4, x3=0, x4=9868, x5=10000, x6=0, x7=10813, x8=0
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 LTYPE is the storage format.
C IRL is the length of arrays containing row information.
C ICL is the length of arrays containing column information
C ICL1 is ICL + 1
C INEL is the length of arrays containing constraint matrix
C element information
C NINTS is the number of integer variables.
C INTNUMS is the variable numbers of integer variables.
C NSETS is the number of sets of integer variables.
C NTOTINFO is the total size of sets plus variables.
C SETS is the variable numbers of variables in sets.
C TYPE is the types of sets of integer variables.
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,IRL,ICL,ICL1,INEL,RTCOD
PARAMETER (MAXSPC=100000,IRL=4,ICL=8,ICL1=9,INEL=17)
REAL*8 DSPACE(MAXSPC)
COMMON/BIG/DSPACE
C Number of integer variables.
INTEGER*4 NINTS,NINTS1
PARAMETER (NINTS=4,NINTS1=4+1)
C
C Number of sets of integer variables.
INTEGER*4 NSETS
PARAMETER (NSETS=1)
C
C Define the model.
INTEGER*4 NROW,NCOL,NEL,LTYPE
DATA NROW,NCOL,NEL,LTYPE/IRL,ICL,INEL,2/
C
C Row indices
INTEGER*4 IA(INEL)
DATA IA/1,2,3,4,2,3,1,2,4,4,1,4,2,3,1,4,3/
C
C Column starts
INTEGER*4 JA(ICL1)
DATA JA/1,5,7,10,11,13,15,17,18/
C
C Upper and lower bounds of rows.
REAL*8 DRLO(IRL),DRUP(IRL)
DATA DRLO/IRL*-1.0D31/ DRUP/9.0D2,6.5D2,5.2D2,9.9D2/
C
C Lower bounds of columns.
REAL*8 DCLO(ICL)
DATA DCLO/ICL*0.0D0/
C
C Upper bounds of columns.
REAL*8 DCUP(ICL)
DATA DCUP/1.0D4,1.0D4,1.0D4,1.0D4,1.0D4,2.0D4,2.0D4,2.0D4/
C
C Variable numbers of the integer variables
INTEGER*4 INTNUMS(NINTS)
DATA INTNUMS/1,4,5,7/
C
C Set priorities.
INTEGER*4 PRIORITY(1)
DATA PRIORITY/1000/
C
C Total size of sets and variables.
INTEGER*4 NTOTINFO
DATA NTOTINFO/NINTS/
C
C Indices of sets.
INTEGER*4 SETINDX(2)
DATA SETINDX/1,NINTS1/
C
C Variable numbers of the variables in sets.
INTEGER*4 SETS(NINTS)
DATA SETS/1,4,5,7/
C
C Pseudo costs.
REAL*8 DNPCOST(NINTS),UPPCOST(NINTS)
DATA DNPCOST/NINTS*1.0D-03/ UPPCOST/NINTS*1.0D-03/
C
C Types of sets for EKKIMDL call
INTEGER*4 TYPE(1)
DATA TYPE/4/
C
C Objective function coefficients.
REAL*8 DOBJ(ICL)
DATA DOBJ/4.0D0,-2.0D0,7.0D0,-1.0D0,2.0D0,-2.0D0,3.0D0,-1.0D0/
C
C Elements of the constraint matrix.
REAL*8 DELS(INEL)
DATA DELS /2*1.0D0,6.0D0,-1.0D0,1.0D0,-5.0D0,5.0D0,-1.0D0,2.0D0,
+ -2.0D0,-1.0D0,1.0D0,-2.0D0,1.0D0,1.0D0,1.0D0,-2.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 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 NINTS=4 integer variables.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
IMAXINTS = NINTS
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKISET',RTCOD)
C
C Pass the model with the matrix stored by columns.
CALL EKKLMDL(RTCOD,DSPACE,LTYPE,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.
CALL EKKIMDL(RTCOD,DSPACE,NINTS,INTNUMS,NSETS,TYPE,
+ PRIORITY,NTOTINFO,SETINDX,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 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
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 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 ]