Cod sursa(job #118245)

Utilizator bogdan88Bogdan Popescu bogdan88 Data 23 decembrie 2007 22:06:33
Problema Sum Scor 85
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.67 kb
var fi,fo:text;
    v,u:array[1..100001] of int64;
    n:int64;
procedure ciur;
var i,j:longint;
begin
  for i:=2 to 100001 do
    v[i]:=i;
  for i:=2 to 100001 do
    if u[i]=0 then
      begin
        j:=2;
        dec(v[i]);
        while i*j<=100001 do
          begin
            u[i*j]:=1;
            v[i*j]:=v[i*j]-v[i*j] div i;
            inc(j);
          end;
      end;
end;
var x,sol,t:int64;
    i:longint;
begin
  assign(fi,'sum.in'); reset(fi);
  assign(fo,'sum.out'); rewrite(fo);
  ciur;
  read(fi,t);
  for i:=1 to t do
    begin
      read(fi,x);
      sol:=2*v[x]*x;
      writeln(fo,sol);
    end;
  close(fi);
  close(fo);
end.