Cod sursa(job #2860)

Utilizator Adrian001Vladulescu Adrian Adrian001 Data 19 decembrie 2006 16:23:48
Problema Factorial Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.67 kb
program cel;
var f,g:text;
    n,p,fact,r:longint;
Begin
Assign(f,'fact.in');Reset(f);
Assign(g,'fact.out');Rewrite(g);
Read(f,p);
n:=0;
fact:=0;
While p>n do
 Begin
  inc(fact,25);
  r:=fact;
  If (r div 25) mod 5=0 then While r mod 5=0 do
                              Begin
                               r:=r div 5;
                               inc(n)
                              end
                         else inc(n,2);
  inc(n,4);
 end;
While n>p do
 Begin
  r:=fact;
  While (r mod 5=0) and (n>p) do
   Begin
    dec(n);
    r:=r div 5;
   end;
  dec(fact,5);
 end;
If n=0 then Write(g,1)
       else Write(g,fact);
Close(f);
Close(g);
end.