Cod sursa(job #29334)

Utilizator maria_pparcalabescu maria daniela maria_p Data 9 martie 2007 07:57:33
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.21 kb
var f,g:text;
    v,b:array[0..10000]of longint;
    nr,i,n,j,nr1:longint;
begin
assign(f,'fractii.in');reset(f);
assign(g,'fractii.out');rewrite(g);
readln(f,n);
i:=1;
while ((i*i)shl 1)+(i shl 1)<=n do
      begin
      if(v[i shr 3]shr (i and 7))and 1=0 then begin
                                              j:=((i*i)shl 1)+(i shl 1);
                                              while 2*j+1<=n do
                                                    begin
                                                    v[j shr 3]:=v[j shr 3]or(1 shl(j and 7));
                                                    j:=j+(i shl 1)+1;
                                                    end;
                                              end;
      inc(i);
      end;
b[0]:=1;
b[1]:=2;
for i:=1 to n do
    if(v[i shr 3]shr(i and 7))and 1=0 then
                 if 2*i+1<=n then begin
                                  inc(b[0]);
                                  b[b[0]]:=2*i+1;
                                  end;
nr:=n;
for i:=2 to n do
    begin
    nr1:=n;
    for j:=1 to b[0] do
        if i mod b[j]=0 then nr1:=nr1-n div b[j]+1;
    nr:=nr+nr1-1;
    end;
writeln(g,nr);
close(f);
close(g);
end.