Cod sursa(job #118215)

Utilizator bogdan88Bogdan Popescu bogdan88 Data 23 decembrie 2007 18:17:06
Problema Sum Scor 85
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.99 kb
var fi,fo:text;
    phi:array[1..100000]of int64;
    x:array[1..100000]of int64;
    ap:array[1..100000]of byte;
    m,i,j,max:longint;
    rez,n:int64;
procedure scrie(k:qword);
var i,nr:longint;
    d:qword;
    st:string[15];
    c:array[1..15] of byte;
begin
  nr:=0;
  while (k>0) do
    begin
      inc(nr);
      d:=k div 10;
      c[nr]:=k-10*d+48;
      k:=d;
    end;
  for i:=nr downto 1 do
    st[nr-i+1]:=chr(c[i]);
  st[0]:=chr(nr);
  writeln(fo,st);
end;
begin
  assign(fi,'sum.in'); reset(fi);
  assign(fo,'sum.out'); rewrite(fo);
  read(fi,m);
  for i:=2 to 100000 do
    phi[i]:=i-1;
  for i:=2 to 100000 do
    if ap[i]=0 then
      begin
        j:=2;
        while i*j<=100000 do
          begin
            ap[i*j]:=1;
            phi[i*j]:=phi[i*j]-phi[i*j] div i;
            inc(j);
          end;
      end;
  for i:=1 to m do
    begin
      read(fi,n);
      rez:=n*phi[n] shl 1;
      scrie(rez);
    end;
  close(fi);
  close(fo);
end.