var
     a, b, c : array [1..10000] of integer;
     k, n, s, i, j : integer;
     toq : boolean;

    procedure quicksort;
      procedure sort(l, r : integer);
        var
          i1, j1, x, w : integer;
        begin
        i1 := l;
        j1 := r;
        x := a[(l+r) div 2];
          repeat
            while  a[i1]<x do
              inc(i1);
            while  x<a[j1] do
              dec(j1);
            if i1 <= j1 then  begin  w := a[i1]; a[i1] := a[j1];  a[j1] := w;
                                     w := b[i1]; b[i1] := b[j1];  b[j1] := w;
                                   inc(i1);  dec(j1);     end;
          until i1 > j1;
        if l < j1 then sort(l, j1);
        if i1 < r then sort(i1, r);
        end;
     begin
     sort(1, n);
     end;{quicksort}

begin
  read(n);
  for k := 1 to n do
    begin
      read(a[k]);
      b[k] := k;
    end;
    s := 0;
    for k := 1 to n do
    s := s + a[k];

  quicksort;
  toq := true;
  for k := 1 to n do
    begin
      if toq then
        begin
          j := 1;  i := 1;
          while (i <= s) and (j <= a[k]) do
            begin
            c[i] := b[k];
            inc(i, 2);
            inc(j);
            end;
          if i > s then toq := false;
        end;
      if toq = false then
        begin
          j := 1;  i := 2;
          while (i <= s) and (j <= a[k]) do
            begin
            c[i] := b[k];
            inc(i, 2);
            inc(j);
            end;
        end;
     end;

     for i := 1 to s do
     write(c[i], ' ');
end.
or smth wrong with my idea!!!