why my program is wrong!
var n,j,i:integer;
    a:array[1..2000] of integer;
procedure cheng(x:integer);
var i,g:integer;
begin
  for i:=1 to 2000 do
    a[i]:=a[i]*x;
  for i:=1 to 2000 do
  begin
    g:=a[i] div 10;
    a[i+1]:=a[i+1]+g;
    a[i]:=a[i] mod 10;
  end;
end;
begin
  read(n);
  if n<4 then
  begin
    writeln(n);
    halt;
  end;
  fillchar(a,sizeof(a),0);
  if n>=3 then
  begin
    a[1]:=3;
    n:=n-3;
  end;
  while n-3>=0 do
  begin
    n:=n-3;
    cheng(3);
  end;
  if n<>0 then cheng(n);
  i:=2000;
  while (i>1) and (a[i]=0) do dec(i);
  for j:=i downto 1 do
    write(chr((ord(a[j])+48)));
end.