求NOIP提高2004合并果子的标程

var
a: array [1..10000] of qword;
i,j,n,k:longint;
s,p,t:qword;
f:text;

procedure insert(p:qword;n:longint);

var
i1,i2:longint;

begin
for i1:=1 to n do
if (a[i1]>p) and (a[i1+1]<=p) then break;
for i2:=n downto i1+1 do a[i2+1]:=a[i2];
a[i1+1]:=p;
end;

begin
assign(f,'fruit2.in');
reset(f);
readln(f,n);
for i:=1 to n do
begin
read(f,s);
a[i]:=s;
end;
close(f);
for i:=1 to n-1 do for j:=i+1 to n do if a[i] k:=n-1;
s:=0;
for i:=1 to k do
begin
p:=a[n]+a[n-1];
s:=s+p;
n:=n-2;
insert(p,n);
n:=n+1;
end;
assign(f,'fruit.out');
rewrite(f);
writeln(f,s);
close(f);
end.

自己写的 ac