Здравствуйте, Артем Воробьев!

Комментарии в программе -- вроде всё ясно.

[code h=200]
{Максимальное количество вершин графа}
const nmax=30;

{По вашему тексту}
type ref = ^ Elem;
Elem = record
num: integer;
{ves: array [1 .. kv] of real;
Я категорически не понял, зачем тут понадобился массив.
Вроде бы одно ребро -- один вес}
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
{Если vi или vj ещё не были добавлены -- увеличиваем n}
if vi>n
then n:=vi;
if vj>n
then n:=vj;

{Начинаем пробег по списку рёбер вершины vi}
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;
{создаём новый элемент в ссылке sled}
new(pi^.sled);
pi^.sled^.sled:=nil;
{привязываем его к текущему}
pi^.sled^.pred:=pi;
{и сдвигаемся на него}
pi:=pi^.sled;
end;

{Всё то же самое для vj}
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}
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
{Сдвигаемся по списку ребер пока не дойдём до конца
или до смежной вершины с кратностью 3}
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.[/code]