Cod sursa(job #602455)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 11 iulie 2011 15:19:52
Problema Sum Scor 85
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.2 kb
Program sum_2;
 var n,j,x,i,max:longint;
     a:array [1..100000] of longword;
     b:array [1..100000] of longint;
     fi,fo:text;
 procedure scrie(k:int64);
    var i,nr:longint;
           d:longword;
           st:string[15];
           c:array[1..15] of byte;
 begin
  nr:=0;
  while (k>0) do
               begin
               inc(nr);
                d:=k div 10;
                 c[nr]:=k-10*d+48;
                  k:=d;
                   end;
  for i:=nr downto 1 do st[nr-i+1]:=chr(c[i]);
 st[0]:=chr(nr);
writeln(fo,st);
end;
begin
 assign(fi,'sum.in');
  assign(fo,'sum.out');
 reset(fi);
  rewrite(fo);
 readln(fi,n);
 max:=0;
 for i:=1 to n do begin
                   readln(fi,b[i]);
                   if b[i]>max then max:=b[i];
                   end;
 a[1]:=1;
 for i:=2 to max do
              a[i]:=i-1;
 for i:=2 to max div 2 do  begin
                            j:=2*i;
                             while j<=max do begin
                              a[j]:=a[j]-a[i];
                               j:=j+i;
                               end;
                                end;
 for i:=1 to n do
             scrie(a[b[i]]*b[i]*2);
 close(fo);
end.