Cod sursa(job #53090)

Utilizator MDanFMI - Dan Moldovan MDan Data 20 aprilie 2007 21:47:36
Problema Fractii Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.9 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 (a[i]=false) or (a[j]=false)
    then
        begin
        if (i mod j<>0) and (j mod i<>0)
        then
            s:=s+2;
        end
    else
        if (i mod j<>0) and (j mod i<>0)
        then
        begin
        c:=i;
        b:=j;
        while c<>b do
        if c<b
        then
            b:=b-c
        else
            c:=c-b;
        if c=1
        then
        s:=s+2;
        end;
    end;



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