Cod sursa(job #810420)

Utilizator t.g.g.tt.g.g.t t.g.g.t Data 10 noiembrie 2012 12:07:12
Problema Sum Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.93 kb
const max=100000;
var a:array[1..100000]of byte; sf:int64;  i,j:longint;n,t,nr,pr,t1:int64; buf1,buf2:array[1..1 shl 16]of char;
begin
for i:=2 to 500 do begin if a[i]=0 then begin j:=i*i; while j<=max do begin a[j]:=1; j:=j+i; end end; end;
assign(input,'sum.in'); reset(input); settextbuf(input,buf1);
assign(output,'sum.out'); rewrite(output); settextbuf(output,buf2);
readln(n);
for i:=1 to n do
  begin
    readln(t);t1:=t;
    j:=2; sf:=1;
    while (t>1) and (j<=(t div 2)) do
      begin
        if a[j]=0 then
          begin
            nr:=0; pr:=1;
            if (t mod j=0) then
             while (t mod j=0) do
             begin
             inc(nr);
             t:=t div j;
             pr:=pr*j
             end;
            if nr>0 then begin sf:=sf*(j-1)*(pr div j) end;
          end;
        inc(j);
      end;
    if t>1 then begin if sf=0 then sf:=1; sf:=sf*(t-1); end;
    sf:=sf*2*t1;
    writeln(sf);
  end;
close(output);
end.