Cod sursa(job #24994)

Utilizator AymdTrimbitas Viorel Stefan Aymd Data 4 martie 2007 08:27:19
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.52 kb
var b:array[1..1000000]of longint;
    n,x,i:longint;
    f,g:text;
    r:real;

begin
assign(f,'fractii.in');
reset(f);
assign(g,'fractii.out');
rewrite(g);
readln(f,n);
r:=n*n;
for i:=2 to n div 2 do begin
   if b[i]=0 then begin
                  x:=i*2;
                  while x<n+1 do begin
                    b[x]:=1;
                    b[i]:=b[i]+1;
                    r:=r-2*b[i];
                    x:=x+i;
                  end;
                  end;
end;
write(g,trunc(r)-n+1);
close(g);
end.