Cod sursa(job #218737)

Utilizator andrici_cezarAndrici Cezar andrici_cezar Data 3 noiembrie 2008 13:06:25
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.81 kb
  program p1;  
  var i,n,x,d,y,l,j,nr:longint;  
       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 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.