home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l292 / 1.ddi / LSIMPLEX.FOR < prev    next >
Encoding:
Text File  |  1989-10-10  |  2.6 KB  |  96 lines
  1.  
  2.       SUBROUTINE simplex (constary, objary, rhsary, numrow, numcol,
  3.      +                    optsol, basisid, objfval)
  4.       INCLUDE 'STDHDR.FOR'
  5.       REAL constary(0:maxr, 0:maxc), objary(0:maxv), rhsary(0:maxv)
  6.       REAL optsol(0:maxv),objfval(0:maxv),workary(0: maxr, 0:maxc)
  7.       INTEGER basisid(0:maxc),numrow, numcol,maxcoefc,minratr
  8.       INTEGER strow, stcol, i, j
  9.       LOGICAL simpcrit1
  10.  
  11.       strow = numrow
  12.       stcol = numcol + numrow + 2
  13.  
  14.       DO i = 0, strow
  15.         DO j = 0, stcol - 1
  16.           workary(i, j) = 0.0
  17.         END DO
  18.       END DO
  19.  
  20.       DO i = 1, numrow
  21.         DO j = 1, numcol
  22.           workary(i, j) = constary(i - 1, j - 1)
  23.         END DO
  24.       END DO
  25.  
  26.       DO j = 1, numcol
  27.         workary(0, j) = -objary(j - 1)
  28.       END DO
  29.  
  30.       workary(0, 0) = 1.0
  31.  
  32.       DO i = 1, numrow
  33.         workary(i, i + numcol) = 1.0
  34.         workary(i, stcol - 1) = rhsary(i - 1)
  35.       END DO
  36.  
  37.       basisid(0) = 0
  38.       DO i = 1, numrow
  39.         basisid(i) = i + numcol
  40.       END DO
  41.  
  42.       simpcrit1 = .FALSE.
  43.       DO WHILE (simpcrit1 .EQV. .FALSE.)
  44.         maxcoef = workary(0, 0)
  45.         maxcoefc = 0.0
  46.         minrat = 99999999.0
  47.         minratr = 0
  48.         DO j = 0, stcol - 2
  49.           IF (workary(0,j) .LT. maxcoef .AND.
  50.      +        workary(0,j) .LT. 0) THEN
  51.             maxcoef = workary(0, j)
  52.             maxcoefc = j
  53.           END IF
  54.         END DO
  55.         DO i = 1, strow
  56.           IF (workary(i,stcol-1).GT.0 .AND.
  57.      +        workary(i,maxcoefc).GT.0) THEN
  58.               IF (workary(i,stcol-1)/workary(i,maxcoefc)
  59.      +           .LT. minrat) THEN
  60.                  minrat = workary(i, stcol - 1) / workary(i, maxcoefc)
  61.                  minratr = i
  62.               END IF
  63.            END IF
  64.         END DO
  65.         basisid(minratr) = maxcoefc
  66.  
  67.         coldiv = workary(minratr, maxcoefc)
  68.         DO j = 0, stcol - 1
  69.           workary(minratr, j) = workary(minratr, j) / coldiv
  70.         END DO
  71.  
  72.         DO i = 0, strow
  73.           IF (i .NE. minratr) THEN
  74.             pivot = -workary(i, maxcoefc)
  75.             DO j = 0, stcol - 1
  76.               workary(i, j) = workary(minratr, j)
  77.      +                         * pivot + workary(i, j)
  78.             END DO
  79.           END IF
  80.         END DO
  81.         simpcrit1 = .TRUE.
  82.         DO j = 0, stcol - 2
  83.           simpcrit1 = (workary(0, j) .GE. 0) .AND. simpcrit1
  84.         END DO
  85.       END DO
  86.       DO j = 0, numrow
  87.         optsol(j) = workary(j, stcol - 1)
  88.       END DO
  89.       DO j = 0, stcol - 2
  90.         objfval(j) = workary(0, j)
  91.       END DO
  92.  
  93.  
  94.       END !SUB simplex
  95.  
  96.