Why this WA, Plz Help!
----------------------------------------------------------------------
program a1218;

const
     max=502;

type
    xlist=integer;
    list=array[1..max]of xlist;
    atype=array[1..3]of list;
    gtype=array[1..max,1..max]of integer;
    ctype=array[1..max]of integer;

var
   name:array[1..max]of string;
   a:atype;
   b:list;
   g:gtype;
   c:ctype;
   i,j,n,j1,k:integer;
   s:shortint;
   st1,st2:string;
   ti:boolean;

procedure qsort(var a : ctype;lo,hi:integer);

    procedure sort(l,r: longint);
      var
         i,j,x,y: longint;
      begin
         i:=l;
         j:=r;
         x:=a[(l+r) div 2];
         repeat
           while a[i]<x do
            inc(i);
           while x<a[j] do
            dec(j);
           if not(i>j) then
             begin
                y:=a[i];
                a[i]:=a[j];
                a[j]:=y;
                inc(i);
                j:=j-1;
             end;
         until i>j;
         if l<j then
           sort(l,j);
         if i<r then
           sort(i,r);
      end;

    begin
       sort(lo,hi);
    end;

function inarr(x:integer;var s:integer;t:integer):boolean;
         var
            i,s1,t1:integer;
         begin
              s1:=s;t1:=t;inarr:=false;
              for i:=s1 to t1 do if c[i]=x then begin
                  s:=i;
                  inarr:=true;
                  exit;
              end;
         end;

procedure printf(s,t:integer);
          var
             i:integer;
          begin
               qsort(c,s,t);
               for i:=s to t do writeln(name[c[i]]);
          end;

procedure findcyc(x,dep:integer);
          begin
               for i:=1 to b[x] do begin
                   j:=1;
                   if inarr(g[x,i],j,dep) then begin
                      printf(j,dep);
                      halt;
                   end else begin
                       inc(dep);
                       c[dep]:=g[x,i];
                       findcyc(g[x,i],dep);
                       c[dep]:=0;
                       dec(dep);
                   end;
               end;
          end;

begin

     fillchar(a,sizeof(a),0);

     readln(n);
     for i:=1 to n do begin
         readln(st1);
         st2:='';
         for j:=1 to length(st1) do
             if st1[j]<>' ' then st2:=st2+st1[j] else break;
         name[i]:=st2;
         j1:=j;k:=0;
         for j:=j1 to length(st1) do if st1[j]=' ' then inc(k) else a
[k][i]:=a[k][i]*10+ord(st1[j])-48;
     end;

     fillchar(b,sizeof(b),0);
     for i:=1 to n do
         for j:=1 to n do begin
             s:=0;
             for k:=1 to 3 do if a[k][j]>a[k][i] then s:=s+1;
             if s>=2 then begin
                inc(b[i]);
                g[i,b[i]]:=j;
             end;
         end;

     ti:=true;
     for i:=1 to n do
         if b[i]=0 then begin
            writeln(name[i]);
            ti:=false;
         end;

     if ti then begin
        c[1]:=1;
        findcyc(1,1);
     end;

end.