Cod sursa(job #70175)

Utilizator MDanFMI - Dan Moldovan MDan Data 4 iulie 2007 23:58:17
Problema Fractii Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.91 kb
Var f,g:text;
ok:boolean;
i,b,j,n,c,s:longint;
a:array [1..1000000] of boolean;
begin
assign (f,'fractii.in');
assign (g,'fractii.out');
reset(f);
rewrite(g);
readln (f,n);
for i:=2 to n do
    begin
    j:=2;
    while (a[i]=false) and (j<=trunc(sqrt(i))) do
    begin
    if i mod j=0
    then
        a[i]:=true;
    j:=j+1;
    end;
    end;
s:=n+n-1;
for i:=2 to n-1 do
    for j:=i+1 to n do
    begin
    if (i mod j<>0) and (j mod i<>0)
    then
        begin
        if (a[i]=false) or (a[j]=false)
        then
            s:=s+2
        else
            begin
            b:=i;
            c:=j;
            while b<>c do
            if b<c
            then
                c:=c-b
            else
                b:=b-c;
            if b=1
            then
                s:=s+2;
            end;
        end
    end;



writeln (g,s);
close(f);
close(g);
end.