I do not know why
Please help me!

var
  i,n,m,k,j:integer;
  b:array[1..5000]of integer;

begin
  fillchar(b,sizeof(b),0);
  readln(n);
  case n of
    0:begin writeln(1); halt;end;
    1:begin writeln(1); halt;end;
    2:begin writeln(2); halt;end;
    3:begin writeln(2); halt;end;
  end;
  case (n mod 3) of
    1:b[5000]:=4;
    2:b[5000]:=6
  else b[5000]:=3;
  end;
  n:=(n div 3)-1;
  m:=1;
  while n>0 do
    begin
      for i:=5000 downto 5001-m do
        b[i]:=b[i]*3;
      for i:=5000 downto 5001-m do
        if b[i]>=10 then
          begin
            inc(b[i-1],b[i] div 10);
            b[i]:=b[i] mod 10;
          end;
      if b[5000-m]<>0 then inc(m);
      dec(n);
    end;
  for i:=5001-m to 5000 do
    write(b[i]);
end.