[_Nox_]

program heapsort;
const 
	max_Heap = 10000;
type 
	THeap = record 
	  h:array [1..max_heap] of integer;
	  E:integer;	  
         end;   

var
	Heap: theap;
	i,p:integer;
	
procedure create_heap;
begin

heap.E:=0;
 
end;

procedure in_heap (A:integer);
var 
	cc:integer;
	cur:integer;
begin
inc (heap.e);
heap.h [heap.e]:=a;
cur:=heap.e;
while (heap.h [cur]<heap.h [cur div 2]) do
 begin
  cc:=heap.h [cur];
  heap.h [cur]:=heap.h [cur div 2];
  heap.h [cur div 2]:=cc;
  cur := cur div 2;
  if cur = 1 then break;
 end; 
end;

PROCEDURE OUT_HEAP (var A:integer); 
var 
	cc,cur,next:integer;
begin
a:=heap.h[1];
heap.h [1]:=heap.h[heap.e];
dec (heap.E);
cur:=1;
while true do
 begin
  if heap.h [cur*2]<heap.h [cur*2+1] then next:=cur*2 else next:=cur*2+1;
  if heap.h [cur]>heap.h [next] then
   begin
    cc:=heap.h [cur];
    heap.h [cur]:=heap.h [next];
    heap.h [next]:=cc;
    cur := next;
    if cur * 2> heap.e then break;
   end else break;
 end;
end;


begin
create_heap;
for i:=1 to 1000 do
 IN_heap (random (10000));
for i:=1 to 1000 do
 begin
  Out_heap (P);
  write (p, ' ');
 end; 
end.

Вот, только что написал, слегка протестировал, вроди работает, адаптируй код под себя, мне просто спать уже пора, нет времени, кстати, я бы тебе посоветовал, посчитать сразу один массив с суммами, чтобы сократить количество вычислений. И не забудь указать кто код писал