Cod sursa(job #4990)

Utilizator Adrian001Vladulescu Adrian Adrian001 Data 9 ianuarie 2007 11:14:42
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.82 kb
Program cel;
Type vector=array[1..15000000] of boolean;
var f,g:text;
    a:vector;
    k,i,j:longint;
    stop:boolean;
Begin
Assign(f,'prim.in');Reset(f);
Assign(g,'prim.out');Rewrite(g);
Read(f,k);
For i:=2 to 1000000 do a[2*i]:=true;
i:=3;
stop:=false;
While (i<=15000000) and (not stop) do
 Begin
  If a[i]=false then Begin
                      dec(k);
                      If k=0 then Begin
                                   Write(g,i*i);
                                   stop:=true;
                                  end;
                      j:=i*i;
                      While j<=15000000 do
                       Begin
                        a[j]:=true;
                        j:=j+2*i;
                       end;
                     end;
  inc(i,2);
 end;
Close(f);
Close(g);
end.