Cod sursa(job #133980)

Utilizator free2infiltrateNezbeda Harald free2infiltrate Data 10 februarie 2008 10:28:45
Problema Sum Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.95 kb
program sum;
type lint = 0..100000;
var i,n,j,m,x,S : lint;
    f,g : text;
    A : array [2..100000] of boolean;

procedure init;
begin
for i := 2 to 100000 do
A[i] := true;

for i := 2 to 100000 do
if A[i] then for j := 2 to 100000 div i do A[i*j] := false;

end;

function min(a,b:lint):lint;
begin
if a>b then min := b
        else min := a;
end;

function prim(x,y:lint):boolean;
var l : longint;
    ok : boolean;
begin
ok := true;

for l := 2 to min(x,y) do
if A[l] then if (x mod l = 0) and (y mod l = 0) then begin
                                ok := false;
                                break;
                                end;



prim := ok;

end;

begin

init;

assign(f,'sum.in');
reset(f);

readln(f,n);
assign(g,'sum.out');
rewrite(g);

for i := 1 to n do begin
readln(f,x);
S := 1;
for j := 2 to (2*x) do
if prim(j,x) then S := S+j;


writeln(g,S);

end;



close(f);
close(g);

end.