FORTRAN Program For the Simplex Method
This program was written for educational purposes not for efficiency.
For instance, it shows all the intermediate matrices in the Simplex Process.
It also uses the compact tableau, which is easier to explain
! Last change: SD 10 Apr 2002 7:08 pm
MODULE SUBS
CONTAINS
!----------------------------------------------------------------------!
! !
! If the problem is to minimize the objective function, this !
! subroutine prepares the tableau by introducing the penalty costs. !
! !
!----------------------------------------------------------------------!
SUBROUTINE MINPREP (M, N, A, X, Y, ARTROW, PENVAL)
IMPLICIT NONE
INTEGER, INTENT(IN):: ARTROW, M, N
REAL, DIMENSION(1:13,1:13), INTENT(IN OUT):: A
REAL, DIMENSION(1:13), INTENT(IN):: PENVAL
CHARACTER(LEN=4), DIMENSION(1:13), INTENT(IN OUT):: X, Y
CHARACTER(LEN=4):: HOLD
CHARACTER(LEN=1):: HYP
INTEGER:: I, J
HYP = '-'
DO I = ARTROW, M
DO J = 2,N
A(2,J) = A(2,J) + PENVAL(I)*A(I,J)
END DO
END DO
DO J = 2,N
A(2,J) = -A(2,J)
END DO
HOLD = X(2)
X(2) = HYP//HOLD
RETURN
END SUBROUTINE MINPREP
!-----------------------------------------------------------------------!
! !
! Subroutine to do the standard MAX problem. The standard MIN problem !
! also uses this routine after being prepared by introduction of !
! the penalty costs. !
! !
!-----------------------------------------------------------------------!
SUBROUTINE STANMAXPROB (M, N, A, X, Y)
IMPLICIT NONE
REAL, DIMENSION(1:13,1:13), INTENT(IN OUT):: A
CHARACTER(LEN=4), DIMENSION(1:13), INTENT(IN OUT):: X, Y
INTEGER, INTENT(IN):: M, N
CHARACTER(LEN=1):: CC, EXTX
CHARACTER(LEN=6):: EXTY
CHARACTER(LEN=10):: LINE, BLANK
INTEGER:: PROW, PCOL, I, J, LINCNT
OPEN (UNIT = 2, FILE = 'outtabl.dat', STATUS = 'UNKNOWN')
LINCNT = 0
EXTY = ' '
EXTX = ' '
DO J = 1,10
LINE(J:J) = '-'
END DO
DO J = 1,10
BLANK(J:J) = ' '
END DO
BLANK(8:8) = '|'
DO
IF (LINCNT+2*M .LE. 60) THEN
CC = ' '
LINCNT = LINCNT + 2*M
ELSE
CC = ' '
LINCNT = 2*M
END IF
WRITE (2, '(A1, A9,12A10)') CC, (EXTY//Y(J), J = 1,N)
WRITE (2,'(1X, A9,12A10)') (LINE, J = 1,N)
DO I = 2,M
WRITE (2,'(1X, A7, "|", 12F10.2)' ) EXTX//X(I), (A(I,J), J=2,N)
WRITE (2,'(1X, A10)' ) BLANK
END DO
CALL PIVCOLUMN (M, N, A, PCOL)
IF (PCOL == -1) THEN
EXIT
END IF
CALL PIVROW (M, N, A, PCOL, PROW)
IF (PROW == -1) THEN
WRITE(2,*) 'Simplex algorithm has terminated. The objective'
WRITE(2,*) 'function is not optimizable.'
EXIT
END IF
WRITE (2,*)
WRITE (2,'(1X, "Pivot row",I3," Pivot column",I3)') PROW, PCOL
WRITE (2,*)
LINCNT = LINCNT + 3
CALL PIVOT (M, N, A, X, Y, PCOL, PROW)
END DO
RETURN
END SUBROUTINE STANMAXPROB
!----------------------------------------------------------------------!
! !
! Subroutine to find the pivot column. Once the components of the !
! gradient of the objective function are all negative, it returns the !
! value -1 as the pivot column which signals the main program that !
! the simplex routine is to terminate. !
! !
!----------------------------------------------------------------------!
SUBROUTINE PIVCOLUMN (M, N, A, PCOL)
IMPLICIT NONE
INTEGER, INTENT(IN):: M, N
REAL,DIMENSION(1:13, 1:13), INTENT(IN):: A
INTEGER, INTENT(OUT):: PCOL
INTEGER:: J
REAL:: X
PCOL = -1
X = 0.0
DO J = 3,N
IF (A(2,J) .GT. X) THEN
PCOL = J
X = A(2,J)
END IF
END DO
RETURN
END SUBROUTINE PIVCOLUMN
!-----------------------------------------------------------------------!
! !
! Subroutine to find the pivot row. If the objective function is not !
! optimizable, it returns the value -1 as the pivot row. !
! !
!-----------------------------------------------------------------------!
SUBROUTINE PIVROW (M, N, A, PCOL, PROW)
IMPLICIT NONE
INTEGER, INTENT(IN):: M, N, PCOL
INTEGER, INTENT(OUT):: PROW
REAL, DIMENSION(1:13, 1:13), INTENT(IN):: A
INTEGER:: I
REAL:: X, XMIN
PROW = -1
XMIN = 1.0E23
DO I = 3, M
IF (A(I,PCOL) < 0.0) THEN
X = -A(I,2)/A(I,PCOL)
IF (X .LT. XMIN) THEN
PROW = I
XMIN = X
END IF
END IF
END DO
RETURN
END SUBROUTINE PIVROW
!----------------------------------------------------------------------!
! !
! Subroutine to do the pivot operation. !
! !
!----------------------------------------------------------------------!
SUBROUTINE PIVOT (M, N, A, X, Y, PCOL, PROW)
IMPLICIT NONE
INTEGER, INTENT(IN):: M, N, PCOL, PROW
REAL,DIMENSION(1:13,1:13),INTENT(IN OUT):: A
CHARACTER(LEN=4),DIMENSION(1:13),INTENT(IN OUT):: X
CHARACTER(LEN=4),DIMENSION(1:13),INTENT(IN OUT):: Y
REAL,DIMENSION(1:13,1:13):: B
CHARACTER(LEN=4):: HOLD
INTEGER:: I, J
DO I = 2,M
DO J = 2,N
B(I,J) = A(I,J) - (A(I,PCOL)*A(PROW,J))/A(PROW,PCOL)
END DO
END DO
DO J = 2, N
B(PROW,J) = -A(PROW,J)/A(PROW,PCOL)
END DO
DO I = 2, M
B(I,PCOL) = A(I,PCOL)/A(PROW,PCOL)
END DO
B(PROW,PCOL) = 1/A(PROW,PCOL)
HOLD = X(PROW)
X(PROW) = Y(PCOL)
Y(PCOL) = HOLD
DO I = 2, M
DO J = 2, N
A(I,J) = B(I,J)
END DO
END DO
RETURN
END SUBROUTINE PIVOT
END MODULE SUBS
!-----------------------------------------------------------------------!
! !
! LINEAR PROGRAMMING BY THE SIMPLEX METHOD !
! !
! Solves both the standard MAX and standard MIN problems. !
! Read file instr.dat for setup instructions. !
! !
! by J R Nanney Reprogrammed in f90 7/29/98 !
! Reprogrammed for Lahey Essential f90 March 2000 !
! Reprogrammed with MODULE April 2002 !
!-----------------------------------------------------------------------!
PROGRAM LINPROG
USE SUBS
IMPLICIT NONE
INTEGER:: ARTROW, IANS, M, N, MODE, I, J
REAL, DIMENSION(1:13, 1:13):: A
REAL, DIMENSION(1:13):: PENVAL
CHARACTER(LEN=4), DIMENSION(1:13):: X, Y
DO I = 1,50
WRITE (*,*)
END DO
WRITE(*,*) 'This program does linear programming by the simplex'
WRITE(*,*) 'method, both the standard MAX and standard MIN '
WRITE(*,*) 'procedures. If you need instructions, stop execution'
WRITE(*,*) ' and read the file instr.dat.'
OPEN (UNIT = 1, FILE = 'intabl.dat', STATUS = 'OLD')
READ (1,*) M, N, MODE
READ (1,*) (Y(J), J = 1, N)
DO I = 2, M
READ (1,*) X(I), (A(I,J), J = 2, N)
END DO
IF (MODE == 1) THEN
READ (1,*) ARTROW
DO I = ARTROW, M
READ (1,*) PENVAL(I)
END DO
CALL MINPREP (M, N, A, X, Y, ARTROW, PENVAL)
END IF
CALL STANMAXPROB (M, N, A, X, Y)
STOP
END PROGRAM LINPROG