Графы. Машинное представление. Доработка программы

const nmax=30;
type ref = ^ Elem;
     Elem = record
            num: integer;
            ves:real;
            pred, sled, ref_vi: ref;
            end;
 
var mas_ref: array [1 .. nmax] of ref;
    {Колчество зааднных вершин}
    n:integer;
 
{Доюавление ребра}
procedure add(vi,vj:integer;v:real);
var i,j:integer;
    pi,pj:ref;
begin
     if vi>n
     then n:=vi;
     if vj>n
     then n:=vj;
 
     pi:=mas_ref[vi];
     if pi=nil
     then begin
          new(pi);
          pi^.sled:=nil;
          pi^.pred:=nil;
          mas_ref[vi]:=pi;
     end
     else begin
          while pi^.sled<>nil do pi:=pi^.sled;
          new(pi^.sled);
          pi^.sled^.sled:=nil;
          pi^.sled^.pred:=pi;
          pi:=pi^.sled;
     end;
 
     pj:=mas_ref[vj];
     if pj=nil
     then begin
          new(pj);
          pj^.sled:=nil;
          pj^.pred:=nil;
          mas_ref[vj]:=pj;
     end
     else begin
          while pj^.sled<>nil do pj:=pj^.sled;
          new(pj^.sled);
          pj^.sled^.sled:=nil;
          pj^.sled^.pred:=pj;
          pj:=pj^.sled;
     end;
 
     {Заполняем номер, вес и ссылку на смежную вершину}
     pi^.num:=vi;
     pi^.ves:=v;
     pi^.ref_vi:=pj;
 
     pj^.num:=vj;
     pj^.ves:=v;
     pj^.ref_vi:=pi;
end;
 
{Вычисление кратности вершины}
function kratnost(vi:integer):integer;
var k:integer;
    pi:ref;
begin
     k:=0;     
     pi:=mas_ref[vi];
     while pi<>nil do
     begin
          pi:=pi^.sled;
          inc(k);
     end;
     kratnost:=k;
end;
 
{Поиск ребра, вершинами которого имеют кратность 3}
function findrebro:ref;
var vi,vj:integer;
    pi,p:ref;
begin
     vi:=1;
     p:=nil;
     while (vi<=n) and (mas_ref[vi]<>nil) and (p=nil) do
     begin
          {Если кратность первой вершины = 3}
          if kratnost(vi)=3
          then begin
               pi:=mas_ref[vi];
               while (pi<>nil) and (kratnost(pi^.ref_vi^.num)<>3) do
                     pi:=pi^.sled;
               {Результат поиска}
               p:=pi;
          end;
          inc(vi);
     end;
     findrebro:=p;
end;
 
{Вывод на экран списка инцидентности}
procedure print;
var  i:integer;
     p:ref;
 
begin
     for i:=1 to n do
     if mas_ref[i]=nil
     then writeln(i:2,': izolirovanny')
     else begin
          write(i:2,': ');
          p:=mas_ref[i];
          while p<>nil do
          begin
               write('(',i,',',p^.ref_vi^.num,';v=',p^.ves:0:2,') ');
               p:=p^.sled;
          end;
          writeln;
     end
end;
 
var  i:integer;
     p:ref;
 
begin
     for i:=1 to n do mas_ref[i]:=nil;
 
     {Формируем граф}
     add(1,2,3.4);
     add(1,3,5.6);
     add(1,4,6.7);
     add(2,3,8.9);
     add(2,4,9.1);
     add(3,4,10.11);
     add(3,5,11.12);
 
 
 
     writeln('Ishodny graf');
     print;
 
     {Находим ребро с вершинами с кратностью 3}
     p:=findrebro;
     while p<>nil do
     begin       
          if p^.sled<>nil
          then p^.sled^.pred:=p^.pred;
          if p^.pred<>nil
          then p^.pred^.sled:=p^.sled
          else mas_ref[p^.num]:=p^.sled;
          if p^.ref_vi^.sled<>nil
          then p^.ref_vi^.sled^.pred:=p^.ref_vi^.pred;
          if p^.ref_vi^.pred<>nil
          then p^.ref_vi^.pred^.sled:=p^.ref_vi^.sled
          else mas_ref[p^.ref_vi^.num]:=p^.ref_vi^.sled;
 
          dispose(p^.ref_vi);
          dispose(p);
 
          {Ищем следующее ребро для удаления}
          p:=findrebro;
     end;
 
     writeln('Udalenie reber s kratnotiyu vershin 3');
     print;
     readln;
end.