Cod sursa(job #345285)

Utilizator energizerBunnyCicu Mihai energizerBunny Data 2 septembrie 2009 14:18:07
Problema Fractii Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.54 kb
Program fractii;
var
 p,q,n,s: longint;
 f: text;
Function cmmdc(a,b:longint):longint;
 Begin
   while a<>b do
    if a>b then
     a:=a - b
    else b:=b - a;
   cmmdc:=a;
 End;

Begin
  assign(f,'fractii.in');
  reset(f);
  read(f,n);
  close(f);

  s:=n + (n - 1);
  p:=2;
  while p < n do Begin
    for q:= p+1 to n do
     if not((p mod 2 = 0) and (q mod 2 = 0)) then
     if (cmmdc(p,q) = 1) then
       s := s + 2;
    inc(p);
  End;
  
  assign(f,'fractii.out');
  rewrite(f);
  write(f,s);
  close(f);
End.