This is my program:
var
  a:array [1..10] of integer;
  c,b:array [0..100000] of integer;
  i,k,max1,max:integer;
begin
  c[0]:=0;
  c[1]:=1;
  max:=-100000;
  max1:=0;
  k:=0;
  repeat
    inc(k);
    read(a[k]);
    if a[k]>max1 then max1:=a[k];
  until a[k]=0;
  dec(k);
  for i:=2 to max1 do
    begin
      if odd(i) then c[i]:=c[(i-1) div 2]+c[(i-1) div 2+1]
        else c[i]:=c[i div 2];
      if c[i]>max then max:=c[i];
      b[i]:=max;
    end;
  for i:=1 to k do
    if a[i]=1 then writeln(1)
      else writeln(b[a[i]]);
end.