Найти обратную матрицу (Pascal)

{Нахождение определителя}
if n=2 then
 begin
  det:=mat1[1,1]*mat1[2,2]-mat1[1,2]*mat1[2,1];
 end;
 det:=1;
 repeat
  if mat1[1,1]=0 then  {если первый элемент 0}
   begin
    k:=0;
    for i:=1 to n do {найдем ненулевой элемент в столбце}
    if mat1[i,1]<>0 then k:=i;
    for j:=1 to n do {перестановим строки}
     begin
      buf:=mat1[1,j];
      mat1[1,j]:=mat1[k,j];
      mat1[k,j]:=buf;
     end;
    det:=(-1)*det; {поменяли знак определителя}
    if k=0 then
     begin
      det:=0;
     end; {если нет в столбце det=0}
   end;
   det:=mat1[1,1]*det; {умножаем определитель на первый элемент}
   buf:=mat1[1,1];{делим первый столбец на первый элемент}
   for i:=1 to n do
   mat1[i,1]:=mat1[i,1]/buf;
   {найдем определитель n-1}
   n:=n-1;
   for i:=1 to n do
   for j:=1 to n do
   mat11[i,j]:=mat1[i+1,j+1]-mat1[i+1,1]*mat1[1,j+1];
   for i:=1 to n do
   for j:=1 to n do
   mat1[i,j]:=mat11[i,j];
  until n=2;
 det:=det*(mat1[1,1]*mat1[2,2]-mat1[1,2]*mat1[2,1]);
writeln('det=',det:8:3);
readkey;
end.

det := 1;
while (n > 2) do
begin
  if mat1[1,1]=0 then  {если первый элемент 0}
   begin
    k:=0;
    for i:=1 to n do {найдем ненулевой элемент в столбце}
    if mat1[i,1]<>0 then k:=i;
    for j:=1 to n do {перестановим строки}
     begin
      buf:=mat1[1,j];
      mat1[1,j]:=mat1[k,j];
      mat1[k,j]:=buf;
     end;
    det:=(-1)*det; {поменяли знак определителя}
    if k=0 then
     begin
      det:=0;
     end; {если нет в столбце det=0}
   end;
   det:=mat1[1,1]*det; {умножаем определитель на первый элемент}
   buf:=mat1[1,1];{делим первый столбец на первый элемент}
   for i:=1 to n do
   mat1[i,1]:=mat1[i,1]/buf;
   {найдем определитель n-1}
   n:=n-1;
   for i:=1 to n do
   for j:=1 to n do
   mat11[i,j]:=mat1[i+1,j+1]-mat1[i+1,1]*mat1[1,j+1];
   for i:=1 to n do
   for j:=1 to n do
   mat1[i,j]:=mat11[i,j];
end
det:=det*(mat1[1,1]*mat1[2,2]-mat1[1,2]*mat1[2,1]);

const
  NMAX = 4;

type
  Tmatr =  array[1..NMAX, 1..NMAX] of real;

const
  mat: Tmatr = ((8, 4, 9, 2),
                (3, 7, 4, 5),
                (3, 6, 9, 8),
                (1, 1, 4, 1));

var
  mat1: Tmatr;
  n, i, j, k, current: integer;
  det, buf: real;

BEGIN
  mat1 := mat;
  n := 4;
  det:=1;
  current := 1;
  while(n > current) do
  begin
    if mat1[current, current]=0 then
    begin
      k:=0;
      for i:=current to n do
        if mat1[i,current] <> 0 then k:=i;
      if k=0 then
      begin
        det:=0;
        break;
      end;
      for j:=current to n do
      begin
        buf:=mat1[current,j];
        mat1[current,j]:=mat1[k,j];
        mat1[k,j]:=buf;
      end;
      det:=(-1)*det;
    end;
    for i:=current+1 to n do
    begin
      buf := mat1[i, current] / mat1[current, current];
      for j:=current to n do
        mat1[i,j]:=mat1[i,j]-buf*mat1[current,j];
    end;
    current := current + 1;
  end;
  for i := 1 to n do
    det := det * mat1[i,i];
  for i := 1 to n do
  begin
    for j := 1 to n do
      write(mat1[i,j]:10:3, ', ');
    writeln;
  end;
  writeln('det=',det:8:3);
end.

for i:=1 to n do {найдем ненулевой элемент в столбце}
    if mat1[i,1]<>0 then k:=i;
    for j:=1 to n do {перестановим строки}
     begin
      buf:=mat1[1,j];
      mat1[1,j]:=mat1[k,j];
      mat1[k,j]:=buf;
     end;
    det:=(-1)*det; {поменяли знак определителя}
    if k=0 then
     begin
      det:=0;
     end; {если нет в столбце det=0}

const
  NMAX = 4;

type
  Tmatr =  array[1..NMAX, 1..NMAX] of real;

const
  mat: Tmatr = ((8, 4, 9, 2),
                (3, 7, 4, 5),
                (3, 6, 9, 8),
                (1, 1, 4, 1));

var
  mat1: Tmatr;

for i:=current+1 to n do
    begin
      buf := mat1[i, current] / mat1[current, current];
      for j:=current to n do
        mat1[i,j]:=mat1[i,j]-buf*mat1[current,j];
    end;

unit matr;
{------------------------------------------}
INTERFACE
{------------------------------------------}
uses crt;
type mat1=array[1..10,1..10] of real;
     t1=array[1..10,1..10] of real;
procedure enter_matrix(var n:integer;var mat:mat1);{ввод матрицы}
procedure output_matrix(n:integer;mat:mat1);{Вывод матрицы}
function determinante(n:integer; mat:mat1):real;{Нахождение определителя}
{function determinante_v1(mat3:mat1):real;{второй способ нахождения определителя}
{procedure fort_MINOR(n:integer; a:mat1); {миноры на главной диагонали}
procedure bermuda(var nt,vt,d:mat1; n:integer);{Разбиение матрицы на 2 треугольные}
procedure ont(n:integer; var mat,obnt:mat1);{нахождение обратной нижней треугольной матрицы}
procedure ovt(n:integer; var mat,obvt:mat1);{нахождение обратной верхней треугольной матрицы}
procedure multi_matrix(n:integer; m1,m2:mat1; var mm:mat1);{произведение матриц}
{-------------------------------------------}
IMPLEMENTATION
{-------------------------------------------}
procedure enter_matrix(var n:integer;var mat:mat1);{ввод матрицы}
var i,j:integer;
begin
 clrscr;
 write('Введите порядок матрицы n=');
 readln(n);
 for i:=1 to n do
  begin
   for j:=1 to n do
    begin
     write('a[',i,',',j,']=');
     read(mat[i,j]);
    end;
   writeln;
  end;
end;

procedure output_matrix(n:integer;mat:mat1);{Вывод матрицы}
var i,j:integer;
begin
 for i:=1 to n do
  begin
   for j:=1 to n do
    begin
     write(mat[i,j]:5:5);
     write('   ');
    end;
   writeln;
  end;
 writeln;
end;

function determinante(n:integer; mat:mat1):real;{Нахождение определителя}
var k,i,j:integer;
    buf,det:real;
    mat11:mat1;
begin
i:=1;
j:=1;
if n=1 then det:=mat[i,j]
else begin
if n=2 then det:=mat[1,1]*mat[2,2]-mat[1,2]*mat[2,1]
else
  begin
   det:=1;
  while (n>2) do
  begin
  if mat[1,1]=0 then  {если первый элемент 0}
   begin
    k:=0;
    for i:=1 to n do {найдем ненулевой элемент в столбце}
    if mat[i,1]<>0 then k:=i;
   {if k=0 then halt;} {при к=0 надо прекратить приведение матрицы, а то потом вылезет деление на 0}
    for j:=1 to n do {перестановим строки}
     begin
      buf:=mat[1,j];
      mat[1,j]:=mat[k,j];
      mat[k,j]:=buf;
     end;
    det:=(-1)*det; {поменяли знак определителя}
    if k=0 then
     begin
      det:=0;
     end; {если нет в столбце det=0}
   end;
   det:=mat[1,1]*det; {умножаем определитель на первый элемент}
   buf:=mat[1,1];{делим первый столбец на первый элемент}
   for i:=1 to n do
   mat[i,1]:=mat[i,1]/buf;
   {найдем определитель n-1}
   n:=n-1;
   for i:=1 to n do
   for j:=1 to n do
   mat11[i,j]:=mat[i+1,j+1]-mat[i+1,1]*mat[1,j+1];
   for i:=1 to n do
   for j:=1 to n do
   mat[i,j]:=mat11[i,j];
 end;
 det:=det*(mat[1,1]*mat[2,2]-mat[1,2]*mat[2,1]);
end;
end;
determinante:=det;
end;

procedure bermuda(var nt,vt,d:mat1; n:integer);{Разбиение матрицы на 2 треугольные}
var i,j,k:integer;
    s:real;
begin
 for i:=1 to n do
  begin
   nt[i,1]:=d[i,1];
   vt[i,1]:=0;
  end;
 for j:=1 to n do
  begin
   vt[1,j]:=d[1,j]/nt[1,1];
   if j>1 then nt[1,j]:=0;
  end;
 for i:=2 to n do
  for j:=2 to n do
   begin
    if i>=j then
     begin
      s:=0;
      for k:=1 to j-1 do
       s:=s+nt[i,k]*vt[k,j];
      nt[i,j]:=d[i,j]-s;
      vt[i,j]:=0;
      if i=j then vt[i,j]:=1;
     end
    else
     begin
      s:=0;
      for k:=1 to i-1 do
       s:=s+nt[i,k]*vt[k,j];
      vt[i,j]:=(d[i,j]-s)/nt[i,i];
      nt[i,j]:=0;
     end;
   end;
end;

procedure ont(n:integer; var mat,obnt:mat1);{нахождение обратной нижней треугольной матрицы}
var i,j,a:integer;
    s:real;
begin
 for i:=1 to n do
  begin
   for j:=1 to n do
    begin
     if i=j then obnt[i,j]:=1/mat[i,j];
     if i<j then obnt[i,j]:=0;
     if i>j then
      begin
       s:=0;
       for a:=j to i-1 do
        begin
         s:=s+mat[i,a]*obnt[a,j];
         obnt[i,j]:=-1*s/mat[i,i];
        end;
      end;
    end;
  end;
end;

procedure ovt(n:integer; var mat,obvt:mat1);{нахождение обратной верхней треугольной матрицы}
var i,j,a:integer;
    s:real;
begin
 for i:=n downto 1 do
  begin
   for j:=1 to n do
    begin
     if i>=j then obvt[i,j]:=mat[i,j];
     if j=i+1 then obvt[i,j]:=-mat[i,j];
     if j>i+1 then
      begin
       s:=0;
       for a:=i+1 to j-1 do
        begin
         s:=s+mat[i,a]*obvt[a,j];
         obvt[i,j]:=-1*(mat[i,j]+s);
        end;
      end;
    end;
  end;
end;

procedure multi_matrix(n:integer; m1,m2:mat1; var mm:mat1);{произведение матриц}
var i,j,a:integer;
    x:real;
begin
 for i:=1 to n do
  for j:=1 to n do
   begin
    x:=0;
     for a:=1 to n do x:=x+m1[i,a]*m2[a,j];
     mm[i,j]:=x;
   end;
end;
end.

program l1; {нахождение обратной матрицы}
uses crt,matr;
var a1,nt,vt,a2,obnt1,obvt1,oa1,edin:mat1;
    n,i,j,u:integer;
    fm:boolean;
    det:real;
begin
 clrscr;
 enter_matrix(n,a1);
 clrscr;
 writeln('Дана матрица');
 output_matrix(n,a1);
 fm:=true;
 for u:=1 to n do
  begin
   if determinante(u,a1)=0 then fm:=false;
   {writeln(determinante(u,a1):5:5);}
  end;
 if fm=true then
  begin
   bermuda(nt,vt,a1,n);
   writeln('Верхняя треугольная матрица:');
   output_matrix(n,vt);
   writeln('Нижняя треугольная матрица:');
   output_matrix(n,nt);
   readkey;
   clrscr;
   writeln('Верхняя треугольная матрица:');
   output_matrix(n,vt);
   writeln('Нижняя треугольная матрица:');
   output_matrix(n,nt);
   ont(n,nt,obnt1);
   writeln('Обратная нижняя треугольная матрица:');
   output_matrix(n,obnt1);
   ovt(n,vt,obvt1);
   writeln('Обратная верхняя треугольная матрица:');
   output_matrix(n,obvt1);
   readkey;
   clrscr;
   writeln('Дана матрица');
   output_matrix(n,a1);
   multi_matrix(n,obvt1,obnt1,oa1);
   writeln('Обратная матрица:');
   output_matrix(n,oa1);
   multi_matrix(n,a1,oa1,edin);
   writeln('Проверка:');
   output_matrix(n,edin);
  end
 else writeln('Данную матрицу нельзя разбить на треугольные');
readkey;
end.

uses crt,matr;
var a1,a,nt,vt,a2,obnt1,obvt1,oa1,edin:mat1;
    n,i,j,u,x,l:integer;
    fm:boolean;
    det,buf,z:real;
begin
 clrscr;
 enter_matrix(n,a1);
 clrscr;
 writeln('Дана матрица');
 output_matrix(n,a1);
 fm:=true;
 for i:=1 to n do
 for j:=1 to n do
 a1[i,j]:=a[i,j];
 x:=0;
 if a1[1,1]=0 then
  begin
   for i:=1 to n do
   if a1[i,1]<>0 then x:=i;
   for i:=1 to n do
    begin
     buf:=a1[1,i];
     a1[1,i]:=a1[x,i];
     a1[x,i]:=buf;
    end;
   end
 else
 for u:=1 to n do
  begin
   if determinante(u,a1)=0 then fm:=false;
   writeln(determinante(u,a1):5:5);
  end;
 if fm=true then
  begin
   bermuda(nt,vt,a1,n);
   writeln('Верхняя треугольная матрица:');
   output_matrix(n,vt);
   writeln('Нижняя треугольная матрица:');
   output_matrix(n,nt);
   readkey;
   clrscr;
   writeln('Верхняя треугольная матрица:');
   output_matrix(n,vt);
   writeln('Нижняя треугольная матрица:');
   output_matrix(n,nt);
   ont(n,nt,obnt1);
   writeln('Обратная нижняя треугольная матрица:');
   output_matrix(n,obnt1);
   ovt(n,vt,obvt1);
   writeln('Обратная верхняя треугольная матрица:');
   output_matrix(n,obvt1);
   readkey;
   clrscr;
   writeln('Дана матрица');
   output_matrix(n,a1);
   multi_matrix(n,obvt1,obnt1,oa1);
   if a[1,1]=0 then
   begin
   for i:=1 to n do
   begin
   buf:=oa1[i,1];
   oa1[i,1]:=oa1[i,x];
   oa1[i,x]:=buf;
   end;
   end;
   writeln('Обратная матрица:');
   output_matrix(n,oa1);
   multi_matrix(n,a1,oa1,edin);
   writeln('Проверка:');
   output_matrix(n,edin);
  end
 else writeln('Данную матрицу нельзя разбить на треугольные');
readkey;
end.

unit matr;
{------------------------------------------}
INTERFACE
{------------------------------------------}
uses crt;
type mat1=array[1..10,1..10] of real;
     t1=array[1..10,1..10] of real;
procedure enter_matrix(var n:integer;var mat:mat1);{ввод матрицы}
procedure output_matrix(n:integer;mat:mat1);{Вывод матрицы}
function determinante(n:integer; mat:mat1):real;{Нахождение определителя}
{function determinante_v1(mat3:mat1):real;{второй способ нахождения определителя}
{procedure fort_MINOR(n:integer; a:mat1); {миноры на главной диагонали}
procedure bermuda(var nt,vt,d:mat1; n:integer);{Разбиение матрицы на 2 треугольные}
procedure ont(n:integer; var mat,obnt:mat1);{нахождение обратной нижней треугольной матрицы}
procedure ovt(n:integer; var mat,obvt:mat1);{нахождение обратной верхней треугольной матрицы}
procedure multi_matrix(n:integer; m1,m2:mat1; var mm:mat1);{произведение матриц}
procedure change_string(n,a,b:integer; var dm:mat1);{меняет строки, где a и b строки которые надо поменять местами}
procedure pre_work(n:integer; var dm1:mat1; var a:integer); {ищем то что надо менять}
{-------------------------------------------}
IMPLEMENTATION
{-------------------------------------------}
procedure enter_matrix(var n:integer;var mat:mat1);{ввод матрицы}
var i,j:integer;
begin
 clrscr;
 write('Введите порядок матрицы n=');
 readln(n);
 for i:=1 to n do
  begin
   for j:=1 to n do
    begin
     write('a[',i,',',j,']=');
     read(mat[i,j]);
    end;
   writeln;
  end;
end;

procedure output_matrix(n:integer;mat:mat1);{Вывод матрицы}
var i,j:integer;
begin
 for i:=1 to n do
  begin
   for j:=1 to n do
    begin
     write(mat[i,j]:5:5);
     write('   ');
    end;
   writeln;
  end;
 writeln;
end;

function determinante(n:integer; mat:mat1):real;{Нахождение определителя}
var k,i,j:integer;
    buf,det:real;
    mat11:mat1;
begin
i:=1;
j:=1;
if n=1 then det:=mat[i,j];
{else begin }
if n=2 then det:=mat[1,1]*mat[2,2]-mat[1,2]*mat[2,1]
else
  begin
   det:=1;
  {while (n>2) do}
  repeat
  {begin}
  if mat[1,1]=0 then  {если первый элемент 0}
   begin
    k:=0;
    for i:=1 to n do {найдем ненулевой элемент в столбце}
    if mat[i,1]<>0 then k:=i;
   {if k=0 then halt;} {при к=0 надо прекратить приведение матрицы, а то потом вылезет деление на 0}
    for j:=1 to n do {перестановим строки}
     begin
      buf:=mat[1,j];
      mat[1,j]:=mat[k,j];
      mat[k,j]:=buf;
     end;
    det:=(-1)*det; {поменяли знак определителя}
    if k=0 then
     begin
      det:=0;
     end; {если нет в столбце det=0}
   end;
   det:=mat[1,1]*det; {умножаем определитель на первый элемент}
   buf:=mat[1,1];{делим первый столбец на первый элемент}
   for i:=1 to n do
   mat[i,1]:=mat[i,1]/buf;
   {найдем определитель n-1}
   n:=n-1;
   for i:=1 to n do
   for j:=1 to n do
   mat11[i,j]:=mat[i+1,j+1]-mat[i+1,1]*mat[1,j+1];
   for i:=1 to n do
   for j:=1 to n do
   mat[i,j]:=mat11[i,j];
  until n=2;
 {end;}
 det:=det*(mat[1,1]*mat[2,2]-mat[1,2]*mat[2,1]);
end;
{end;}
determinante:=det;
end;

procedure bermuda(var nt,vt,d:mat1; n:integer);{Разбиение матрицы на 2 треугольные}
var i,j,k,x:integer;
    s,buf:real;
begin
 {if d[1,1]=0 then  {если первый элемент 0}
  { begin
    x:=0;
    for i:=1 to n do {найдем ненулевой элемент в столбце}
   { if d[i,1]<>0 then x:=i;
   {if x=0 then halt;} {при x=0 надо прекратить приведение матрицы, а то потом вылезет деление на 0}
    {for j:=1 to n do {перестановим строки}
     {begin
      buf:=d[1,j];
      d[1,j]:=d[x,j];
      d[k,j]:=buf;
     end;
     end;}
 for i:=1 to n do
  begin
   nt[i,1]:=d[i,1];
  {vt[i,1]:=0;}
  end;
 for j:=1 to n do
  begin
   vt[1,j]:=d[1,j]/nt[1,1];
   if j>1 then nt[1,j]:=0;
  end;
 for i:=2 to n do
  for j:=2 to n do
   begin
    if i>=j then
     begin
      s:=0;
      for k:=1 to j-1 do
       s:=s+nt[i,k]*vt[k,j];
      nt[i,j]:=d[i,j]-s;
      vt[i,j]:=0;
      if i=j then vt[i,j]:=1;
     end
    else
{добавление}
     if nt[i,i]=0 then begin writeln('Ну нельзя разбить!'); readkey; halt; end
      else
     begin
      s:=0;
      for k:=1 to i-1 do
       s:=s+nt[i,k]*vt[k,j];
      vt[i,j]:=(d[i,j]-s)/nt[i,i];
      nt[i,j]:=0;
     end;
   end;
end;

procedure ont(n:integer; var mat,obnt:mat1);{нахождение обратной нижней треугольной матрицы}
var i,j,a:integer;
    s:real;
begin
 for i:=1 to n do
  begin
   for j:=1 to n do
    begin
     if i=j then obnt[i,j]:=1/mat[i,j];
     if i<j then obnt[i,j]:=0;
     if i>j then
      begin
       s:=0;
       for a:=j to i-1 do
        begin
         s:=s+mat[i,a]*obnt[a,j];
         obnt[i,j]:=-1*s/mat[i,i];
        end;
      end;
    end;
  end;
end;

procedure ovt(n:integer; var mat,obvt:mat1);{нахождение обратной верхней треугольной матрицы}
var i,j,a:integer;
    s:real;
begin
 for i:=n downto 1 do
  begin
   for j:=1 to n do
    begin
     if i>=j then obvt[i,j]:=mat[i,j];
     if j=i+1 then obvt[i,j]:=-mat[i,j];
     if j>i+1 then
      begin
       s:=0;
       for a:=i+1 to j-1 do
        begin
         s:=s+mat[i,a]*obvt[a,j];
         obvt[i,j]:=-1*(mat[i,j]+s);
        end;
      end;
    end;
  end;
end;

procedure multi_matrix(n:integer; m1,m2:mat1; var mm:mat1);{произведение матриц}
var i,j,a:integer;
    x:real;
begin
 for i:=1 to n do
  for j:=1 to n do
   begin
    x:=0;
     for a:=1 to n do x:=x+m1[i,a]*m2[a,j];
     mm[i,j]:=x;
   end;
end;

procedure change_string(n,a,b:integer; var dm:mat1);{меняет строки, где a и b строки которые надо поменять местами}
var j:integer;
    buf:array[0..10] of real;
begin
 for j:=0 to n do
  begin
   buf[j]:=dm[a,j]; {где а, то что хотим поменять}
   dm[a,j]:=dm[b,j]; {где b, на что хотим поменять}
   dm[b,j]:=buf[j];
  end;
end;

procedure pre_work(n:integer; var dm1:mat1; var a:integer); {ищем то что надо менять}
begin
 a:=1;
 if dm1[1,1]=0 then
  begin
   while dm1[a,1]=0 do
    a:=a+1;
  end;
 change_string(n,a,1,dm1);
end;
end.

uses crt,matr;
var a1,a,nt,vt,a2,obnt1,b,obvt1,oa1,edin:mat1;
    n,i,j,u,k,x,y,z:integer;
    fm:boolean;
    det,buf1:real;
begin
 clrscr;
 enter_matrix(n,a1);
   for i:=1 to n do
    begin
     x:=0;
     for j:=1 to n do
      begin
       if a1[i,j]=0 then x:=x+1;
      end;
     if x=n then begin writeln('Данную матрицу нельзя разбить на треугольные'); readkey; halt; end;
    end;
   for i:=1 to n do
    begin
     y:=0;
     for j:=1 to n do
      begin
       if a1[j,i]=0 then y:=y+1;
      end;
     if y=n then begin writeln('Данную матрицу нельзя разбить на треугольные'); readkey; halt; end;
    end;
 clrscr;
 writeln('Дана матрица');
 output_matrix(n,a1);
 pre_work(n,a1,z);
      {for i:=1 to n do
      for j:=1 to n do
      a[i,j]:=a1[i,j];
      k:=0;
      if a1[1,1]=0 then
       begin
        for i:=1 to n do
         if a[i,1]<>0 then k:=i;
        for i:=1 to n do
         begin
          buf1:=a[1,i];
          a[1,i]:=a[k,i];
          a[k,i]:=buf1;
         end;
       end;}
 {fm:=true;
 for u:=2 to n do
  begin
   if determinante(u,a)=0 then fm:=false;
   {writeln(determinante(u,a1):5:5);}
 {end;
 if fm=true then}
  begin
   bermuda(nt,vt,a1,n);
   writeln('Верхняя треугольная матрица:');
   output_matrix(n,vt);
   writeln('Нижняя треугольная матрица:');
   output_matrix(n,nt);
   readkey;
   clrscr;
   writeln('Верхняя треугольная матрица:');
   output_matrix(n,vt);
   writeln('Нижняя треугольная матрица:');
   output_matrix(n,nt);
   ont(n,nt,obnt1);
   writeln('Обратная нижняя треугольная матрица:');
   output_matrix(n,obnt1);
   ovt(n,vt,obvt1);
   writeln('Обратная верхняя треугольная матрица:');
   output_matrix(n,obvt1);
   readkey;
   clrscr;
   writeln('Дана матрица');
   output_matrix(n,a1);
   multi_matrix(n,obvt1,obnt1,b);
        if a1[1,1]=0 then
         begin
          for i:=1 to n do
           begin
            buf1:=b[i,1];
            b[i,1]:=b[i,k];
            b[i,k]:=buf1;
           end;
         end;
   writeln('Обратная матрица:');
   output_matrix(n,b);
   multi_matrix(n,a1,b,edin);
   writeln('Проверка:');
   output_matrix(n,edin);
  end;
{ else writeln('Данную матрицу нельзя разбить на треугольные');}
readkey;
end.