Cod sursa(job #218852)

Utilizator andrici_cezarAndrici Cezar andrici_cezar Data 3 noiembrie 2008 19:56:15
Problema Fractii Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.08 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.