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 EXNAME2
C
C This program solves the same maximization problem as the one defined
C in the program EXLMDL. However, EKKNAME is used here to add names
C to the matrix.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include files with control variable definitions.
IMPLICIT NONE
INCLUDE (OSLI)
INCLUDE (OSLR)
INCLUDE (OSLN)
INCLUDE (OSLC)
C
C Allocate dspace and other arrays.
INTEGER*4 MAXSPC,IRL,ICL,ICL1,IEL
PARAMETER (MAXSPC=15000)
REAL*8 DSPACE(MAXSPC)
CHARACTER*8 CSPACE(MAXSPC)
EQUIVALENCE (DSPACE,CSPACE)
C
PARAMETER (IRL=5,ICL=8,ICL1=9,IEL=14)
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,I
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 Names to be added to matrix.
CHARACTER*8 ROWNAMES(5), COLNAMES(8)
DATA COLNAMES /'TCOL0001','TCOL0002','TCOL0003','TCOL0004',
+ 'TCOL0005','TCOL0006','TCOL0007','TCOL0008'/
DATA ROWNAMES /'ROW01 ','ROW02 ','ROW03 ','ROW04 ',
+ 'ROW05 '/
INTEGER*4 NUMROW, NUMCOL, STARTROW, STARTCOL, OSLNAMES
DATA NUMROW,NUMCOL,STARTROW,STARTCOL,OSLNAMES/0,8,1,1,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 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 Add column names to the model; let EKKNAME generate row names.
CALL EKKNAME(RTCOD,DSPACE,NUMROW,ROWNAMES,STARTROW,NUMCOL,
+ COLNAMES,STARTCOL,OSLNAMES)
IF (RTCOD.GT.0) CALL CHKRT('EKKNAME',RTCOD)
C
C Write model to a 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 using the simplex method.
CALL EKKSSLV(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
C
C Change the row names directly.
CALL EKKNGET(RTCOD,DSPACE,OSLN,OSLNLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKNGET',RTCOD)
DO 10 I = 1,NROW
CSPACE(NROWNAMES+I-1)=ROWNAMES(I)
10 CONTINUE
C
C Change the name of the model.
CALL EKKCGET(RTCOD,DSPACE,OSLC,OSLCLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKCGET',RTCOD)
CNAME='TINYPROB'
CALL EKKCSET(RTCOD,DSPACE,OSLC,OSLCLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKCSET',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 EXNFES
C
C This program analyzes the following infeasible 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 (by indices or column-major order).
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 CROW is the array containing row names.
C CCOL is the array containing column names.
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,RTCOD
PARAMETER (MAXSPC=15000,IRL=5,ICL=8,ICL1=9,IEL=14)
REAL*8 DSPACE(MAXSPC),SINF
REAL*8 DRLO(IRL),DCLO(ICL),DOBJ(ICL),DELS(IEL),DRUP(IRL),DCUP(ICL)
INTEGER*4 NCOL,NROW,NEL,ITYPE,MCOL(ICL1),MROW(IEL),ISAVEUNIT
CHARACTER*12 CROW(IRL),CCOL(ICL)
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 Row Names
DATA CROW /'ROW01','ROW02','ROW03','ROW04','ROW05'/
C
C Column Names
DATA CCOL /'COL01','COL02','COL03','COL04','COL05',
+ 'COL06','COL07','COL08'/
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 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 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('EKKISET',RTCOD)
CALL EKKNAME(RTCOD,DSPACE,NROW,CROW,1,NCOL,CCOL,1,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKNAME',RTCOD)
C
C Solve problem using primal simplex.
CALL EKKSSLV(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
C
C Perform infeasibility analysis.
CALL EKKNFES(RTCOD,DSPACE,7,1,0,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKNFES',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)
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 EXNCRSH
C
C This program solves the following problem:
C
C Minimize 1x1 +2x2 +3x3 +4x4 +5x5 +6x6 +7x7 +8x8 +10x9 +10x10
C
C Subject to
C
C -x1 - x2 + x3 = -1
C x1 + x4 = 1
C - x3 - x4 - x5 = -2
C x2 + x5 = 2
C - x6 - x7 - x8 = -3
C x6 + x9 = 3
C x8 - x9 - x10 = -4
C x7 + x10 = 4
C 0 <= x5 + x6 <= 3
C
C The two network blocks (rows 1 through 4 and rows 5 through 8)
C are solved together using EKKNSLV. The last row (row 9) is added
C using EKKROW, and the complete problem is solved with the dual
C algorithm of EKKSSLV. The init=0 option of EKKSSLV is selected, so
C that the basis created by EKKNSLV will be used as an advanced basis.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include files with control variable definitions.
INCLUDE (OSLI)
INCLUDE (OSLN)
INCLUDE (OSLR)
C
C Allocate dspace and other arrays.
PARAMETER (MAXSPC=20000)
REAL*8 DSPACE(MAXSPC),DDELS(20)
INTEGER*4 IRL,ICL,IEL,DRLO,DCLO,DOBJ,DELS,DRUP,DCUP,MCOL,MROW,
+ NFROM,NTO,MMROW(20),MMCOL(20),NCOL,NROW,NEL,ITYPE,RTCOD,NUMELS
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 and allow room for one block.
CALL EKKDSCM(RTCOD,DSPACE,1,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
C
C Assume that the network part of the problem may have as many as 20
C columns (arcs) and 20 rows (nodes).
IRL = 20
ICL = 20
IEL = 2*ICL
C
C Reserve space in dspace for a number of working arrays.
C Note: these arrays could be in user's storage.
CALL EKKHIS(RTCOD,DSPACE,IRL,DRLO)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS ',RTCOD)
CALL EKKHIS(RTCOD,DSPACE,IRL,DRUP)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS ',RTCOD)
CALL EKKHIS(RTCOD,DSPACE,ICL,DCUP)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS ',RTCOD)
CALL EKKHIS(RTCOD,DSPACE,ICL,DCLO)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS ',RTCOD)
CALL EKKHIS(RTCOD,DSPACE,ICL,DOBJ)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS ',RTCOD)
CALL EKKHIS(RTCOD,DSPACE,IEL,DELS)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS ',RTCOD)
CALL EKKHIS(RTCOD,DSPACE,ICL,MCOL)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS ',RTCOD)
CALL EKKHIS(RTCOD,DSPACE,ICL,MROW)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS ',RTCOD)
CALL EKKHIS(RTCOD,DSPACE,ICL,NFROM)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS ',RTCOD)
CALL EKKHIS(RTCOD,DSPACE,ICL,NTO)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS ',RTCOD)
C
C Print out memory storage being used.
CALL EKKSMAP(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKSMAP',RTCOD)
C
C Get the data associated with network part of the problem.
CALL GETIN(DSPACE(DRLO),DSPACE(DCLO),DSPACE(DOBJ),DSPACE(DELS),
+ DSPACE(DRUP),DSPACE(DCUP),DSPACE(MCOL),DSPACE(MROW),
+ DSPACE(NFROM),DSPACE(NTO),NCOL,NROW,NEL,ITYPE)
C
C Set Imaxcols and Imaxrows so that there is enough room for at least
C 5 additional columns and 5 additional rows.
C
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
IMAXCOLS = ICL + 5
IMAXROWS = IRL + 5
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKISET',RTCOD)
C
C Load the network part of the problem.
C Note that EKKNMDL could have been used instead of EKKLMDL.
CALL EKKLMDL(RTCOD,DSPACE,ITYPE,NROW,NCOL,NEL,DSPACE(DOBJ),
+ DSPACE(DRLO),DSPACE(DRUP),DSPACE(DCLO),DSPACE(DCUP),
+ DSPACE(MROW),DSPACE(MCOL),DSPACE(DELS))
C
C Since the arrays passed to EKKLMDL reside in dspace, EKKLMDL
C will return an error return code. However, this is not a
C problem here. Check only for severe messages.
C
IF (RTCOD.GE.300) CALL CHKRT('EKKLMDL',RTCOD)
C
C Solve the network problem using primal algorithm.
CALL EKKNSLV(RTCOD,DSPACE,1,3)
IF (RTCOD.GT.0) CALL CHKRT('EKKNSLV',RTCOD)
C
C Initializing some parameters associated with row 9. The constraint
C imposes a requirement that the sum of the flows on arcs 5 and 6
C should be between 0.0 and 3.0.
C
MMCOL(1) = 5
MMCOL(2) = 6
DDELS(1) = 1.0D0
DDELS(2) = 1.0D0
NUMELS = 2
C
CALL EKKNGET(RTCOD,DSPACE,OSLN,OSLNLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKNGET',RTCOD)
DSPACE(NROWUPPER+9-1) = 3.0D0
DSPACE(NROWLOWER+9-1) = 0.0D0
C
C Now add the additional constraint.
CALL EKKROW(RTCOD,DSPACE,1,9,NUMELS,DDELS,MMCOL)
IF (RTCOD.GT.0) CALL CHKRT('EKKROW ',RTCOD)
C
C Make Rdweight small to help maintain dual feasibility.
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRGET',RTCOD)
RDWEIGHT = 1.0D-4
CALL EKKRSET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRSET',RTCOD)
C
C Solve the total problem with EKKSSLV using dual algorithm.
CALL EKKSSLV(RTCOD,DSPACE,2,0)
IF (RTCOD.GT.300) 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 routine transfers information related to network problem under
C consideration into various arrays. Note that the adjacency lists
C will not be used by EKKLMDL and may be deleted.
C***********************************************************************
C
SUBROUTINE GETIN(DRLO,DCLO,DOBJ,DELS,DRUP,DCUP,MCOL,MROW,
+ NFROM,NTO,NCOL,NROW,NEL,ITYPE)
C
REAL*8 DRLO(*),DCLO(*),DOBJ(*),DELS(*),DRUP(*),DCUP(*)
INTEGER*4 MCOL(*),MROW(*),NFROM(*),NTO(*),NCOL,NROW,NEL,ITYPE
INTEGER*4 NE,NC,NR,IT,I
PARAMETER (NE=20,NC=10,NR=8,IT=2)
REAL*8 DDRLO(NR),DDCLO(NC),DDOBJ(NC),DDELS(NE),DDRUP(NR),
+ DDCUP(NC)
INTEGER*4 MMCOL(NC+1),MMROW(NE),NNFROM(NC),NNTO(NC)
C
DATA DDRLO/-1.0,1.0,-2.0,2.0,-3.0,3.0,-4.0,4.0/
DATA DDCLO/NC*0.0/,DDCUP/NC*1.0D31/
DATA DDRUP/-1.0,1.0,-2.0,2.0,-3.0,3.0,-4.0,4.0/
DATA DDOBJ/1.0,2.0,3.0,4.0,4.0,6.0,7.0,8.0,10.0,10.0/
DATA DDELS/1.0,-1.0,1.0,-1.0,1.0,-1.0,1.0,-1.0,1.0,-1.0,1.0,
+ -1.0,1.0,-1.0,1.0,-1.0,1.0,-1.0,1.0,-1.0/
DATA MMCOL/1,3,5,7,9,11,13,15,17,19,21/
DATA MMROW/2,1,4,1,1,3,2,3,4,3,6,5,8,5,5,7,6,7,8,7/
DATA NNFROM/2,4,1,2,4,6,8,7,6,8/
DATA NNTO/1,1,3,3,3,5,5,5,7,7/
C
NEL = NE
NCOL = NC
NROW = NR
ITYPE= IT
C
C Row bounds
DO I=1,NROW
DRLO(I) = DDRLO(I)
DRUP(I) = DDRUP(I)
ENDDO
C
C Column bounds, Objective, Adjacencies, Column start
DO I=1,NCOL
DCLO(I) = DDCLO(I)
DCUP(I) = DDCUP(I)
DOBJ(I) = DDOBJ(I)
NFROM(I)= NNFROM(I)
NTO(I) = NNTO(I)
MCOL(I) = MMCOL(I)
ENDDO
MCOL(NCOL+1) = MMCOL(NCOL+1)
C
C Row numbers, Elements
DO I=1,NEL
MROW(I) = MMROW(I)
DELS(I) = DDELS(I)
ENDDO
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
C
No input data is required to run this program.
C***********************************************************************
C
C EXNGET
C
C This program calls EKKSSLV, EKKMPRE and EKKMSLV to solve a mixed
C integer programming problem.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Bring in include files with control variable definitions.
IMPLICIT NONE
INCLUDE (OSLN)
INCLUDE (OSLI)
C
C Allocate dspace.
INTEGER*4 MAXSPC,RTCOD
PARAMETER (MAXSPC=1000000)
REAL*8 DSPACE(MAXSPC)
CHARACTER*8 CSPACE(MAXSPC)
EQUIVALENCE (DSPACE,CSPACE)
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 Read model data from MPS file on unit 98.
CALL EKKMPS(RTCOD,DSPACE,98,2,55)
IF (RTCOD.GT.0) CALL CHKRT('EKKMPS ',RTCOD)
C
C Solve the LP.
CALL EKKSSLV(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
C
C Preprocess the branch-and-bound tree.
CALL EKKMPRE(RTCOD,DSPACE,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKMPRE',RTCOD)
C
C Solve the MIP.
CALL EKKMSLV(RTCOD,DSPACE,1,35,36)
IF (RTCOD.GT.0) CALL CHKRT('EKKMSLV',RTCOD)
C
C Get current row and column values for formated printing.
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 MYFILE(9,INUMROWS,INUMCOLS,CSPACE(NROWNAMES),
+ CSPACE(NCOLNAMES),DSPACE(NROWACTS),DSPACE(NCOLSOL),
+ DSPACE(NROWDUALS),DSPACE(NCOLRCOSTS))
C
IPRTINFOMASK = 63
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)
STOP
END
C
C***********************************************************************
C This subroutine gets specific values and formats them for output.
C***********************************************************************
C
SUBROUTINE MYFILE(IUNIT,NROWS,NCOLS,QROWS,QCOLS,DROWACT,DCOLACT,
+ DROWDUAL,DCOLDUAL)
C
INTEGER*4 IUNIT,NROWS,NCOLS
CHARACTER*8 QROWS(*),QCOLS(*)
REAL*8 DROWACT(*),DCOLACT(*),DROWDUAL(*),DCOLDUAL(*)
C
WRITE(IUNIT,90) 'ROWS '
DO 10 I=1,NROWS
WRITE(IUNIT,100) I,QROWS(I),DROWACT(I),DROWDUAL(I)
10 CONTINUE
C
WRITE(IUNIT,90) 'COLUMNS '
DO 20 I=1,NCOLS
WRITE(IUNIT,100) I,QCOLS(I),DCOLACT(I),DCOLDUAL(I)
20 CONTINUE
C
90 FORMAT(A8)
100 FORMAT(I8,1X,A8,1X,D20.5,1X,D20.5)
C 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 2".
C***********************************************************************
C
C EXNMDL
C
C This program solves the following problem:
C
C Minimize x1 + 2x2 + x3
C
C Subject to:
C
C 2.0 <= x1 + x2 <= 4.0
C 0.0 <= - x2 + x3 <= 0.0
C -3.0 <= -x1 - x3 <= -3.0
C
C 0.0 <= x1 <= 1.0
C 0.0 <= x2 <= 1.0D+31
C 0.0 <= x3 <= 1.0D+31
C
C The constraint matrix has three rows. Arc 1 has a lower bound on
C its flow of 0.0 and an upper bound of 1.0. Arcs 2 and 3 have
C lower bounds of 0.0 and upper bounds of infinity.
C
C EKKNMDL is used to create data structures from network model
C information. EKKNSLV is used to solve the problem.
C
C***********************************************************************
C
PROGRAM MAIN
C
C Allocate dspace.
INTEGER*4 MAXSPC,IRL,ICL
PARAMETER (MAXSPC=20000,IRL=50,ICL=100)
REAL*8 DSPACE(MAXSPC),DRES1,DRES2
INTEGER*4 RTCOD,DRLO,DCLO,DOBJ,DRUP,DCUP,NCOL,NROW,NFROM,NTO
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 Reserve space in dspace for a number of temporary arrays.
C Note: these arrays could be in user's storage.
CALL EKKHIS(RTCOD,DSPACE,IRL,DRLO)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS ',RTCOD)
CALL EKKHIS(RTCOD,DSPACE,IRL,DRUP)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS ',RTCOD)
CALL EKKHIS(RTCOD,DSPACE,ICL,DCUP)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS ',RTCOD)
CALL EKKHIS(RTCOD,DSPACE,ICL,DCLO)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS ',RTCOD)
CALL EKKHIS(RTCOD,DSPACE,ICL,DOBJ)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS ',RTCOD)
CALL EKKHIS(RTCOD,DSPACE,ICL,NFROM)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS ',RTCOD)
CALL EKKHIS(RTCOD,DSPACE,ICL,NTO)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS ',RTCOD)
C
C Print out memory storage being used.
CALL EKKSMAP(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKSMAP',RTCOD)
C
C Get data associated with network problem.
CALL GETIN(DSPACE(DRLO),DSPACE(DCLO),DSPACE(DOBJ),DSPACE(DRUP),
+ DSPACE(DCUP),DSPACE(NFROM),DSPACE(NTO),NCOL,NROW)
C
C Load network problem from various arrays. Store matrix by columns.
CALL EKKNMDL(RTCOD,DSPACE,1,1,NCOL,NROW,DSPACE(NFROM),DSPACE(NTO),
+ DSPACE(DOBJ),DSPACE(DCLO),DSPACE(DCUP),DSPACE(DRLO),
+ DSPACE(DRUP),DRES1,DRES2)
C
C Since the arrays passed to EKKNMDL reside in dspace, EKKNMDL
C may return an error return code. However, this is not a
C problem here. Check only for severe messages.
C
IF (RTCOD.GT.300) CALL CHKRT('EKKNMDL',RTCOD)
C
C Solve the network problem.
CALL EKKNSLV(RTCOD,DSPACE,1,3)
IF (RTCOD.GT.0) CALL CHKRT('EKKNSLV',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 transfers information of network problem under
C consideration into various arrays.
C***********************************************************************
C
SUBROUTINE GETIN(DRLO,DCLO,DOBJ,DRUP,DCUP,NFROM,NTO,NCOL,NROW)
C
REAL*8 DRLO(*),DCLO(*),DOBJ(*),DRUP(*),DCUP(*)
INTEGER*4 NFROM(*),NTO(*),NCOL,NROW
C
NCOL = 3
NROW = 3
C
C Row bounds
DRLO(1) = 2.0D0
DRUP(1) = 4.0D0
DRLO(2) = 0.0D0
DRUP(2) = 0.0D0
DRLO(3) = -3.0D0
DRUP(3) = -3.0D0
C
C Column bounds
DCLO(1) = 0.0D0
DCUP(1) = 1.0D0
DCLO(2) = 0.0D0
DCUP(2) = 1.0D31
DCLO(3) = 0.0D0
DCUP(3) = 1.0D31
C
C Objective
DOBJ(1) = 1.0D0
DOBJ(2) = 2.0D0
DOBJ(3) = 1.0D0
C
C Adjacencies - NFROM/NTO correspond to rows with 1.0/-1.0
NFROM(1) = 1
NTO (1) = 3
NFROM(2) = 1
NTO (2) = 2
NFROM(3) = 2
NTO (3) = 3
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 EXNSLV
C
C This program reads a network problem from an MPS file and solves
C it using the primal network simplex method.
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=150000)
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 Reduce frequency of call to EKKITRU to improve performance.
C Set Iiterufreq to a large number.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
IITERUFREQ = 999999
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKISET',RTCOD)
C
C Solve network problem.
CALL EKKNSLV(RTCOD,DSPACE,1,3)
IF (RTCOD.GT.0) CALL CHKRT('EKKNSLV',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 4".
C***********************************************************************
C
C EXOSLBAS
C
C This program reads a problem from an MPS file, sets up a basis,
C solves the problem with the simplex method, and prints the solution.
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.
INTEGER*4 MAXSPC,RTCOD
PARAMETER (MAXSPC=50000)
CHARACTER*8 CSPACE(MAXSPC)
INTEGER*4 MSPACE(2*MAXSPC)
REAL*8 DSPACE(MAXSPC)
EQUIVALENCE (DSPACE,MSPACE,CSPACE)
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 Create a row copy of the matrix.
CALL EKKCOPY(RTCOD,DSPACE,3)
IF (RTCOD.GT.0) CALL CHKRT('EKKCOPY',RTCOD)
C
C Get values of control variables.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.NE.0) CALL CHKRT('EKKIGET',RTCOD)
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.NE.0) CALL CHKRT('EKKRGET',RTCOD)
CALL EKKNGET(RTCOD,DSPACE,OSLN,OSLNLN)
IF (RTCOD.NE.0) CALL CHKRT('EKKNGET',RTCOD)
C
C Set up the basis.
CALL SETBAS(MSPACE(NROWRC),MSPACE(NCOLRC),CSPACE(NROWNAMES),
+ DSPACE(NOBJECTIVE),MSPACE(NROWSTAT),MSPACE(NCOLSTAT),
+ INUMROWS,RMAXMIN,IPRINTUNIT)
C
C Solve the problem using the basis.
CALL EKKSSLV(RTCOD,DSPACE,2,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 sets up a basis. For certain rows, the column with
C the smallest objective coefficient is marked as basic.
C
C In this example, the MPS file contains equality GUB rows.
C The names of these rows begin with GUB. By choosing variables
C with the smallest objective coefficient to be basic, a dual
C feasible basis can be obtained.
C
C Note: Generalized upper bound rows are sets of rows with no columns
C in common, and all element values 1.0. They may be L or G rows.
C***********************************************************************
C
SUBROUTINE SETBAS(MROW,MCOL,NAMES,DOBJ,MRSTAT,MCSTAT,NROW,
+ DWAY,IPRINTUNIT)
C
INTEGER*4 MROW(*),MCOL(*),MRSTAT(*),MCSTAT(*),IBASIC
REAL*8 DOBJ(*),DMM,DWAY
CHARACTER*8 NAMES(*)
C
C Basic variables have the 32 bit (most significant) set.
IBASIC=ISHFT(1,31)
C
DO IROW =1,NROW
IF (NAMES(IROW)(1:3) .EQ. 'GUB') THEN
C Initialize the smallest objective coefficient to infinity
DMM=1.0D31
DO IEL=MROW(IROW),MROW(IROW+1)-1
JCOL=MCOL(IEL)
C See if the current objective coefficient is the
C smallest so far
IF (DMM.GT.DWAY*DOBJ(JCOL)) THEN
KCOL=JCOL
DMM=DWAY*DOBJ(JCOL)
ENDIF
ENDDO
C Mark the column as basic
MCSTAT(KCOL)=IBASIC
MRSTAT(IROW)=0
WRITE(IPRINTUNIT,*) 'Column ',KCOL,' marked as basic.'
ENDIF
ENDDO
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 Linear Programming Model Data 7".
C***********************************************************************
C
C EXPARA1
C
C This driver reads in an MPS file which includes parametric delta
C vectors, solves it, and then performs LP parametric analysis.
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
PARAMETER (MAXSPC=50000)
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 up names of parametric change vectors as they are in MPS file.
CALL EKKCGET(RTCOD,DSPACE,OSLC,OSLCLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKCGET',RTCOD)
CCHANGEOBJ = 'CHANGOBJ'
CCHANGERHS = 'CHANGRHS'
CCHANGERANGE = 'CHANGRNG'
CCHANGEBOUNDS = 'CHANGBND'
CALL EKKCSET(RTCOD,DSPACE,OSLC,OSLCLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKCSET',RTCOD)
C
C Read an LP model (with parametric vectors) from MPS file on unit 98.
CALL EKKMPS(RTCOD,DSPACE,98,2,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKMPS ',RTCOD)
C
C Solve the problem using primal simplex.
CALL EKKSSLV(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
C
C Perform LP parametric analysis (using default Lambda parameters).
CALL EKKSPAR(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKSPAR',RTCOD)
C
C Print the problem 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 5".
C***********************************************************************
C
C EXPARA2
C
C This program sets up the LP problem shown below and uses EKKPMDL
C to set up parametric change vectors. The program then solves the
C the problem (maximization) using simplex method. The subroutine
C EKKSPAR is used to performs LP parametric analysis.
C Note: EKKPMDL can also be used after setting up LP with EKKMPS.
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 (by indices or column-major order).
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 file with real control variable definitions.
IMPLICIT NONE
INCLUDE (OSLR)
C
C Allocate dspace and other arrays.
INTEGER*4 MAXSPC,IRL,ICL,ICL1,IEL
PARAMETER (MAXSPC=25000,IRL=5,ICL=8,ICL1=9,IEL=14)
REAL*8 DSPACE(MAXSPC)
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 Change vectors for objective, row/column lower and upper bounds.
REAL*8 OBJDEL(8),ROWLOWDEL(5),ROWUPDEL(5),
+ COLLOWDEL(8),COLUPDEL(8)
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 Set up parametric vectors.
C Range the objective function coefficients which are currently
C zero up to +5.
DATA OBJDEL /0.0,3*5.0,0.0,2*5.0,0.0/
C Range last two row lower bounds down by 1
DATA ROWLOWDEL /3*0.0,2*-1.0/
C Range last four row upper bounds up by 3
DATA ROWUPDEL /0.0,4*3.0/
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 Load 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 Load the parametric change vectors.
C Use only objective and row bounds parametrics (MASK=7).
CALL EKKPMDL(RTCOD,DSPACE,OBJDEL,ROWLOWDEL,ROWUPDEL,
+ COLLOWDEL,COLUPDEL,7)
IF (RTCOD.GT.0) CALL CHKRT('EKKPMDL',RTCOD)
C
C Solve using primal simplex method.
CALL EKKSSLV(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
C
C Set control variables so that EKKSPAR parametric analysis
C is done by taking five equal steps toward change vectors.
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRGET',RTCOD)
RSLAMBDA = 0.0
RSLAMBDALIM = 1.0
RSLAMBDADELTA = 0.2
CALL EKKRSET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRSET',RTCOD)
C
C Perform LP parametric analysis.
CALL EKKSPAR(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKSPAR',RTCOD)
C
C Print the solution.
CALL EKKPRTS(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKPRTS',RTCOD)
C
STOP
END
C
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 EXPRSL
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 (by indices or column-major order).
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,RTCOD
PARAMETER (MAXSPC=15000,IRL=5,ICL=8,ICL1=9,IEL=14)
REAL*8 DSPACE(MAXSPC),SINF
REAL*8 DRLO(IRL),DCLO(ICL),DOBJ(ICL),DELS(IEL),DRUP(IRL),DCUP(ICL)
INTEGER*4 NCOL,NROW,NEL,ITYPE,MCOL(ICL1),MROW(IEL),ISAVEUNIT
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 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 Turn off printing of message numbers.
CALL EKKMSET(RTCOD,DSPACE,1,0,0,0,0,9999,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKMSET',RTCOD)
C
C Set to print EKKSTAT output to a different file unit.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
ISAVEUNIT=IPRINTUNIT
IPRINTUNIT=12
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKISET',RTCOD)
C
C Print problem statistics.
CALL EKKSTAT(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKSTAT',RTCOD)
C
C Set the print unit back to its previous value.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
IPRINTUNIT=ISAVEUNIT
CALL EKKISET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKISET',RTCOD)
C
C Turn on printing of message numbers.
CALL EKKMSET(RTCOD,DSPACE,1,0,0,0,0,9999,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKMSET',RTCOD)
C
C Scale the matrix.
CALL EKKSCAL(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKSCAL',RTCOD)
C
C Presolve problem.
CALL EKKPRSL(RTCOD,DSPACE,15,3)
IF (RTCOD.GT.0) CALL CHKRT('EKKPRSL',RTCOD)
C
C Decide if CRSH will help or not. Simple strategy based on sum of
C primal infeasibilities.
C NOTE: this could also be done using TYPE = 3 in EKKCRSH.
C Get solution and the sum of infeasibilities before CRSH.
C
CALL EKKINVT(RTCOD,DSPACE,1,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKINVT',RTCOD)
C
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRGET',RTCOD)
SINF=RSUMPINF
WRITE(6,8000) SINF
8000 FORMAT(1X,'Sum of primal infeasibilities before CRSH: ',D12.5)
C
C Crash.
CALL EKKCRSH(RTCOD,DSPACE,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKCRSH',RTCOD)
C
C Get solution and the sum of infeasibilities after CRSH.
CALL EKKINVT(RTCOD,DSPACE,1,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKINVT',RTCOD)
C
CALL EKKRGET(RTCOD,DSPACE,OSLR,OSLRLN)
IF (RTCOD.GT.0) CALL CHKRT('EKKRGET',RTCOD)
WRITE(6,9000) RSUMPINF
9000 FORMAT(1X,'Sum of primal infeasibilities after CRSH: ',D12.5)
C
C If the sum of infeasibilities was better before CRSH, get a NLBS.
C Otherwise, use the basis resulting from CRSH.
C
IF (SINF.LT.RSUMPINF) CALL EKKNLBS(RTCOD,DSPACE)
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 primal simplex.
CALL EKKSSLV(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
C
C Post-solve problem.
CALL EKKPSSL(RTCOD,DSPACE,15)
IF (RTCOD.GT.0) CALL CHKRT('EKKPSSL',RTCOD)
C
C Solve again to ensure dual feasibility.
CALL EKKSSLV(RTCOD,DSPACE,1,3)
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)
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 EXPTMD
C
C This program switches between multiple models in one application
C program.
C
C The first model is:
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 Here 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 NROW1 is the total number of rows in the composite matrix.
C NCOL1 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 DOBJ1 is the objective row.
C DRLO1 is the row lower bounds.
C DRUP1 is the row upper bounds.
C DCLO1 is the column lower bounds.
C DCUP1 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.
PARAMETER (MAXSPC=20000)
REAL*8 DSPACE(MAXSPC)
C
INTEGER*4 IA(10),JA(10),IB(10),JB(10),IC(10),JC(10),RTCOD
INTEGER*4 MROW(30),MCOL(30),NEL,ITYPE,NROW1,NCOL1,NROW2,NCOL2
REAL*8 DRLO1(15),DRUP1(15),DCLO1(30),DCUP1(30),DOBJ1(30)
REAL*8 DRLO2(15),DRUP2(15),DCLO2(30),DCUP2(30),DOBJ2(30)
REAL*8 DELS(30),A(10),B(10),C(10)
C
DATA NROW1,NCOL1 /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/
DATA 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 bounds on row activities.
DATA DRLO1 /1.0D02,5.0D01,13*0.0D0/
C
C Upper bounds on row activities.
DATA DRUP1 /1.0D02,5.0D01,13*0.0D0/
C
C Lower bounds on columns.
DATA DCLO1 /30*0.0D0/
C
C Upper bounds on columns.
DATA DCUP1 /30*1.0D31/
C
C Objective function coefficients.
DATA DOBJ1 /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 are 2 models.
CALL EKKDSCA(RTCOD,DSPACE,MAXSPC,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCA',RTCOD)
C
C Describe model 1 as having 9 blocks.
CALL EKKDSCM(RTCOD,DSPACE,1,9)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
C
C Set up the model.
CALL EKKLMDL(RTCOD,DSPACE,1,NROW1,NCOL1,0,DOBJ1,DRLO1,DRUP1,
+ DCLO1,DCUP1,0,0,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKLMDL',RTCOD)
C
C Describe A block.
CALL EKKDSCB(RTCOD,DSPACE,IATYPE,1,IA,JA,A,0,0,NACOL,NA)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCB',RTCOD)
C
C Describe B block.
CALL EKKDSCB(RTCOD,DSPACE,IBTYPE,2,IB,JB,B,2,0,NBCOL,NB)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCB',RTCOD)
C
C Describe C block.
CALL EKKDSCB(RTCOD,DSPACE,ICTYPE,3,IC,JC,C,8,24,NCCOL,NC)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCB',RTCOD)
C
C Repeat A block.
CALL EKKDSCB(RTCOD,DSPACE,IATYPE,4,IA,JA,A,2,6,NACOL,NA)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCB',RTCOD)
C
CALL EKKDSCB(RTCOD,DSPACE,IATYPE,5,IA,JA,A,4,12,NACOL,NA)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCB',RTCOD)
C
CALL EKKDSCB(RTCOD,DSPACE,IATYPE,6,IA,JA,A,6,18,NACOL,NA)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCB',RTCOD)
C
C Repeat B block.
CALL EKKDSCB(RTCOD,DSPACE,IBTYPE,7,IB,JB,B,4,6,NBCOL,NB)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCB',RTCOD)
C
CALL EKKDSCB(RTCOD,DSPACE,IBTYPE,8,IB,JB,B,6,12,NBCOL,NB)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCB',RTCOD)
C
CALL EKKDSCB(RTCOD,DSPACE,IBTYPE,9,IB,JB,B,8,18,NBCOL,NB)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCB',RTCOD)
C
C Create new copy of the matrix.
CALL EKKNWMT(RTCOD,DSPACE,3)
IF (RTCOD.GT.0) CALL CHKRT('EKKNWMT',RTCOD)
C
C Now save this model as a file on unit 16 for later use.
CALL EKKPTMD(RTCOD,DSPACE,16)
IF (RTCOD.GT.0) CALL CHKRT('EKKPTMD',RTCOD)
C
C Now build a second model (describe it with only 1 block).
CALL EKKDSCM(RTCOD,DSPACE,2,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
C
C***********************************************************************
C
C The second model is:
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***********************************************************************
C
C Define model.
DATA NROW2,NCOL2,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,16*0.0D0/
C
C Row indices.
DATA MROW /1,5,1,2,2,3,1,4,1,5,3,4,1,5,16*0/
C
C Column starts.
DATA MCOL /1,3,5,7,9,11,12,13,15,21*0/
C
C Lower bounds on row activities.
DATA DRLO2 /2.5D0,-1.0D31,4.0D0,1.8D0,3.0D0,10*0/
C
C Upper bounds on row activities.
DATA DRUP2 /1.0D31,2.1D0,4.0D0,5.0D0,1.5D01,10*0/
C
C Lower bounds on columns.
DATA DCLO2 /2.5D0,0.0D0,2*0.0D0,5.0D-1,25*0.0D0/
C
C Upper bounds on columns.
DATA DCUP2 /1.0D31,4.1D0,2*1.0D31,4.0D0,2*1.0D31,4.3D0,22*0.0D0/
C
C Objective function coefficients.
DATA DOBJ2 /1.0D0,3*0.0D0,2.0D0,2*0.0D0,-1.0D0,22*0.0D0/
C
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 in the model with matrix stored by columns.
CALL EKKLMDL(RTCOD,DSPACE,ITYPE,NROW2,NCOL2,NEL,DOBJ2,DRLO2,DRUP2,
+ DCLO2,DCUP2,MROW,MCOL,DELS)
IF (RTCOD.GT.0) CALL CHKRT('EKKLMDL',RTCOD)
C
C Solve using the 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 Retrieve the first model.
CALL EKKGTMI(RTCOD,DSPACE,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKGTMI',RTCOD)
CALL EKKGTMD(RTCOD,DSPACE,16)
IF (RTCOD.GT.0) CALL CHKRT('EKKGTMD',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 Solve the LP using the simplex method.
CALL EKKSSLV(RTCOD,DSPACE,1,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKSSLV',RTCOD)
C
C Set to print only 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.NE.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 EXQMDL
C
C This program solves the following problem:
C
C Minimize x1 + 2x5 - x8 + 1/2(x1**2 + x2**2 + x3**2 + x4**2
C + x5**2 + x6**2 + x7**2 + x8**2)
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 Allocate dspace and other arrays.
IMPLICIT NONE
INTEGER*4 MAXSPC,IRL,ICL,ICL1,IEL
PARAMETER (MAXSPC=20000,IRL=5,ICL=8,ICL1=9,IEL=14)
REAL*8 DSPACE(MAXSPC),DELSQ(8)
INTEGER*4 MROWQ(8),MCOLQ(8),NELQ,IQTYPE,RTCOD
REAL*8 DRLO(IRL),DCLO(ICL),DOBJ(ICL),DELS(IEL),DRUP(IRL),DCUP(ICL)
INTEGER*4 NCOL,NROW,NEL,ITYPE,MCOL(ICL1),MROW(IEL)
C
C Define the model.
DATA NROW,NCOL,NEL,ITYPE /5,8,14,2/
C
C Define the quadratic matrix.
DATA NELQ,IQTYPE /8,1/
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 Quadratic matrix elements.
DATA DELSQ /8*1.0D0/
C
C Quadratic matrix row indices.
DATA MROWQ /1,2,3,4,5,6,7,8/
C
C Quadratic matrix column indices.
DATA MCOLQ /1,2,3,4,5,6,7,8/
C
C
C Describe application and specify that there is 1 model.
CALL EKKDSCA(RTCOD,DSPACE,MAXSPC,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCA',RTCOD)
C
C Describe the model. Minimum of 5 blocks are needed for QP.
CALL EKKDSCM(RTCOD,DSPACE,1,5)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
C
C Pass linear 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 Pass quadratic matrix stored by indices.
CALL EKKQMDL(RTCOD,DSPACE,IQTYPE,NELQ,MROWQ,MCOLQ,DELSQ)
IF (RTCOD.GT.0) CALL CHKRT('EKKQMDL',RTCOD)
C
C Solve the QP using the primal algorithm.
CALL EKKQSLV(RTCOD,DSPACE,1,1)
IF (RTCOD.GT.0) CALL CHKRT('EKKQSLV',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
No input data is required to run this program.
C***********************************************************************
C
C EXQPAR
C
C This program solves a parametric quadratic program.
C The perturbation vectors perturb only the variable costs.
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,PERTLEN,I,INDX1,INDX2
PARAMETER (MAXSPC=100000)
REAL*8 DSPACE(MAXSPC),L,U
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. Minimum of 5 blocks are needed for QP.
CALL EKKDSCM(RTCOD,DSPACE,1,5)
IF (RTCOD.GT.0) CALL CHKRT('EKKDSCM',RTCOD)
C
C Read linear model data from MPS file on unit 98.
CALL EKKMPS(RTCOD,DSPACE,98,2,0)
IF (RTCOD.GT.0) CALL CHKRT('EKKMPS ',RTCOD)
C
C Read quadratic matrix from file on unit 10.
CALL EKKQMPS(RTCOD,DSPACE,10,2)
IF (RTCOD.GT.0) CALL CHKRT('EKKQMPS',RTCOD)
C
C Define the limits of the parametric adjustment vectors.
L = 0.0D0
U = 1.0D0
C
C Print information related to usage of dspace.
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 Get integer control variables.
CALL EKKIGET(RTCOD,DSPACE,OSLI,OSLILN)
IF (RTCOD.GT.0) CALL CHKRT('EKKIGET',RTCOD)
PERTLEN = INUMCOLS + INUMROWS
C
C Reserve some space in dspace for temporary data.
CALL EKKHIS(RTCOD,DSPACE,PERTLEN,INDX1)
IF (RTCOD.GT.0) CALL CHKRT('EKKHIS ',RTCOD)
INDX2=INDX1+INUMROWS
C
C DSPACE(INDX1) is the RHS parametric adjustment vector.
C DSPACE(INDX2) is the objective function parametric
C adjustment vector.
C
C Initialize the parametric adjustment vectors.
DO I=0,INUMROWS-1
DSPACE(INDX1+I) = 0.0D0
ENDDO
DO I=0,INUMCOLS-1
DSPACE(INDX2+I) = 0.1D0
ENDDO
C
C Print information related to usage of dspace.
CALL EKKSMAP(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKSMAP',RTCOD)
C
C Parametrically analyse a QP problem.
CALL EKKQPAR(RTCOD,DSPACE,DSPACE(INDX1),DSPACE(INDX2),L,U)
IF (RTCOD.GT.0) CALL CHKRT('EKKQPAR',RTCOD)
C
C Restore storage pointers.
CALL EKKPOPS(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKPOPS',RTCOD)
C
C Print information related to usage of dspace.
CALL EKKSMAP(RTCOD,DSPACE)
IF (RTCOD.GT.0) CALL CHKRT('EKKSMAP',RTCOD)
C
C Get real control variables.
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***********************************************************************
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 "Sample Quadratic Programming Model Data 1".
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 ]