Cod sursa(job #174592)

Utilizator free2infiltrateNezbeda Harald free2infiltrate Data 8 aprilie 2008 23:54:59
Problema Fractii Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.9 kb
program fratii;
var n,S,Sp,i,j,k,l : longint;
    f,g : text;
    A,B,C : array [1..1000000] of boolean;
begin
assign(f,'fractii.in');
reset(f);
assign(g,'fractii.out');
rewrite(g);

read(f,n);

for i := 1 to n do
A[i] := true;
B := A;

for i := 2 to n do
if A[i] then for j := 2 to n div i do A[i*j] := false;



S := n;

for i := 2 to n do begin

Sp := n;
k := i;
C  := B;

for j := 2 to i do
if A[j] then
            if k mod j=0 then begin
                              while k mod j = 0 do k := k div j;

                              for l := 1 to n div j do
                              if C[l*j] then begin
                                           C[l*j] := false;
                                           Sp := Sp-1;
                                           end;
                              end;
S := S+Sp;


end;


write(g,S);

close(f);
close(g);

end.