Cod sursa(job #37077)

Utilizator cheery_g1rlHaller Emanuela cheery_g1rl Data 24 martie 2007 16:29:28
Problema Sum Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.05 kb
type rez=0..5000050000;
var f,g:text;
    s:rez;
    n,x,y,q,a,b,i,j:longint;
    v:array[1..200000] of 0..1;
begin
assign(f,'sum.in');
reset(f);
readln(f,n);
assign(g,'sum.out');
rewrite(g);
for i:=1 to n do
  begin
    readln(f,x);
    s:=0;
    y:=2*x;
    for j:=1 to y do begin v[j]:=0;s:=s+j;end;
    if x mod 2=0 then
       begin
         while x mod 2=0 do x:=x div 2;
         s:=s-2;
         q:=2;v[2]:=1;
         while q*2<=y do
            begin
              s:=s-q*2; v[2*q]:=1;
              inc(q);
            end;

       end;
    a:=3;
    while x<>1 do
       begin
         if x mod a=0 then
            begin
              while x mod a=0 do x:=x div a;
              s:=s-a;
              q:=2;
              while q*a<=y do
                 begin
                   if v[a*q]=0 then begin
                   s:=s-q*a;             v[a*q]:=1; end;
                   inc(q);
                 end;
            end;
         inc(a,2);
       end;
     writeln(g,s);
  end;

close(f);
close(g);
end.