Cod sursa(job #380163)

Utilizator vasilepopescuVasile Popescu vasilepopescu Data 4 ianuarie 2010 22:37:26
Problema Factorial Scor 25
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.82 kb
var p,m5,exp:longint;
    n:int64;
    f,g:text;
    a:array[1..1000] of longint;
procedure determina;
 begin
  m5:=5;
  exp:=0;
  while m5<5*p do
   begin
    inc(exp);
    a[exp]:=m5;
    m5:=m5*5;
   end;
  end;
procedure calcul;
 var i,c,j,k:longint;
     gasit:boolean;
 begin
  i:=1;
  n:=5;
  while i<p do
   begin
    n:=n+5;
    c:=0;
    k:=exp;
    gasit:=false;
    while not gasit and (k>=2) do
     if n mod a[k] =0 then
      begin
       c:=c+k;
       gasit:=true
      end
     else
       dec(k);
    if c=0 then
     i:=i+1
    else
     i:=i+c
   end;
  if i>p then
   n:=-1;
  if p=0 then
    n:=1;
  end;
begin
 assign(f,'fact.in');
 reset(f);
 readln(f,p);
 close(f);
 determina;
 calcul;
 assign(g,'fact.out');
 rewrite(g);
 write(g,n);
 close(g);
end.