Ошибка времени выполнения: Индекс находится вне границ массива

program zadanie1;
type pir=array[1..1000] of longint;
var b:pir;
    k,s,t,per,por:integer;
procedure r(var b:pir;var k:integer);
var  f:text;
begin
k:=0;
assign(f,paramstr(1));
reset(f);
while (not eof(f)) and (k<1000) do
begin
inc(k);
readln(f,b[k]);
end;
close(f);
end;
procedure resh(var a:pir; i,k,s,t:integer);
var p:longint;
   min:integer;
begin
min:=i*2;
If min<=k then
   begin  inc(por);  inc(s);
      if min<k then
      begin
      inc(por);
      If a[min]<a[min+1] then
      min:=min+1;
      end;
      if a[i]<a[min] then
        begin   inc(per);
          p:=a[min];
          a[min]:=a[i];
          a[i]:=p;
       end
        else  inc(t);
      If (t>1) and (s>1) then
      If   min<k then
       por:=por-2
       else por:=por-1;
      resh(a,min,k,s,t);
   end;
end;
 
procedure build(var a:pir; k:integer);
begin  s:=0; t:=0;
for var i:=(k div 2) downto 1 do
resh(a,i,k,s,t);
end;
 
procedure sort(var a:pir; k:integer);
var g:longint;
begin
for var e:=k downto 2 do
   begin  inc(per);
    g:=a[e];
    a[e]:=a[1];
    a[1]:=g;
    resh(a,1,e-1,s,t);
   end;
end;
 
procedure w(var b:pir;var k:integer; per,por:longint);
var f:text;
 
begin
assign(f,paramstr(2));
rewrite(f);
writeln(f,por);
writeln(f,per);
for var i:=1 to k do
writeln(f,b[i]);
close(f);
end;
begin 
 r(b,k);
 build(b,1000);
 sort(b,1000);
 w(b,k,per,por);
 end.