自己的做法:
var n,i,ans,a1,k,temp:longint;a:array[1..10001] of longint;
procedure qsort(l,r:longint);
var
i,j,k,p,temp:longint;
begin
i:=l;
j:=r;
k:=a[l];
repeat
while a[i]>k do
i:=i+1;
while a[j]<k do
j:=j-1;
if (i<=j)
then
begin
p:=a[i];
a[i]:=a[j];
a[j]:=p;
i:=i+1;
j:=j-1;
end;
until i>j;
if (l<j)
then qsort(l,j);
if (l<r)
then qsort(i,r);
end;
begin
readln(n);
for i:=1 to n do read(a[i]);
qsort(1,n);
while n>1 do
begin
dec(n);
a[n]:=a[n]+a[n+1];
temp:=a[n];
ans:=ans+a[n];
for i:=n-1 downto 1 do
if a[i]>=temp
then break
else begin a[i+1]:=a[i];k:=i;end;
a[k]:=temp;
end;
writeln(ans);
end.