(Pascal) Задача коммивояжера

[ksenija15reg]

Здравствуйте! Помогите пожалуйста решить проблему в программе. Нужно реализовать решение минимаксной задачи коммивояжера полным перебором с использованием булевых переменных.
Программа не находит минимаксную дугу. у самой уже долго не получается решить проблему

  C: array [1..N,1..N] of integer=((0,3,0,5),(0,0,1,0),(0,0,0,2),(0,0,4,0));
  Tour, P,rez: array [1..N] of integer; 
  max,min2: integer;
  i,i2,j,k, min, ind: integer;
  t:integer;
  All: boolean; 
BEGIN

Writeln('Vvod elementov');

  For i:=1 To N Do
    Begin
      For j:=1 To N Do Write(C[i,j],' ');
       WriteLn;
    End;
All:=False; 
max:=-100;
min2:=100;
  For i:=1 To N Do 
      P[i]:=i;
      Repeat
       For i:=1 To N-1 Do
       max:= C[P[i],P[i+1]];
        if C[P[i],P[i+1]]>max then
        begin
        max:=C[P[i],P[i+1]];
        Tour:=P;
        end
        else begin
        max:=C[P[1],P[N]];
        Tour:=P;
          
            If max<min2 then
           min2:=max;
       end;  
    
       For i:=N DownTo 3 do
         Begin
         If P[i]<P[i-1] Then continue;
         min:=N+1;
         k:=P[i-1];
           For j:=i To N Do If (P[j]>k) and (P[j]<min) Then
            Begin
             min:=P[j];
             ind:=j;
            End;
           P[i-1]:=min;
           P[ind]:=k;
          For j:=i To N-1 Do
            Begin
             min:=N+1;
          For k:=j To N Do If min > P[k] Then
             Begin
              min:=P[k];
              ind:=k;
             End;
          
           k:=P[j];
           P[j]:=min;
           P[ind]:=k;
     
            End;
      GoTo out;
        End;
       
  All:=true;
  Out:
   Until All;
WriteLn('========================================= ======================================');
Write(': ');
for i:=1 to N do
Write(Tour[i],'-');
Write('1');
WriteLn(' MinMax ',min2);
t:=milliseconds;
  write('RunTime=',t/1000:0:2,' с.');
END.