Не работает программа, как исправить? Паскаль

[Тетрадь]

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

program pro1;
uses op,obrabotki;
var a:mas;
    n,key:integer;
begin
vvod(a,n);
writeln('Исходный массив');
vivod(a,n);
sort(a,n);
writeln('После сортировки');
vivod(a,n);
write(' Введите число:');
poisc(a,n);
end.

unit op;
interface
type mas=array [1..10000] of integer;
implementation
end.

unit obrabotki;

interface
uses op;
procedure vvod(var a:mas; var n:integer);
procedure vivod (a:mas;n:integer);
procedure sort(var a:mas;n:integer) ;
procedure poisc(a:mas;n:integer);

implementation

procedure vvod(var a:mas;var n:integer);
var i:integer;
begin
writeln ('Введите количество элементов');
readln(n);
writeln('Введите элементы:');
for i:=1 to n do
Readln(a[i]);
end;

procedure vivod (a:mas;n:integer);
var i:integer;
begin
for i:=1 to n do write(a[i]:4);
writeln;
end;

procedure sort(var a:mas;n:integer) ;
var i, temp, n_min : integer;
begin
temp:=0;
for i :=1 to n do begin
for n_min :=1 to n do begin
if a[i] > a[n_min] then begin
temp:= a[i];
a[i]:= a[n_min];
a[n_min]:=temp;
end;

end;

end;
end;

procedure poisc(a:mas;n:integer);
var
   i,l,u,r,m,key:integer;
   begin
   l := 1;
    r := n + 1;
    u:=0;
    inc(u,2);
    readln(key);
    While l < r - 1 do
    begin
      m := (l + r) div 2;
      inc(u);
      if a[m] > key then
      begin
      r := m;
      inc(u,2);
      end
        else
        begin
        l := m;
        inc(u,2);
    end;
    begin
    if a[l] = key then WriteLn(l)
    
    else writeln('Данных элементов нет в массиве');
    end;
    writeln('Временная сложность: ',u);

end;
end;
end.

[Stilet]

Текст ошибки засекречен?

[Тетрадь]

Он не находит число в массиве, всегда пишет, что такого элемента нет. Так же данную запись и временную сложность он показывает по несколько раз.

[Mad_Cat]

он показывает по несколько раз

Дык выкиньте свои writeln за цикл и будет по 1 разу показывать

[Тетрадь]

Он не находит число в массиве, всегда пишет, что такого элемента нет.

[Тетрадь]

Кто может помочь? сам не могу исправить

[Stilet]

Допустим я:

procedure poisc(a:mas;c:integer);
var b,i,stp,key:integer;
begin
 readln(key);
 b:=1;stp:=0;
 { Начинаем цикл пока разница между границами не будет равна 2 что
 скажет о том что искать больше нечего, т.е между граничными элементами
 уже ничего нет}
 while (c-b)>1 do begin
 {Это колво шагов для статистики}
   inc(stp);
   {Становимся посередине искомого подмассива}
   i:=b+(c-b) div 2;
   {если найден то выйти вернув номер найденого по порядку}
   if a[i]=key then begin writeln('Found ',key,' in ',i,'. Steps of Maya =',stp); break;;end;
   {иначе сравним}
   if a[i]<key then
    {Если искомое меньше центрального то сдвигаем верхнюю границу
    Считая что за центром искомого нет и быть не может}
    c:=i
   else
    {Иначе искомого нет слева от центра, тогда сдвигаем нижнюю границу}
    b:=i;
 end; writeln('done...');
end;

Взято отсюда:
http://www.programmersforum.ru/showt...288#post729288

Годится?

[ZX Spectrum-128]

type mas=array [1..10000] of integer;

var a:mas;
  n,key:integer;

procedure vvod(var a:mas;var n:integer);
var i:integer;
begin
writeln ('Введите количество элементов');
readln(n);
writeln('Введите элементы:');
for i:=1 to n do
Readln(a[i]);
end;

procedure vivod (a:mas;n:integer);
var i:integer;
begin
for i:=1 to n do write(a[i]:4);
writeln;
end;

procedure sort(var a:mas;n:integer) ;
var i, temp, n_min : integer;
begin
temp:=0;
for i :=1 to n do begin
for n_min :=1 to n do begin
if a[i] > a[n_min] then begin
temp:= a[i];
a[i]:= a[n_min];
a[n_min]:=temp;
end;

end;

end;
end;

procedure poisc(m:mas;count:integer);
var
  it,i,first,last:integer;
  found:boolean;
begin
it:=0;
First := 1;
Last := n;
Found:=False; {Элемент не найден}
repeat {Повторять поиск}
I := (First + Last) div 2; {Разделить на две части}
if M[I] = key then Found:=True
else
begin
if M[I] > key then First := I+1 {Искать элемент в правой части}
else Last := I-1; {Искать элемент в левой части}
end;
it:=it+1; {Увеличить счетчик числа итераций}
until (Found) or (First>Last); {Завершить, если найдется искомый элемент или будет просмотрен весь массив}
if Found then Writeln('Искомый элемент ',key,' в массиве занимает ',I,'-ю позицию')
else
Writeln('В массиве нет искомого элемента ',key);
Writeln('Поиск выполнен За ',it,' итераций');
end;
begin
vvod(a,n);
writeln('Исходный массив');
vivod(a,n);
sort(a,n);
writeln('После сортировки');
vivod(a,n);
write(' Введите число:');
readln(key);
poisc(a,n);

end.

[Тетрадь]

Из 10 элементов он находит 6300 позицию элемента

[ZX Spectrum-128]

У меня нормально отработало