Обратная матрица

uses crt;
const t=0.000001;{ограничиваем числа, близкие к нолю, на них делить}
type Tmatr=array[1..4,1..4]of real;
 
procedure Per(n,k:integer;a:Tmatr;var p:integer);{перестановка строк с макс. главным элементом}
var z:real;
    j,i:integer;
begin
z:=abs(a[k,k]);
i:=k;
p:=0;
for j:=k+1 to n do
  begin
    if abs(a[j,k])>z then
      begin
        z:=abs(a[j,k]);
        i:=j;
        p:=p+1;
      end;
  end;
if i>k then
for j:=k to n do
   begin
     z:=a[i,j];
     a[i,j]:=a[k,j];
     a[k,j]:=z;
   end;
end;
function znak(p:integer):integer;{изменение знака при перестановке строк матрицы}
begin
if p mod 2=0 then
znak:=1 else znak:=-1;
end;
function znak1(i,m:integer):integer;{изменение знака при перестановке строк при нахождении дополнений}
begin
if (i+m) mod 2=0 then
znak1:=1 else znak1:=-1;
end;
procedure opr(n,p:integer;a:Tmatr;var det:real;var f:byte);{нахождение определителя матрицы}
var k,i,j:integer;
    r:real;
begin
det:=1.0;f:=0;
for k:=1 to n do
   begin
     if a[k,k]=0 then per(k,n,a,p);
     det:=znak(p)*det*a[k,k];
     if abs(det)<t then
      begin
       f:=1;
       writeln('Обратной матрицы нет!');
       readln;
       exit;
      end;
     for j:=k+1 to n do
        begin
         r:=a[j,k]/a[k,k];
         for i:=k to n do
         a[j,i]:=a[j,i]-r*a[k,i];
        end;
   end;
end;
procedure opr1(n,p:integer;d:Tmatr;var det1:real);{нахождение определений для дополнений}
var k,i,j:integer;
    r:real;
begin
det1:=1.0;
for k:=2 to n do
   begin
     if d[k,k]=0 then per(n,k,d,p);
     det1:=znak(p)*det1*d[k,k];
     for j:=k+1 to n do
       begin
         r:=d[j,k]/d[k,k];
         for i:=k to n do
         d[j,i]:=d[j,i]-r*d[k,i];
       end;
   end;
end;
Procedure Peresch(n,p:integer;var b:Tmatr;det1:real;var e:Tmatr);{вычисление дополнений}
var i,m,k,j:integer;
    z:real;
    d,c:Tmatr;
begin
for i:=1 to n do
for m:=1 to n do
   begin
     for j:= 1 to n do {перестановка строк}
       begin
         z:=b[i,j];
         for k:=i downto 2 do
         d[k,j]:=b[k-1,j];
         for k:=i+1 to n do
         d[k,j]:=b[k,j];
         d[1,j]:=z;
       end;
     for k:=1 to n do {перестановка столбцов}
       begin
         z:=d[k,m];
         for j:=m downto 2 do
         c[k,j]:=d[k,j-1];
         for j:=m+1 to n do
         c[k,j]:=d[k,j];
         c[k,1]:=z;
       end;
     Opr1(n,p,c,det1);{вычисление определителей}
     e[i,m]:=det1*znak1(i,m);{вычисление дополнений}
   end;
end;
procedure Transp(a:Tmatr; n:integer;var at:Tmatr);{транспонирование матрицы}
var k,j:integer;
begin
for k:= 1 to n do
for j:=1 to n do
at[k,j]:=a[j,k];
end;
Procedure Proverka(a,b:Tmatr; n:integer;var c:Tmatr);{проверка - умножение прямой матрицы на обратную}
var k,j,i:integer;
    z:double;
begin
for k:=1 to n do
for j:=1 to n do
  begin
    c[k,j]:=0;
    for i:=1 to n do
      begin
        z:=a[i,j]*b[k,i];
        c[k,j]:=c[k,j]+z;
      end;
   end;
end;
procedure Vyvod(var a:Tmatr; n:integer);{вывод матриц на экран}
var k,j:integer;
begin
for k:=1 to n do
  begin
    for j:=1 to n do
    write(a[k,j]:7:2);
    writeln;
  end;
end;
var n,k,j,i,p:integer;{n-размер матрицы,k-счетчик по строкам,j-счетчик по столбцам,p-счетчик перестановок}
    a,at,b,c,e:Tmatr;{a-исходная, at-транспонированная, b-матрица дополнений, e-обратная, с-проверка}
    det,det1:real;{det-определитель исходной матрицы,det1-определители-дополнения}
    f:byte;{признак несуществования обратной матрицы}
begin
clrscr;
n:=4;
for k:=1 to n do
for j:=1 to n do
   begin
    write('a[',k,',',j,']=');
    readln(a[k,j]);
   end;
clrscr;
writeln('Исходная матрица:');
Vyvod(a,n);
Opr(n,p,a,det,f); {vychislenie opredelitelja}{считаем определитель}
if f=1 then exit;
Transp(a,n,b);  {транспонируем матрицу}
Peresch(n,p,b,det1,e);  {считаем дополнения}
writeln('Obratnaja matrica:');
for k:=1 to n do
for j:=1 to n do
e[k,j]:=e[k,j]/det; {создаем обратную матрицу}
Vyvod(e,n);
writeln('Proverka:');
Proverka(a,e,n,c);  {делаем проверку}
Vyvod(c,n);
readln
end.

const n=3;