Cod sursa(job #216462)

Utilizator Tase_CCapalna Tanase Tase_C Data 24 octombrie 2008 17:41:58
Problema Sum Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.7 kb
const max=10;
var v,a,b,p:array[1..max] of longint;
    t,nr,i,j,n,x,d,k:longint;
    s:int64;
begin
  assign(input,'sum.in'); reset(input);
  assign(output,'sum.out'); rewrite(output);
  readln(n);
  for i:=2 to trunc(sqrt(max)) do
    if p[i]= 0 then
      for j:=1 to max div i do p[i*j]:=i;
  for i:=2 to max do
    if p[i]=0 then p[i]:=i;
  for i:=2 to max do begin
    b[i]:=i div p[i];a[i]:=p[i]; k:=p[i];
    while b[i] mod k=0 do begin
      b[i]:=b[i] div k; a[i]:=a[i]*k;
    end;
    if (b[i]=1) then v[i]:=i-i div k
    else v[i]:=v[a[i]]*v[b[i]];
  end;

  for t:=1 to n do begin
    readln(x); s:=1;
    s:=s*x*2*v[x];
    writeln(s);
  end;
  close(input); close(output);
end.