Var
 S,S1,S2,Dig_S,Dig_S1:String;
 DR,Code,DD:Word;
 i,k,Dig:Byte;
 b:boolean;

Procedure DigitalRoot(Sd:String; var Sr:String; var D:Word);
var
 P:Word;
 L,j,m:Byte;
begin
 L:=Length(Sd);
 P:=0;
 for j:=1 to L do
  begin
   Val(Sd[j],m,Code);
   Inc(P,m);
  end;
 STR(P,Sr);
 D:=P;
 if P>=10 then DigitalRoot(Sr,Sr,D);
end;

Begin
 Writeln('Enter the number (up to 255 digits):');
 Readln(S);
 DigitalRoot(S,S1,DR);
 b:=false;
 i:=0;
 Repeat
  Inc(i);
  Val(S[i],Dig,Code);
  k:=10;
  repeat
   Dec(k);
   STR(DR+k,Dig_S);
   DigitalRoot(Dig_S,Dig_S1,DD);
  until ((Dig+k<10) and ((DD mod 3)=0)) or (k=1);
  if ((Dig+k<10) and ((DD mod 3)=0)) then
   begin
    b:=true;
    Dig:=Dig+k;
   end;
 Until b or (i=Length(S));
 if b then
  begin
   S1:='';
   for k:=1 to i-1 do
    S1:=S1+S[k];
   STR(Dig,Dig_S);
   S1:=S1+Dig_S;
   for k:=i+1 to Length(S) do
    S1:=S1+S[k];
  end
 else
  begin
   S1:='';
   for k:=1 to Length(S)-1 do
    S1:=S1+S[k];
   DigitalRoot(S1,S2,DR);
   Val(S[Length(S)],Dig,Code);
   repeat
    Dec(Dig);
   until ((DR+Dig) mod 3)=0;
   STR(Dig,Dig_S);
   S1:=S1+Dig_S;
  end;
 Writeln('Result:');
 Writeln(S1);
 Readln
End.