Запрограммировать нахождение коэффициентов характеристического уравнения методом Данилевского включая второй особый случай — Pascal(Паскаль)

program danilevski_2;

uses crt;

type mat1= array[1..10] of real;
     mat2= array[1..10,1..10] of real;

var a:array[1..10,1..10] of real;
    b:array[1..10,1..10] of real;
    c:array[1..10,1..10] of real;
    mm:array[1..10,1..10] of real;
    m:array[1..10,1..10] of real;
    g1,g2,g3,dt:mat1;
    k,i,j,n,mn,iii,l,yes,st1,st2,osob:integer;

label forend,sl1;

Function  ch(z:integer):integer;
var r1,r2,r3:real;
    z1,z2,cc:integer;
begin
    z1:=z DIV 2 ;
    if z/2=z1 then begin
    ch:=1; cc:=1;end
    else
    begin
    ch:=-1;
    cc:=-1;
    end;
end;

procedure multi;
var i,j:integer;
begin
  if mn=n then
    begin
    for i:=1 to st1 do g3[i]:=dt[i];
    st2:=st1;
    end
  else
    begin
    for i:=1 to st1 do g1[i]:=dt[i];
    for i:=1 to st2 do g2[i]:=g3[i];
    writeln;
    for i:=1 to n do g3[i]:=0;
    g1[st1+1]:=ch(st1);
    g2[st2+1]:=ch(st2);
    for i:=1 to st1+1 do
    for j:=1 to st2+1 do
    begin
    g3[i+j-1]:=g3[i+j-1]+g1[i]*g2[j];
    end;
    st2:=st1+st2;
    end
end;

begin
clrscr;

writeln('Введите размерность матрицы: ');
readln(n);


if n>9 then begin
 writeln('Больше девяти нельзя'); readln;end
else
begin

    writeln('Введите исходную матрицу A');
    for i:=1 to n do
    for j:=1 to n do begin
    write('a[',i,',',j,']:');
    readln(a[i,j])
    end;



    mn:=n; st1:=0; st2:=0; yes:=0;

for iii:=n-1 downto 1  do begin
  osob:=0;
  for i:=iii downto 1 do if a[iii+1,i]=0 then osob:=osob+1;

    if (a[iii+1,iii] = 0) and (osob >= 1) and (osob <> iii) then
    begin
    writeln('Встретился Особый случай 1, в данной программе не рассматривается:');
    readln;
    yes:=1;
    halt;
    end;

  if osob = iii then
    begin
    writeln('Встретился Особый случай 2:');
    readln;
     yes:=-1;
      if ch(mn-iii)>0 then dt[mn-iii+1]:=1
      else dt[mn-iii+1]:=-1;
      for i:=mn downto iii+1 do dt[mn-i+1]:=a[iii+1,i]*dt[mn-iii+1]*(-1);
     st1:=mn-iii;
    multi;
     mn:=iii;
     goto forend
  end;

    for i:=1 to mn do begin
    for j:=1 to mn do begin
    mm[i,j]:=0;
    m[i,j]:=0;
    end;
    mm[i,i]:=1;
    m[i,i]:=1;
    end;

    for i:=1 to mn do begin
    mm[iii,i]:=a[iii+1,i]*(-1)/a[iii+1,iii];
    m[iii,i]:=a[iii+1,i];
    end;

    mm[iii,iii]:=1/a[iii+1,iii];

    for i:=1 to mn do
    for j:=1 to mn  do begin
    c[i,j]:=0;
    for k:=1 to mn do c[i,j]:=m[i,k]*a[k,j]+c[i,j];
    end;

    for i:=1 to mn do
    for j:=1 to mn  do begin
    a[i,j]:=0;
    for k:=1 to mn do a[i,j]:=c[i,k]*mm[k,j]+a[i,j];
    end;
forend:
 end;
end;

sl1:
  if yes<>1 then
    if ch(mn)>0 then dt[mn+1]:=1
    else dt[mn+1]:=-1;
    for i:=mn downto 1 do dt[mn-i+1]:=a[1,i]*dt[mn+1]*(-1);
    st1:=mn;
    multi;

    writeln('Это коэффициенты характеристического уравнения ');
    writeln('записанные в порядке увеличения их порядковых номеров,');
    writeln('т.е. d1, d2,...,dn');
    for i:=n downto 1 do begin
    write('d' ,n+1-i,' =',g3[i]:4:1,' ');
    writeln
    end;
   readln;
  end.