Cod sursa(job #4697)

Utilizator fogabFodor Gabor fogab Data 6 ianuarie 2007 12:29:26
Problema Sum Scor 85
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.86 kb
const k=100000;
var f,f2:text;
    a:array[2..k] of qword;
    n,x,i,j:longint;
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(f2,st);
end;
begin
for i:=2 to k do a[i]:=i;
for i:=2 to k do begin
                 if a[i]=i then begin
                                a[i]:=i-1;
                                for j:=2 to (k div i) do a[j*i]:=a[j*i]-a[j*i] div i;
                                end;
                 end;
assign(f,'sum.in');
reset(f);
readln(f,n);
assign(f2,'sum.out');
rewrite(f2);
for i:=1 to n do begin
                 readln(f,x);
                 scrie(a[x]*2*x);
                 end;
close(f);
close(f2);
end.