Help me+++++
program de;
    var
    m:array[1..2000] of integer;
    i,a,p,ost,f:integer;
procedure profi(t:integer);
     var
     j,os:integer;
begin
   j:=0;
   os:=0;
   repeat
   inc(j);
   m[j]:=m[j]*t+os;
   os:=0;
   if m[j]>9 then
     begin
      os:=m[j] div 10;
      m[j]:=m[j] mod 10;
     end;
   if (j=f+1) and (m[j]<>0) then inc(f);
   until j=f+1;
end;
begin
   readln(a);
   if a=1 then  writeln(1)
   else
   if a=2 then writeln(2)
   else
   if a=3 then writeln(3)
   else
   if a=4 then writeln(4)
   else
   if a=7 then writeln(12)
   else
   begin
   f:=1;
   m[1]:=1;
   p:=a div 3;
   ost:=a mod 3;
   for i:=1 to p do
   profi(3);
   if ost<>0 then profi(ost);
   for i:=f downto 1 do
   write(m[i]);
   end;
end.

Excuse, I have found a mistake.