simplx.txt

Numeric Programs

Procedure SIMPLX(var A:matrx2; M, N, MP, NP, M1, M2, M3:integer;
                      var ICASE:integer;var IZROV, IPOSV:array of integer);
Label 1,2,3,4;
const
    EPS  =0.000001;
var
    L1,L2,L3:array[0..100] of integer;
    K,I,NL1,NL2,IR,KP,M12,IP,IQ,KH:integer;   Q1,BMAX:real;
begin
    If M <> M1 + M2 + M3 Then
    begin
        ShowMessage(' Bad input constraint counts');
        Exit;
    end;
    NL1:=N;
    For K:=1 To N do
    begin
        L1[K]:=K;
        IZROV[K]:=K;
    end; 
    NL2:=M;
    For I:=1 To M do
    begin
        If A[I + 1, 1] < 0  Then
        begin
            ShowMessage('Bad input tableau.');
            Exit;
        End;
        L2[I]:=I;
        IPOSV[I]:=N + I;
    end;
    For I:=1 To M2 do
        L3[I]:=1;
    IR:=0;
    If M2 + M3 = 0 Then GoTo 3;
    IR:=1;
    For K:=1 To N + 1 do
    begin
        Q1:=0;
        For I:=M1 + 1 To M do
            Q1:=Q1 + A[I + 1, K];
        A[M + 2, K]:=-Q1;
    end;
    repeat
        SIMP1(A, MP, NP, M + 1, L1, NL1, 0, KP, BMAX);
        If (BMAX <= EPS) And (A[M + 2, 1] < -EPS) Then
        begin
          ICASE:=-1;
          Exit;
        end
        Else If (BMAX <= EPS) And (A[M + 2, 1] <= EPS) Then
        begin
          M12:=M1 + M2 + 1;
          If M12 <= M Then
          begin
              For IP:=M12 To M do
              begin
                  If IPOSV[IP] = IP + N Then
                  begin
                      SIMP1(A, MP, NP, IP, L1, NL1, 1, KP, BMAX);
                      If BMAX > 0  Then GoTo 1;
                  end;
              end;
          end;
          IR:=0;
          M12:=M12 - 1;
          If M1 + 1 > M12 Then Exit;
          For I:=M1 + 1 To M12 do
          begin
              If L3[I - M1] = 1 Then
              begin
                  For K:=1 To N + 1 do
                      A[I + 1, K]:=-A[I + 1, K];
              end;
          end;
          goto 3;
        end;
        SIMP2(A, M, N, MP, NP, L2, NL2, IP, KP, Q1);
        If IP = 0 Then
        begin
          ICASE:=-1;
          Exit;
        end;
1:      SIMP3(A, MP, NP, M + 1, N, IP, KP);
        If IPOSV[IP] >= N + M1 + M2 + 1 Then
        begin
          For K:=1 To NL1 do
              If L1[K] = KP Then goto 4;
4:        NL1:=NL1 - 1;
          For IQ:=K To NL1 do
              L1[IQ]:=L1[IQ + 1];
        end
        Else
        begin
          If IPOSV[IP] < N + M1 + 1 Then GoTo 2;
          KH:=IPOSV[IP] - M1 - N;
          If L3[KH] = 0 Then GoTo 2;
          L3[KH]:=0;
        end;
        A[M + 2, KP + 1]:=A[M + 2, KP + 1] + 1;
        For I:=1 To M + 2 do
          A[I, KP + 1]:=-A[I, KP + 1];
2:      IQ:=IZROV[KP];
        IZROV[KP]:=IPOSV[IP];
        IPOSV[IP]:=IQ;
    until IR <> 0;
3:  SIMP1(A, MP, NP, 0, L1, NL1, 0, KP, BMAX);
    If BMAX <= 0  Then
    begin
        ICASE:=0;
        Exit;
    end;
    SIMP2(A, M, N, MP, NP, L2, NL2, IP, KP, Q1);
    If IP = 0 Then
    begin
        ICASE:=1;
        Exit;
    end;
    SIMP3(A, MP, NP, M, N, IP, KP);
    GoTo 2;
end;