Ciclu eulerian

>

{determina cliclu eulerian dintr-un graf, daca exista}
program ciclu_eulerian; 
uses crt; 
type mat=array [1..20,1..20] of integer; 
     sir=array [1..20] of integer; 
var a:mat;s:sir; 
    n,m,i,j,k,prim:integer; 
    gasit:boolean; 
procedure cit; 
begin 
 write('n=');readln(n); 
 m:=0;prim:=0; 
 for i:=1 to n-1 do 
  for j:=i+1 to n do 
   begin 
    write('a[',i,',',j,']=');readln(a[i,j]); 
    if a[i,j]=1 then 
            begin 
             m:=m+1; 
             prim:=i; 
            end; 
    a[j,i]:=a[i,j]; 
   end; 
end; 
function valid(k:integer):boolean; 
var i:integer; 
begin 
 valid:=true; 
 if a[s[k],s[k-1]]=0 then valid:=false; 
 if (k=m)and(a[s[k],s[1]]=0)then valid:=false; 
end; 
procedure back(k:integer); 
var i,j:integer; 
begin 
 i:=1; 
 while (i<=n)and(not gasit) do 
 begin 
  s[k]:=i; 
  if valid(k) then 
   begin 
    a[s[k],s[k-1]]:=0; 
    a[s[k-1],s[k]]:=0; 
    if k=m then 
       begin 
        gasit:=true; 
        writeln('Ciclul eulerian este:'); 
        for j:=1 to m do write(s[j],' '); 
        writeln(s[1]); 
       end 
           else back(k+1); 
    a[s[k],s[k-1]]:=1; 
    a[s[k-1],s[k]]:=1; 
   end; 
  i:=i+1; 
 end; 
end; 
procedure tip; 
begin 
 clrscr; 
 writeln('Matricea de adiacenta:'); 
 for i:=1 to n do 
 begin 
  for j:=1 to n do write(a[i,j],' '); 
  writeln; 
 end; 
 writeln; 
end; 
begin{PP} 
clrscr; 
cit; 
tip; 
if prim<>0 then 
 begin 
  s[1]:=prim; 
  gasit:=false; 
  back(2); 
  if not gasit then write('Graful nu este eulerian.'); 
 end 
           else write('Graful nu este eulerian.'); 
 readkey; 
end. 
{PascalZone.uv.ro}