i've time limit extided tese#7.
i don't know other methods!!
please help me,
here is code :

  var
    a : array [1..1000] of word;
    j, k, x : integer;
    i, n : word;
    b : array [1..1000] of integer;

begin
   read(n);
   for i := 1 to n do
     read(a[i]);

   for i := 1 to n do
     begin
       j := 0;   x := i;
       repeat
         inc(j);
         x := a[x];
       until x = i;
       b[i] := j;
     end;

   for i := 1 to n - 1 do
     if b[i] <> 1 then   begin
     for j := i + 1 to n do
     if b[i]=b[j] then b[j] := 1;
       x := b[i] div 2;
       j := 2;

       repeat
         if b[i]mod j=0 then
           begin
             for k := i + 1 to n do
               if b[k]mod j = 0 then b[k] := b[k] div j;
           end
         else inc(j);
       until j >= x;

     end;
     k := 1;
     for i := 1 to n do
     k := k * b[i];
     writeLn(k);
end.