无奈了..不知到为何
var a:Array[1..10100,0..10100]of longint;
    //b:Array[1..10000,1..10000]of boolean;
    le,cx,cd:Array[1..10100]of longint;
    b:array[1..10100]of boolean;
    str:array[1..10100]of longint;
    st:array[1..10100]of boolean;
    i,j,k,l,m,n,x,y,ck,ql,qlx:longint;
function min(x,y:longint):longint;
begin
  if x>y then exit(y) else exit(x);
end;
procedure search(x:longint);
var p,q,k1:longint;
    t:boolean;
    tb:array[1..10100]of boolean;
begin
  b[x]:=true;
  inc(k);str[k]:=x;st[x]:=true;inc(ck);cx[x]:=ck;le[x]:=ck;k1:=k;
  for p:=1 to a[x,0] do
    begin
      if b[a[x,p]]=false then begin search(a[x,p]);le[x]:=min(le[x],le[a[x,p]]);end else
      if st[a[x,p]]=true then le[x]:=min(le[x],cx[a[x,p]]);
    end;
  if cx[x]=le[x] then begin
    t:=true;
    fillchar(tb,sizeof(tb),false);
    for p:=k1 to k do
      begin
        st[str[p]]:=false;
        tb[str[p]]:=true;
      end;
    for p:=k1 to k do
      if a[str[p],0]>0 then begin
        for q:=1 to a[str[p],0] do
          if tb[a[str[p],q]]=false then begin
        t:=false;break;end;end;
    if t then begin if ql>0 then begin writeln(0);halt;end else begin inc(ql);qlx:=k-k1+1;end;end;
    k:=k1-1;
  end;

end;
begin
  readln(n,m);
  for i:=1 to m do
    begin
      readln(x,y);
      inc(a[x,0]);
      a[x,a[x,0]]:=y;
    end;
  for i:=1 to n do
    if b[i]=false then
      begin
        b[i]:=true;
        fillchar(str,sizeof(str),0);
        fillchar(st,sizeof(St),false);
        st[i]:=true;
        str[1]:=i;
        ck:=0;
        le[i]:=1;
        cx[i]:=1;
        k:=0;
        search(i);
      end;
  writeln(qlx);
end.

• Re:runtime error (25) kuzi11 2010-04-30 19:53:13