program Bourne;
  var
    x:char;
    a:array[1..1000] of char;
    n,i,start,len,maxlen:integer;
  procedure find(p,q:integer);
    var
      p0,q0:integer;
    begin
      p0:=p;  q0:=q;
      while (p0>=1)and(q0<=n)and(a[p0]=a[q0]) do
        begin
          inc(len,2);
          inc(q0); dec(p0);
        end;
      if len>maxlen then
        begin
          maxlen:=len;
          start:=p0;
       end;
    end;
  begin
    n:=0;
    repeat
      read(x);
      inc(n);
      a[n]:=x;
    until eoln;
    maxlen:=0;
    for i:=1 to n do
      begin
        len:=0;
        find(i,i+1);
        len:=1;
        find(i-1,i+1);
      end;
    for i:=1 to maxlen do
      write(a[start+i]);
    writeln;
  end.

I used DP O(n^2)
var
  st : ansistring;
  f : array [0..1010,0..1010] of boolean;
  i,j,cx,cy,max : longint;
begin
  readln(st); max:=0;
  for i:=1 to length(st) do
  for j:=1 to i do f[i,j]:=true;
  for i:=1 to length(st)-1 do
  for j:=1 to length(st)-i do
  if st[j] = st[i+j] then f[j,i+j]:=f[j+1,i+j-1]
                     else f[j,i+j]:=false;

  max:=-1;
  for i:=1 to length(st) do
  for j:=0 to length(st)-i do
  if (f[i,i+j]) and (j>max) then
  begin
    cx:=i;
    cy:=i+j;
    max:=j;
  end;

  for i:=cx to cy do write(st[i]);
  writeln;
end.