-----------------------------MY PROGRAM------------------------
const MAXN = 505;
type
PointType = record
   X, Y : longint;
 end;

var a:array[1..MAXN]of pointtype;
    d:array[1..MAXN,1..MAXN]of byte;
    c:array[1..MAXN]of integer;
    s:array[1..MAXN]of integer;
    len:array[1..MAXN]of longint;
    N,i,j,max,l,h,ccc:integer;
procedure sort(l,r: integer);
var
  i,j: integer;
  x,y: longint;
begin
  i:=l; j:=r; x:=len[(l+r) DIV 2];
  repeat
    while len[i]<x do i:=i+1;
    while x<len[j] do j:=j-1;
    if i<=j then
    begin
      y:=len[i]; len[i]:=len[j]; len[j]:=y;
      y:=s[i]; s[i]:=s[j]; s[j]:=y;
      i:=i+1; j:=j-1;
    end;
  until i>j;
  if l<j then sort(l,j);
  if i<r then sort(i,r);
end;

begin
 readln(n);
 for i:=1 to N do
 begin
   read(a[i].x,a[i].y);
   if a[i].y<a[i].x then
   begin
     ccc:=a[i].y;a[i].y:=a[i].x;a[i].x:=ccc;
   end;
 end;
 for i:=1 to N do
 for j:=1 to N do
 begin
   if (a[j].x=a[i].x)and(a[j].y=a[i].y)then d[i,j]:=0
   else if (a[j].x>a[i].x)and(a[j].y<a[i].y) then
   begin
     d[i,j]:=1;
     inc(c[i]);
   end
   else d[i,j]:=0;
 end;
 for i:=1 to N do d[i,i]:=1;
 max:=-MaxInt;
 for i:=1 to N do if c[i]>max then
 begin
   max:=c[i];
   l:=i;
 end;
 h:=0;
 for i:=1 to N do if d[l,i] = 1 then
 begin
   inc(h);
   s[h]:=i;
   len[h]:=a[i].y-a[i].x;
 end;
 sort(1,h);
 writeln(max+1);
 for i:=1 to h-1 do write(s[i],' ');
 writeln(s[h]);
end.

Try this test:
3
1 4
2 3
2 3
The correct output is
2
3 1
or
2
2 1
The output of your program is
3
3 2 1

GL

My program is wrong in test#3,why??
This is my program.
program ural1078;
  const
   maxn=500;
  var
   max,num,k,i,j,n:integer;find:boolean;
   f:array[1..500,1..2] of integer;
   h,path:array[1..maxn,1..maxn] of integer;
   chu,ru:array[1..maxn] of integer;
   result:array[0..maxn] of integer;
  procedure print(s,t:integer);
    begin
      if s=t then begin result[0]:=1; result[1]:=s; end
             else begin
                    print(s,path[s,t]);
                    inc(result[0]);
                    result[result[0]]:=t;
                  end;
    end;
begin
  readln(n);
  for i:=1 to n do readln(f[i,1],f[i,2]);
  for i:=1 to n do
    for j:=1 to n do
     if i<>j
       then if (f[i,1]>=f[j,1])and(f[i,2]<f[j,2])
                 then begin
                        h[i,j]:=1;
                        inc(chu[i]);inc(ru[i]);
                        path[i,j]:=i;
                      end;
  for k:=1 to n do
    if (chu[k]<>0)and(ru[k]<>0)
       then for i:=1 to n do
             for j:=1 to n do
               if (h[i,k]+h[k,j]>h[i,j])and(h[i,k]>0)and(h[k,j]>0)
                  then begin
                         h[i,j]:=h[i,k]+h[k,j];
                         path[i,j]:=path[k,j];
                       end;
  max:=-maxint;
  for i:=1 to n do
   if (chu[i]<>0)
    then for j:=1 to n do
           if (h[i,j]+1>max)and(h[i,j]>0)
                      then begin
                             max:=h[i,j]+1;
                             print(i,j);
                           end;
  writeln(max);
  for i:=1 to max do write(result[i],' ');
end.