Cod sursa(job #141042)

Utilizator RichiUngur Richard-Alex Richi Data 22 februarie 2008 18:13:42
Problema Sum Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.55 kb
var v:array[1..200000] of longint;
    i,n,x,j,l,d:longint;
begin
  assign(input,'sum.in');reset(input);
  assign(output,'sum.out'); rewrite(output);
  readln(n);
  for i:=1 to n do begin
    readln(x); l:=2*x;
    for j:=1 to l do v[j]:=j;
    d:=2;
    while (x>1) do begin
      while (x mod d<>0)and(d*d<=x) do inc(d);
      if (d*d>x) then d:=x;
      for j:=1 to l div d do v[j*d]:=0;
      while (x mod d=0)do x:=x div d;
    end;
    x:=0;
    for j:=1 to 2*l do x:=x+v[j];
    writeln(x);
  end;
  close(input); close(output);
end.