Cod sursa(job #117966)

Utilizator bogdan88Bogdan Popescu bogdan88 Data 22 decembrie 2007 21:31:52
Problema Sum Scor 75
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.31 kb
var fi,fo:text;
    n,ct,m,l:longint;
    phi:int64;
    prime2:array[1..100000]of byte;
    primee:array[1..30000]of longint;
procedure gen(ba:longint);
var i,j:int64;
begin
  i:=3;
  primee[1]:=2;
  l:=1;
  prime2[1]:=1;
  while i<=ba do
    begin
      if prime2[i]=0 then
        begin
          j:=i*i;
          inc(l);
          primee[l]:=i;
          while j<=ba do
             begin
                prime2[j]:=1; inc(j,i);
             end;
        end;
      inc(i,2);
    end;
end;
procedure solv(n:int64);
var i:longint;
    r,rez:int64;
begin
  ct:=n; phi:=1;
  for i:=1 to l do
    begin
      if n mod primee[i]=0 then
        begin
          r:=1;
          while n mod primee[i]=0 do
            begin
              n:=n div primee[i];
              r:=r*primee[i];
            end;
          phi:=phi*(primee[i]-1)*r div primee[i];
        end;
      if n=1 then break;
    end;
  if n>1 then
     phi:=phi*(n-1);
  rez:=ct*phi shl 1;
  writeln(fo,rez);
end;
var i:longint;
begin
  assign(fi,'sum.in'); reset(fi);
  assign(fo,'sum.out'); rewrite(fo);
  read(fi,m);
  gen(100000);
  for i:=1 to m do
    begin
      read(fi,n);
      if (prime2[n]=0)and(n and 1=1) then writeln(fo,(n-1) shl 1 * n) else
      solv(n);
    end;
  close(fi);
  close(fo);
end.