Cod sursa(job #602417)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 11 iulie 2011 13:45:54
Problema Sum Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1 kb
Program sum_2;
 var n,i,j,l,x:longint;
     a:array [1..200000] of longint;
     fi,fo:text;
 procedure scrie(k:qword);
  var i,nr:longint;
         d:qword;
         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(st);
end;
begin
 assign(fi,'sum.in');
  assign(fo,'sum.out');
 reset(fi);
  rewrite(fo);
 readln(fi,n);
 for i:=1 to 200000 do
                    a[i]:=i-1;
 for i:=2 to 100000 do  begin
                         j:=2*i;
                          while j<=200000 do begin
                            a[j]:=a[j]-a[i];
                              j:=j+i;
                               end;
                                end;
 for i:=1 to n do begin
                   readln(fi,x);
                   scrie(a[x]*x*2);
                   end;
 close(fo);
end.