program here:




const
  maxx = 3000;
type
  pp = array [1..maxx] of integer;
var
  pre , h , f , c , d , o , temp , sj , xj , u : pp;
  ch : char;
  ling : boolean;
  ii , yu , i , ws : longint;
procedure mid(aa,bb:pp);
var
  ii , jw , kk : longint;
begin
  fillchar(c,sizeof(c),0);
  jw := 0;
  fillchar(temp,sizeof(temp),0);
  for ii := 1 to ws+2 do begin
    temp[ii] := aa[ii] + bb[ii] + jw;
    jw := temp[ii] div 10;
    temp[ii] := temp[ii] mod 10;
  end;
  ii := maxx;
  while (ii<>1) and (temp[i]=0) do dec(ii);
  yu := 0;
  for kk := ws+2 downto 1 do begin
    yu := yu *10 + temp[kk];
    c[kk] := yu div 2;
    yu := yu mod 2;
  end;


end;
function big(aa,bb:pp) : boolean;
var
  wsa, wsb : integer;
begin
  wsa := maxx;
  big := false;
  while (wsa<>1) and (aa[wsa]=0) do dec(wsa);
  wsb := maxx;
  while (wsb<>1) and (bb[wsb]=0) do dec(wsb);
  if wsa > wsb then begin
    big := true;
    exit;
  end;
  if wsa < wsb then begin
    big := false;
    exit;
  end;
  for i := wsa downto 1 do begin
    if aa[i] > bb[i] then begin
      big := true;
      exit;
    end;
    if aa[i] < bb[i] then begin
      big := false;
      exit;
    end;
  end;
end;
procedure square;
var
  l1 , l2 , ws : integer;
begin
  ws := maxx;
  fillchar(f,sizeof(f),0);
  while (ws <>1) and (c[ws]=0) do dec(ws);
  for l1 := 1 to ws do
    for l2 := 1 to ws do
      f[l1+l2-1] := f[l1+l2-1] + c[l1] * c[l2];
  for l1 := 1 to ws * 2 + 2 do begin
    f[l1+1] := f[l1+1] + f[l1] div 10;
    f[l1] := f[l1] mod 10;
  end;
end;
procedure sqq;
var
  l1 , l2 , ws : integer;
begin
  ws := maxx;
  fillchar(h,sizeof(h),0);
  while (ws <>1) and (d[ws]=0) do dec(ws);
  for l1 := 1 to ws do
    for l2 := 1 to ws do
      h[l1+l2-1] := h[l1+l2-1] + d[l1] * d[l2];
  for l1 := 1 to ws * 2 + 2 do begin
    h[l1+1] := h[l1+1] + h[l1] div 10;
    h[l1] := h[l1] mod 10;
  end;
end;

function equal(aa,bb:pp) : boolean;
var
  iii , ws1 , ws2 : integer;
begin
  ws1 := maxx;
  equal := true;
  while (aa[ws1]=0) and (ws1<>1) do dec(ws1);
  ws2 := maxx;
  while (bb[ws2]=0) and (ws2<>1) do dec(ws2);
  if ws1 <> ws2 then begin
    equal := false;
    exit;
  end;
  for iii := 1 to ws1 do
    if aa[iii] <> bb[iii] then begin
      equal := false;
      exit;
    end;
end;
procedure add1;
begin
  d := c;
  ii := 1;
  repeat
    d[ii] := d[ii]+1;
    if d[ii] in [0..9] then break;
    d[ii+1] := d[ii] div 10;
    d[ii] := d[ii] mod 10;
    inc(ii);
  until false;
end;

begin
  ws := 0;
  ling := true;
  while not eoln(input) do begin
    read(ch);
    inc(ws);
    temp[ws] := ord(ch) - ord('0');
    if ch <> '0' then ling := false;
  end;
  if ling then begin
    writeln(0);
    halt;
  end;
  for i := 1 to ws do
    o[i] := temp[ws-i+1];
  for i := 1 to ws do
    o[i] := o[i] * 2;
  for i := 1 to ws do begin
    o[i+1] := o[i+1] + o[i] div 10;
    o[i] := o[i] mod 10;
  end;
  xj[1] := 1;
  sj[ws+1] := 1;
  repeat
    mid(xj,sj);
    if equal(pre,c) then begin
      add1;
      c := d;
      break;
    end;
    pre := c;
    square;
    add1;
    sqq;
    if big(f,o) then sj := c;
    if big(o,h) then xj := c;
  until big(o,f) and big(h,o);
  ws := 3000;
  while (ws<>1) and (c[ws]=0) do dec(ws);
  for i := ws downto 1 do
    write(c[i]);
  writeln;
end.

48805971417498085602366608859366

Right answer is 9879875648761788  but your programm give 9879875648761720. Good Luck