unit Unit2;
interface
type
 Tmatrix=array of array of Real;
 procedure Permition(k,n:integer;var a:Tmatrix;var p:integer);//перестановка строк
 procedure Determinate(n:integer;var det:real;var a:tmatrix); //определитель
 procedure Additional(n:integer;d:tmatrix;var det1:real);//дополнения
 Procedure Matrixadd(n:integer;b:Tmatrix;var e:Tmatrix);//матрица алгебраических дополнений
 function Sign(p:integer):integer;//знак при перестановке строк
 function Sign1(i,m:integer):integer;//знак дополнения
implementation
 
procedure Permition(k,n:integer;var a:Tmatrix;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-1 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-1 do
   begin
     z:=a[i,j];a[i,j]:=a[k,j];a[k,j]:=z;
   end;
end;
 
procedure Determinate(n:integer;var det:real;var a:tmatrix);
var k,i,j,p:integer;r:real;
begin
  det:=1.0;
  for k:=0 to n-1 do
  begin
    if a[k,k]=0 then Permition(k,n,a,p);
    det:=sign(p)*det*a[k,k];
    for j:=k+1 to n-1 do
    begin
      r:=a[j,k]/a[k,k];
      for i:=k to n-1 do
       begin
        a[j,i]:=a[j,i]-r*a[k,i];
      end;
    end;
  end;
end;
 
procedure Additional(n:integer;d:tmatrix;var det1:real);
var i,j,p,k:integer;
r:real;
begin
  det1:=1.0;
  for i:=1 to n-1 do
   begin
     Permition(i,n,d,p);
     det1:=sign(p)*det1*d[i,i];
     for j:=i+1 to n-1 do
    begin
      r:=d[j,i]/d[i,i];
      for k:=i to n-1 do
      begin
        d[j,k]:=(d[j,k]-r*d[i,k]);
      end;
    end;
  end;
end;
 
Procedure Matrixadd(n:integer;b:Tmatrix;var e:Tmatrix );
var i,m,k,j:integer;z,det1:real;d,c:Tmatrix;
begin
  Setlength(c,n,n);
  Setlength(d,n,n);
  for i:=0 to n-1 do begin
  for m:=0 to n-1 do begin
  for j:=0 to n-1 do  //перестановка строки
  begin
    z:=b[i,j];
    for k:=i downto 1 do
     begin
       d[k,j]:=b[k-1,j];end;
       for k:=i+1 to n-1 do
       begin
         d[k,j]:=b[k,j];
       end;
       d[0,j]:=z;
     end;
   for k:=0 to n-1 do  //перестановка столбца
    begin
     z:=d[k,m];
     for j:=m downto 1 do
    begin
      c[k,j]:=d[k,j-1];
    end;
    for j:=m+1 to n-1 do
    begin
      c[k,j]:=d[k,j];
    end;
  c[k,0]:=z;
  end;
  Additional(n,c,det1);
  e[i,m]:=(det1)*sign1(i,m);
 end;
 end;
end;
 
function Sign(p:integer):integer;
begin
  if p mod 2=0 then
  result:=1 else result:=-1;
end;
 
function Sign1(i,m:integer):integer;
begin
  if (i+m) mod 2=0 then
  result:=1 else result:=-1;
end;
end.