1 /**************************************************************
2 Problem: 1724
3 User: HansBug
4 Language: Pascal
5 Result: Accepted
6 Time:56 ms
7 Memory:860 kb
8 ****************************************************************/
9
10 var
11 i,j,k,l,m,n,head:longint;
12 tot:int64;
13 a,FIX,LEF,rig:array[0..40500] of longint;
14 procedure swap(var x,y:longint);inline;
15 var z:longint;
16 begin
17 z:=x;x:=y;y:=z;
18 end;
19 function min(x,y:longint):longint;inline;
20 begin
21 if x<y then min:=x else min:=y;
22 end;
23 function max(x,y:longint):longint;inline;
24 begin
25 if x>y then max:=x else max:=y;
26 end;
27 procedure merge(VAR X,y:longint);inline;
28 begin
29 if x=0 then swap(x,y);
30 if y=0 then exit;
31 if a[x]>a[y] then swap(x,y);
32 merge(rig[x],y);
33 fix[x]:=min(fix[lef[x]],fix[rig[x]])+1;
34 if fix[lef[x]]<fix[rig[x]] then swap(lef[x],rig[x]);
35 end;
36 function cuthead(var head:longint):longint;inline;
37 begin
38 cuthead:=a[head];
39 merge(lef[head],rig[head]);
40 head:=lef[head];
41 end;
42 begin
43 readln(n);
44 for i:=1 to n do
45 begin
46 readln(a[i]);
47 fix[i]:=0;rig[i]:=0;lef[i]:=0;
48 end;
49 head:=1;
50 for i:=2 to n do
51 begin
52 j:=i;
53 merge(head,j);
54 end;
55 m:=n;tot:=0;
56 for i:=1 to n-1 do
57 begin
58 k:=cuthead(head);
59 k:=k+cuthead(head);
60 tot:=tot+k;
61 inc(m);
62 j:=m;
63 a[m]:=k;
64 fix[m]:=0;rig[m]:=0;lef[m]:=0;
65 merge(head,j);
66 end;
67 writeln(tot);
68 readln;
69 end.