Cod sursa(job #367790)

Utilizator aghamatMorariu Razvan aghamat Data 23 noiembrie 2009 15:38:38
Problema Fractii Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.03 kb
 program p1;  
 var a:array[1..1000000] of boolean;  
 b:array[1..1000000] of qword;  
 n,i,j,k,l:longint;f1,f2:text;m:qword;  
 begin  
  assign(f1,'fractii.in');  
 reset(F1);  
  assign(f2,'fractii.out');  
 rewrite(f2);  
readln(f1,n);  
a[1]:=true;  
 for i:=1 to n do  
    if not a[i] then  
                begin  
                j:=i;  
                while j+i<=N do  
                 begin  
              j:=j+i;  
                a[j]:=true;  
                 end;  
                end;  
m:=1;  
for i:=2 to n do  
        b[i]:=i;  
for i:=2 to n do  
        if a[i]=false then  
                        begin  
                        j:=i;  
                         while j<=n do  
                                   begin  
  
                                  b[j]:=(b[j] div i)*(i-1);  
                                    j:=j+i;  
                                     end;   end;  
  for i:=2 to n do  
          m:=m+2*b[i];  
 writeln(f2,m);  
  close(f1);  
  close(f2);  
  end.