{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
Var
 k,n,i,s1,s2,l:Longint;
 a:array[1..10000,0..1] of Longint;
 d:array[1..10000,1..2] of Longint;
 p:array[1..10000,1..2] of Longint;
 ans:array[1..10000] of Integer;

Function Min(a,b:Longint):Longint;
Begin
If a>b then Min:=b else Min:=a;
End;

Procedure Sort(l,r:Longint);
Var i,j,x,y:Longint;
Begin
i:=l; j:=r; x:=a[(l+r) div 2,0];
Repeat
 While a[i,0]<x do i:=i+1;
 While x<a[j,0] do j:=j-1;
 If i<=j then
 Begin
  y:=a[i,0]; a[i,0]:=a[j,0]; a[j,0]:=y;
  y:=a[i,1]; a[i,1]:=a[j,1]; a[j,1]:=y;
  i:=i+1; j:=j-1;
 End;
Until i>j;
 If l<j then Sort(l,j);
 If i<r then Sort(i,r);
End;


Begin    {
Assign(input,'olymp.in');
Assign(output,'olymp.out');
Reset(input);
Rewrite(output);}
Read(n);
For i:=1 to n do begin Read(a[i,0]); a[i,1]:=i; end;
Sort(1,n);
For i:=1 to n do
 For k:=1 to 2 do d[i,k]:=20000000;
d[2,2]:=a[1,0]+a[2,0];
For i:=3 to n do
 Begin
 {d[i,1]}
 s1:=d[i-1,1];
 s2:=d[i-1,2];
 If s1<s2 then p[i,1]:=1 else p[i,1]:=2;
 d[i,1]:=Min(s1,s2)+a[1,0]+a[i,0];
 s1:=d[i-2,1];
 s2:=d[i-2,2];
 If s1<s2 then p[i,2]:=1 else p[i,2]:=2;
 d[i,2]:=Min(s1,s2)+a[1,0]+a[2,0]+a[2,0]+a[i,0];
 End;
d[n,1]:=d[n,1]-a[1,0];
d[n,2]:=d[n,2]-a[1,0];
If d[n,1]<d[n,2] then k:=1 else k:=2;
Writeln(d[n,k]);
i:=n;
l:=0;
While i<>2 do
 Begin
 Inc(l);
 ans[l]:=k;
 i:=i-k;
 k:=p[i+k,k];
 End;
{Write(a[1,1],' ',a[2,1]);
If n>2 then Write(' ',a[1,1]);
Writeln;                      }
k:=3;
For i:=l downto 1 do
 Begin
 If ans[i]=2 then
  Begin
{  Write(a[k,1],' ',a[k+1,1]);
  Writeln(' ',a[2,1]);
  Write(a[1,1],' ',a[2,1]);
  If k+1<n then Write(' ',a[1,1]);
  Writeln;                        }
  k:=k+2;
  End else
  Begin
{  Write(a[k,1],' ',a[1,1]);
  If k<n then Write(' ',a[1,1]);
  k:=k+1;
  Writeln;   }
  End;
 End;
End.
