Cod sursa(job #21728)

Utilizator floringh06Florin Ghesu floringh06 Data 24 februarie 2007 09:00:41
Problema Sum Scor 65
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.49 kb
{$IFDEF NORMAL}
  {$I-,Q-,R-,S-}
{$ENDIF NORMAL}
{$IFDEF DEBUG}
  {$I+,Q+,R+,S-}
{$ENDIF DEBUG}
{$IFDEF RELEASE}
  {$I-,Q-,R-,S-}
{$ENDIF RELEASE}

const nmax=100000;

var fi,fo:text;
    i,n,x,a,b,int:longint;
    sum:qword;
    v,p,pr:array[1..100000] of longint;



  function Euler(m:longint):longint;
    var i,j:longint;
        rez:real;
     begin
      rez:=m;
      i:=1;
      while pr[i]<=m div 2+1 do
      begin
       if pr[i]>trunc(sqrt(m)) then
        if rez=m then
         break;
       if m mod pr[i]=0 then
       begin
        rez:=rez*(1-1/pr[i]);
        inc(i);
       end
        else inc(i);
      end;
      if rez=m then rez:=rez-1;
      Euler:=trunc(rez);
     end;

  procedure generare;
   var i,j,k,t:longint;
    begin
     p[1]:=1;
     p[2]:=0;
     for i:=2 to nmax div 2+1 do
      begin
       k:=2*i;
       while k<=nmax do
        begin
         p[k]:=1;
         k:=k+i;
        end;
      end;
      t:=1;
     for i:=2 to nmax do
      if p[i]=0 then
       begin
        pr[t]:=i;
        inc(t);
       end;
//      writeln(fo,t);
    end;


  procedure scor(a:longint);
   var i,j,k,phi:longint;
    begin
     phi:=Euler(x);
     sum:=2*x;
     sum:=sum*phi;
     writeln(fo,sum);
    end;



begin
 assign(fi,'sum.in'); reset(fi);
 assign(fo,'sum.out'); rewrite(fo);
 generare;
 readln(fi,n);
 for i:=1 to n do
  begin
   readln(fi,x);
   scor(x);
  end;
close(fi);
close(fo);
end.