Поиск гамильтонова контура (Pascal)

[АркЛи]

Доброго времени суток, форумчане! Очень жду свежего взгляда со стороны, потому как у самого уже голова просто не варит!)
Это программа поиска гамильтонова контура в графе, основанная на моем понимании метода Робертса-Флореса.
Суть в следующем - вводится матрица смежности (mass) вершин графа. После на ее основе строится новая матрица-ключ (key), в которой индексу строки соответствует номер вершины, а в столбцах находятся числа-индексы смежных вершин.
Дальше матрица-ключ рекурсивно обрабатывается (надеюсь, код получился достаточно адекватным и ясным).
Собственно, в чем вопрос! Программа не выдает адекватных результатов для каждого типа графов. В некоторых случаях в ответ выводится среди прочих вершина с индексом 0, при том что по условию индексация начинается с 1, а результат 0 не допускается к рассмотрению вовсе!
Какая ошибка в коде присутствует, как можно это исправить?
Ниже код+иллюстрации нормальной(а) и ненормальной работы(б) программы.

program gamilton;
uses crt;

const n=5;

type matrix=array [1..n,1..n] of byte;
     tset=set of byte;
	 vector=array[1..n] of byte;

var mass:matrix;
    key:matrix;
    i:byte;
    all_vertexes, con_vertexes:tset;
	result:vector;


procedure input(var arr:matrix; var inputed:tset);
var i,j:byte;
begin inputed:=[];
      for i:=1 to n do begin
          inputed:=inputed+[i];
          for j:=1 to n do
          readln(arr[i,j]);
          end;
end;

procedure output(const arr:matrix);
var i,j:byte;
begin
      for i:=1 to n do
        begin
        for j:=1 to n do write (arr[i,j]);
        writeln;
        end;
end;

procedure keygen (var arr,rowdok:matrix; var inputted:tset);(*создание матрицы-ключа*)
var i,j,k:byte;
	stop:boolean;
begin i:=1;
stop:=false;
inputted:=[];
while not stop do begin
	 k:=1;
     for j:=n downto 1 do
                      if arr[i,j]=1 then begin
		                         rowdok[i,k]:=j;
                                 inputted:=inputted+[i];
                                 k:=k+1;
                                 end;
     i:=i+1;
     if i>n then stop:=true;
                  end;
end;


procedure main(var arr:matrix; var inputed:tset; var res:vector);
	procedure rec(var i,j,k:byte);

	procedure incr(var i,j,k:byte);
	var tmp:byte;
	begin
		for tmp:=1 to n do if ((arr[i,tmp]<>0)and not (arr[i,tmp]in inputed))
         then break;
         rec(arr[i,tmp],j,k);
        writeln;
	end;

	procedure fin(i,j,k:byte);
	begin for j:=1 to n do if arr[i,j]=1 then res[k]:=arr[i,j];
	end;

	begin;
	if (k<n) then begin
		if not ((i in inputed)and(i<>0)) then(*!!!*)
						begin
								inputed:=inputed+[i];
								res[k]:=i;
								k:=k+1;
								rec(arr[i,j],j,k);
						end
						else incr(arr[i,j],j,k);
					end
        else fin(arr[i,j],j,k);

	end;
var i,j,k:byte;
begin i:=1;j:=1;k:=0;
	rec(i,j,k);
end;

begin clrscr;
input(mass,all_vertexes); {заполнение матрицы и контрольного множества}
clrscr;
output(mass); {посмотреть}
keygen (mass,key,con_vertexes);{создание ключа, заполнение множества 
							тех вершин, которые включены в связи графа}
writeln;
output(key);

if (con_vertexes<>all_vertexes) then writeln ('not Hamiltonian path')(*очевидно, 
что если не все верщины графа соединены ребрами, есть отдельные, 
* то и гамильтонова контура там нету*)
else begin
	con_vertexes:=[];
	main(key,con_vertexes,result);
	for i:=0 to n do write(result[i],' ');
	end;
readln;
end.

[АркЛи]

Всем привет! Народ, подскажите какой-нибудь адекватный алгоритм поиска гамильтонова контура, желательно на основе поиска в глубину...
Примеры там реализации, может есть у кого?