Cod sursa(job #218850)

Utilizator andrici_cezarAndrici Cezar andrici_cezar Data 3 noiembrie 2008 19:55:31
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.82 kb
program p1;   
var i,n,x,rad,d,y,l,j,nr:qword;   
    a:array[1..1000000] of longint;   
    f,g:text;   
begin   
     assign(f,'fractii.in');reset(f);   
     assign(g,'fractii.out');rewrite(g);   
     read(f,n);   
     a[1]:=1;   
     nr:=1;   
     for i:=2 to n do   
         begin   
              d:=2;   
              x:=i;   
              y:=x;   
		rad:=sqrt(x);
              while (d<=rad)and(x mod d>0) do d:=d+1;   
              l:=1;   
              while y mod d=0 do   
                    begin   
                         y:=y div d;   
                         l:=l*d;   
                    end;   
              l:=l div d;   
              a[i]:=a[y]* (d-1)*l;   
              nr:=nr+2*a[i];   
          end;   
     writeln(g,nr);   
     close(f);   
     close(g);   
end.