Если не сложно, проверьте правильность написания программы..., Это не должно занять много времени. Заранее благодарна. Опции

[Shymoda]

Ориентированный граф задан матрицей инцидентности. По заданной матрице сформировать список окрестностей вершин графа. По сформированному списку окрестностей вершин определить степени захода всех вершин графа и вершину с максимальной степенью захода. Удалить вершину с максимальной степенью захода вместе со смежными ей вершинами из списка окрестностей.

Program EinZweinDrein;
Type
EU=^Elem;
Elem=Record
nv:integer;
adres:EU;
end;
Var M:array[1..10,1..20] of integer;
Kver,kdur,maxver,imax,kdel:integer;
BegSpis,St,Sp:EU;
Procedure OpenFileForRead;
Var F_in:Text;
i,j:integer;
Begin
Assign(F_in,'Matr.txt');
Reset(F_in);
Kver:=0; Kdur:=0; i:=0;
While not Eof(F_in) do
Begin
Inc(i); j:=0;
While not Eoln(F_in) do
Begin
Inc(j);
Read(F_in,M[i,j]);
End;
Readln(F_in);
Kdur:=j;
End;
Kver:=i;
End;
Procedure VivodMatric;
Var i,j:integer;
Begin
For i:=1 to kver do
Begin
For j:=1 to kdur do
Write(M[i,j]:3);
End;
End;
Procedure Formirovanie;
Var i,j,k:integer;
Begin
New(St);
BegSpis:=St;
For i:=1 to kver do
Begin
St^.nv:=-i;
Sp:=St;
New(St);
Sp^.adres:=St;
For j:=1 to kdur do
If M[i,j]=1 then
For k:=1 to kver do
If M[k,j]=-1 then
St^.nv:=k;
End;
Sp^.adres:=nil;
End;
Procedure VivodSpis;
Begin
St:=BegSpis;
While St<>Nil do
Begin
Write(St^.nv,' ');
St:=St^.adres;
End;
End;
Procedure StepZah;
Var A:array[1..10] of integer;
i:integer;
Begin
For i:=1 to kver do
A[i]:=0;
St:=BegSpis;
While St<>Nil do
Begin
If St^.nv>0 then
A[st^.nv]:=A[st^.nv]+1;
St:=St^.adres;
End;
Writeln('Stepeni zahoda');
For i:=1 to kver do
Writeln(i,' ',A[i]);
Maxver:=A[1];
Imax:=1;
For i:=2 to kdur do
If Maxver<A[i] then
Begin
Maxver:=A[i];
Imax:=i;
End;
Maxver:=Imax;
Writeln('Maxver=',Maxver);
End;
Procedure DeleteElem;
Var K:array[1..10] of integer;
i:integer;
Begin
St:=BegSpis;
Kdel:=0;
While St<>Nil do
Begin
If St^.nv=-maxver then
Kdel:=Kdel+1;
K[kdel]:=maxver;
St:=St^.adres;
If (St<>Nil) and (st^.nv>0) then
Begin
K[kdel]:=St^.nv;
St:=St^.adres;
End;
Break;
End;
For i:=1 to kdel do
Begin
St:=BegSpis;
While St<>Nil do
Begin
If St^.nv=-K[i] then
Begin
If St=BegSpis then
BegSpis:=St^.adres
Else
Begin
Sp^.adres:=St^.adres;
St:=Sp;
End;
St:=St^.adres;
While (St<>Nil) and (St^.nv>0) do
Begin
If St=BegSpis then
BegSpis:=St^.adres
Else
Begin
Sp^.adres:=St^.adres;
Sp:=St;
End;
Sp:=St;
St:=St^.adres;
End;
End
Else if Sp^.adres=St^.adres then
Begin
Sp^.adres:=St^.adres;
St:=Sp;
End;
Sp:=St;
St:=St^.adres;
End;
End;
End;
Begin
OpenFileForRead;
VivodMatric;
Formirovanie;
VivodSpis;
StepZah;
DeleteElem;
VivodSpis;
End.

М

Просьба использовать тэги кода при публикации программного текста. Lapp

[volvo]

Честно говоря, как-то не соображу так сразу почему...

Ну, ты бы показала новую процедуру формирования списка, может вместе и разберемся, почему DeleteElem глючит...

Добавлено через 6 мин.
Старая версия вылетала, потому что у тебя не хватало begin/end, как я понимаю:

Procedure DeleteElem;
Var K:array[1..10] of integer;
i:integer;
Begin
  St:=BegSpis;
  Kdel:=0;
  While St<>Nil do Begin
    If St^.nv=-maxver then BEGIN { <--- }
      Kdel:=Kdel+1;
      K[kdel]:=maxver;
    END; { <--- }
  St:=St^.adres;
  If (St<>Nil) and (st^.nv>0) then Begin
    K[kdel]:=St^.nv;
    St:=St^.adres;
  End;
  Break;
End;
...

А теперь подумай, что у тебя происходило, когда этих begin/end не было? На первой же итерации обращение к 0-му элементу массива (а массив-то описан с индексами 1 .. 10) - давало тебе вылет...