Cod sursa(job #218740)

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