Cod sursa(job #218847)

Utilizator andrici_cezarAndrici Cezar andrici_cezar Data 3 noiembrie 2008 19:50:02
Problema Fractii Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.96 kb
program p1;   
var i,n,x,d,y,l,rad,j:longint;   
    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:=trunc(sqrt(x));   
  
            while (d<=rad)and(x mod d>0) do d:=d+1;   
  
            if d>rad then a[i]:=i-1   
            else   
                begin   
                 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;   
                end;   
             nr:=nr+2*a[i];   
        end;   
    writeln(g,nr);   
    close(f);   
    close(g);   
end.