Cod sursa(job #53051)

Utilizator ProtomanAndrei Purice Protoman Data 20 aprilie 2007 19:37:25
Problema Fractii Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.11 kb
var nr,j:qword; f1,f2:text; a,b,v:array[0..10000001] of qword; i,n:longint;

procedure Ciur;
begin
for i:=2 to n do begin
                if v[i]=0 then begin
                        j:=i;
                        a[i]:=i-1;
                        while j+i<=n do begin
                                j:=j+i;
                                inc(v[j]);
                                b[j]:=b[j] div i;
                                a[j]:=a[j]*a[i];
                                while (b[j] mod i=0)and(b[j]<>1) do begin
                                        b[j]:=b[j] div i;
                                        a[j]:=a[j]*i;
                                end;
                        end;
                end;
end;
end;

begin
        assign(f1,'fractii.in');
        reset(f1);
        assign(f2,'fractii.out');
        rewrite(f2);
        read(f1,n);
        nr:=1;
        for i:=2 to n do begin a[i]:=1; b[i]:=i; end;
        ciur;
        for i:=2 to n do
        begin
                nr:=nr+a[i]*2;
        end;
        writeln(f2,nr);
        close(f1);
        close(f2);
end.