Cod sursa(job #493405)

Utilizator PlayLikeNeverB4George Marcus PlayLikeNeverB4 Data 18 octombrie 2010 00:38:10
Problema Ciurul lui Eratosthenes Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.52 kb
program ciurul_lui_eratostene;
const MAX=2000000;
var f,g:text; i,j,n,S:0..MAX; prim:array[1..MAX] of 0..1;
begin
Assign(f,'ciur.in'); Reset(f);
Assign(g,'ciur.out');Rewrite(g);
Read(f,n); Close(f);
i:=2;
While i<=trunc(sqrt(n)) do
 begin
 prim[i]:=1;
 inc(i);
 end;
i:=2;
While i<=trunc(sqrt(n)) do
 begin
 While (prim[i]=0)and(i<=trunc(sqrt(n))) do inc(i);
 j:=2;
 Repeat
  prim[i*j]:=0;
  inc(j);
 Until i*j>n;
 inc(i);
 end;
S:=0;
For i:=2 to n do
 If prim[i]=1 then inc(S);
Write(g,S); Close(g);

end.