Cod sursa(job #252763)

Utilizator butler1234Cioc Stefan butler1234 Data 4 februarie 2009 21:34:20
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.98 kb
program bfracti;
var s,i,j,a,b,n,x,y,i1,k:longint;
     f1,f2:text;
     kb:boolean;

function prim(a,b:longint):boolean;
var pr:boolean;
begin
prim:=true;
for i1 := 2 to a do
   if (a mod i1=0) and (b mod i1=0) then
      begin
      prim:=false;
      exit;
      end;
end;

function cmmdc(a,b:longint):longint;
var r,aux: longint;
begin
{intotd a<b}
r:=a mod b;
while r<>0 do
   begin
   a:=b;
   b:=r;
   r:= a mod b;
end;
cmmdc:= b;
end;



begin
assign(f1,'fractii.in'); reset(f1);
assign(f2,'fractii.out'); rewrite(f2);
read(f1,n);
s:=2*n-1;

for i:=2 to n-1 do
  begin
  s :=s+2;
  for j:=i+2 to n do
  begin
   if ((i mod 2=0) and (j mod 2=0)) then
   else
      begin
      {for i1 := 2 to i do
         if (i mod i1=0) and (j mod i1=0) then}
           {{ if (prim(i,j)) then}
           if cmmdc(i,j)=1 then
             begin
              s:=s+2;
            end;
      end;
   end;
  end;
write(f2,s);
close(f1);
close(f2);
end.