Cod sursa(job #252152)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 3 februarie 2009 22:25:52
Problema Sum Scor 85
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.19 kb
program alex;
var f,g:text;
    c:array[1..200005]of integer;
    p:array[1..100000]of longint;
    k,i,j,x,n,z,y:longint;
    s:int64;
begin
k:=1;
p[1]:=2;
i:=3;
repeat
if c[i]=0 then begin
               k:=k+1;
               p[k]:=i;
               if i<40000 then y:=i*i
                          else y:=i;
               while y<=100000 do
                     begin
                     c[y]:=1;
                     y:=y+i;
                     end;
               end;
i:=i+2;
until(i>=100000);
assign(f,'sum.in');reset(f);
assign(g,'sum.out');rewrite(g);
readln(f,n);
for i:=1 to n do
    begin
    readln(f,x);
    j:=1;
    s:=x;
    z:=x;
    while(p[j]*p[j]<=x)and(x<>1)do
         begin
         if x mod p[j]=0 then begin
                              s:=s div p[j];
                              s:=s*(p[j]-1);
                              while x mod p[j]=0 do
                                    x:=x div p[j];
                              end;
         j:=j+1;
         end;
    if x>1 then begin
                s:=s div x;
                s:=s*(x-1);
                end;
    s:=s*z*2;
    writeln(g,s);
    end;
close(f);
close(g);
end.