Решение матриц по теореме Гаусса

program variant27;
 
type mat=array[1..5,1..6] of real;
vec=array[1..5] of real;
var i,j,k,n,k1,n1:integer; s,r:real; {Реальное число уравнений}
a:mat; x:vec;
var f:text;
 
begin
Write('Введите число уравнений N = '); readln(n);
assign(f,'mat.txt'); {имя файла данных на диске}
reset(f);
for i:=1 to n do
      begin      
        for j:=1 to n+1 do read(f,a[i,j]);   
        readln(f);
        end;
close(f);
        begin
          n1:=n+1;
          for k:=1 to n do
                 begin
                    k1:=k+1;
                    s:=a[k,k];j:=k;
                    for i:=k1 to n do
                        begin
                           r:=a[i,k]; 
                           if abs(r)>abs(s) then
                               begin
                                  s:=r; j:=i;
                               end;
                        end;
     
                    if s=0 then
                           begin
                             writeln('Переставьте уравнения чтобы на главной диагонали не было нулевых коэффициентов !');
                             halt;
                           end;
                    if j<>k then
                    for i:=k to n+1 do
                           begin
                              r:=a[k,i]; a[k,i]:=a[j,i];a[j,i]:=r;
                           end;
                    for j:=k1 to n1 do a[k,j]:=a[k,j]/s;
                    for i:=k1 to n do
                          begin
                             r:=a[i,k];
                             for j:=k1 to n1 do
                             a[i,j]:=a[i,j]-a[k,j]*r;
                          end;
               end;
          if s<>0 then
          for i:=n downto 1 do
                 begin s:=a[i,n1];
                     for j:=i+1 to n do s:=s-a[i,j]*x[j];
                     x[i]:=s;
                 end;
       end;
 
  begin
     Write('Введите число уравнений N = '); readln(n);
     assign(f,'mat.txt'); {имя файла данных на диске}
     reset(f);
     for i:=1 to n do
           begin
              for j:=1 to n1 do read(f,a[i,j]);
              readln(f);
           end;
  close(f);
  for i:=1 to n do
  writeln('X[,i,]=',X[i]);
  writeln('Проверка:');
  for i:=1 to n do
       begin
          s:=0;
          for j:=1 to n do s:=s+a[i,j]*X[j];
          write('Уравнение ',i,' ',s,' = ',a[i,n+1]);
          writeln(' Погрешность ',
          abs((s-a[i,n+1])/s));
      end;
  end;
End.

assign(f,'mat.txt'); {имя файла данных на диске}
reset(f);
read(f,n);
for i:=1 to n do
 begin
  for j:=1 to n+1 do
   begin
    read(f,a[i,j]);
    write(a[i,j]:6:2);
   end;
  writeln;
 end;
close(f);

program lab4;
uses crt;
const nmax=10;//макс кол уравнений
      e=0.001; //точность
var t:text;
    m,m1:array[1..nmax,1..nmax] of real;
    x,y:array[1..nmax] of real;
    n,i,j,k:integer;
    c,d:real;
    f:boolean;
begin
assign(t,'mat.txt');
reset(t);
read(t,n);
writeln('Коэффициенты уравнений:');
for i:=1 to n do
 begin
  for j:=1 to n+1 do
   begin
    read(t,m[i,j]);
    if j<=n then  write(m[i,j]:6:2)
    else write(m[i,j]:8:2);
   end;
  writeln;
 end;
close(t);
writeln;
m1:=m;  //запомним
for k:=1 to n-1 do
 begin
  if m[k,k]=0 then //если главный элемент=0
  for i:=k+1 to n do //то обмениваем строки
  if m[i,k]<>0 then
   begin
    for j:=1 to n+1 do
     begin
      c:=m[k,j];
      m[k,j]:=m[i,j];
      m[i,j]:=c;
     end;
    break;
   end;
  for i:=k+1 to n do //приводим к треугольному виду
   begin
    c:=-m[i,k]/m[k,k];
    for j:=1 to n+1 do
    m[i,j]:=m[i,j]+c*m[k,j];
   end;
 end;
for k:=n downto 2 do  //обратный ход
for i:=k-1 downto 1 do
 begin
  c:=-m[i,k]/m[k,k];
  for j:=1 to n+1 do
  m[i,j]:=m[i,j]+c*m[k,j];
 end;
for k:=1 to n do
  begin
   x[k]:=m[k,n+1]/m[k,k];
   writeln('x',k,'=',x[k]:0:3);
  end;
writeln('Проверка:');
f:=true;
for i:=1 to n do
 begin
  y[i]:=0;
  for j:=1 to n do
  y[i]:=y[i]+m1[i,j]*x[j];
  writeln('y[',i,']=',y[i]:0:2,' погрешность=',abs(m1[i,n+1]-y[i])/abs(m1[i,n+1]):0:4);
  if abs(m1[i,n+1]-y[i])>e then f:=false;
 end;
if f then writeln('Система решена верно!')
else writeln('Система решена не верно!');
end.