Cod sursa(job #52911)

Utilizator ProtomanAndrei Purice Protoman Data 20 aprilie 2007 11:56:20
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.02 kb
type sir=array[1..1000000] of integer;

var n,nr,i,g,k,h,t,j:longint; f1,f2:text; v:sir; a,b:array[1..1000000] of longint;

{procedure ciur(b:longint);
var i,j:longint;
begin
        i:=1;
        while ((i*i) shl 1)+(i shl 1)<=b do
        begin
                if v[i shr 3] and (1 shl (i and 7))=0 then
                begin
                        j:=((i*i)shl 1)+(i shl 1);
                        while 2*j+1<=b 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;
        i:=0;
        x[1]:=2;
        x[0]:=1;
        while 2*i+1<=n do
        begin
                inc(i);
                if v[i shr 3] and (1 shl (i and 7))=0 then
                begin
                        inc(x[0]);
                        x[x[0]]:=2*i+1;
                end;
        end;
end;
}

procedure Ciur;
begin
for i:=2 to n do begin
                if v[i]=0 then begin
                        j:=0;
                        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[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 g:=2 to n do
        begin
                nr:=nr+a[g]*2;
        end;
        writeln(f2,nr);
        close(f1);
        close(f2);
end.