Здравствуйте, Семенов Алексей Анатольевич!
Код программы - в приложении. Программа работает с файлом input.txt
Привожу пример (то, что между **** и ****, сохранить в файл input.txt, который надо расположить в одной папке с экзэшником).
****
3
6
160 2 1 3 1 0 0
170 3 4 4 0 1 0
120 4 5 2 0 0 1
0 0 0
13 10 8 0 0 0
****
Это файл для решения следующей задачи
F=13x1+10x2+8x3 ->MAX
Ограничения:
2x1+x2+x3<=160
3x1+4x2+4x3<=170
4x1+5x2+2x3<=120


Вроде все
Рад был помочь

Приложение:
uses crt;
const
N1=5;
M1=12;
s=7;{для форматирования вывода}
k=2;
type
col=array[1..N1+1] of real;
row=array[0..M1] of real;
matr=array[1..N1+1] of row;
var
finp:text;{файл данных}
ifMax:boolean;
Ci:col;
Cj:row;
q:col; {симплекс-отношения}
a:matr;
n,m:integer;{array n*m}
i0,j0:integer;
stop:boolean;

procedure init;
var i,j:integer;
answer:char;
begin
clrscr;
write('Задача на максимум? (y/n)');
readln(answer);
ifMax:=answer='y';
stop:=false;
i0:=-1;
j0:=-1;
assign(finp,'input.pas');
reset(finp);
readln(finp,n);
readln(finp,m);
{write('Количество строк n=');
readln(n);
write('Количество столбцов м=');
readln(m);}
for i:=1 to n do
for j:=0 to m do
begin
{write('a[',i,',',j,']=');}
read(finp,a[i,j]);
end;
for i:=1 to n do
begin
{write('Ci[',i,']=');}
read(finp,Ci[i]);
end;
for j:=1 to m do
begin
{write('Cj[',j,']=');}
read(finp,Cj[j]);
end;
Cj[0]:=0;
close(finp);
end;

procedure countDj;{вычисление строки дельта j}
var i,j:integer;
s:real;
begin
for j:=0 to m do

begin
s:=0;
for i:=1 to n do
s:=s+a[i,j]*Ci[i];
a[n+1,j]:=s-Cj[j];
end;
end;

function findj0:integer;{поиск разрешающего столбца}
var j:integer;
j0tmp:integer;
mtmp:real;{max or min}
begin
j0tmp:=1;
if ifMax
then begin
for j:=2 to m do
if a[n+1,j]<a[n+1,j0tmp]
then j0tmp:=j;
if a[n+1,j0tmp]>=0
then stop:=true;
end
else begin
for j:=2 to m do
if a[n+1,j]>a[n+1,j0tmp]
then j0tmp:=j;
if a[n+1,j0tmp]<=0
then stop:=true;
end;
findj0:=j0tmp;
end;

function findi0:integer;{поиск разрешающей строки}
var i:integer;
i0tmp:integer;
procedure countq;{расчет симплексных отношений}
var i:integer;
begin
if stop
then
for i:=1 to n do
q[i]:=-1
else
for i:=1 to n do
if a[i,j0]<>0
then q[i]:=a[i,0]/a[i,j0]
else q[i]:=-1;

end;
Begin
countq;
i0tmp:=1;
while (q[i0tmp]<0) and (i0tmp<=n) do i0tmp:=i0tmp+1;
if i0tmp>n then stop:=true
else
for i:=1 to n do
if (q[i]>0) and (q[i]<q[i0tmp])
then i0tmp:=i;
findi0:=i0tmp;
End;

procedure showhead;{печать шапки таблицы}
var j:integer;
begin
clrscr;
write('Cj':s);
for j:=0 to m do
write(Cj[j]:s:0);
writeln('Симп.':s+2);
write('Ci ':s);
write('f':s);
for j:=1 to m do
write('x':s-1,j);
writeln('отн.':s);
end;

procedure show;{вывод таблицы}
var i,j:integer;
begin
for i:=1 to n+1 do
begin
if i=n+1
then
write('dj':s)
else
write(Ci[i]:s:0);
for j:=0 to m do
begin
if (i=i0) and(j=j0) then textColor(4);
write(a[i,j]:s:k);
textColor(7);
end;
if i<n+1 then write(q[i]:s+2:k);
writeln;
end;
end;
procedure newtable;{пересчет таблицы}
var i,j:integer;
begin
Ci[i0]:=Cj[j0];
for i:=1 to n do
for j:=0 to m do
if (i<>i0) and (j<>j0)
then a[i,j]:=a[i,j]-(a[i0,j]*a[i,j0])/a[i0,j0];
for j:=0 to m do
if j<>j0 then a[i0,j]:=a[i0,j]/a[i0,j0];
for i:=1 to n do
if i<>i0 then a[i,j0]:=0;
a[i0,j0]:=1;

end;
BEGIN
init;
showhead;
repeat
countDj;
j0:=findj0;
i0:=findi0;
show;
if not stop then newtable;
readln;
until stop;
writeln('Решение окончено. Press Enter');
readln;
END.