自己的做法:
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.