My program works perfectly, but it got CE.
  Please tell me why.

Here is my program:

 var n,i,j,kol:integer;
    res:longint;
    a,p:array [1..1000] of integer;
    b:array [1..1000] of boolean;


Procedure init;
 Begin
  fillchar(b,sizeof(b),false);
   readln(n);
   for i:=1 to n do read(a[i]);
End;


Function min(x,y:longint):longint;
 Begin
  if x<y then min:=x else min:=y
End;


Function max(x,y:longint):longint;
 Begin
  if x>y then max:=x else max:=y
End;


Function NOK_(x,y:longint):longint;
 Begin
  NOK_:=1;
   if x mod y=0 then NOK_:=x else

    Begin
     for i:=2 to y do
      if (x mod i=0) and (y mod i=0) then
        begin
         NOK_:=NOK_*i;
         x:=x div i;
         y:=y div i;
        end;
      NOK_:=NOK_*x*y;
    End;
End;


Procedure main;
 Begin

 For i:=1 to n do
  if not b[i] then Begin
   j:=i; kol:=0;

   repeat
    j:=a[j];
    b[j]:=true;
    kol:=kol+1;
   until j=i;

   for j:=1 to n do
    if b[j] and (p[j]=0) then p[j]:=kol;

  End;

   res:=p[1];
   for i:=2 to n do res:=NOK_(max(res,p[i]),min(res,p[i]));

End;


Procedure out;
 Begin
  write(res);
End;


BEGIN

 init;  main;  out;

END.

On FPC 1.0.4 your program are compiled normally. I don't know, which version here.