Cod sursa(job #210811)

Utilizator mlazariLazari Mihai mlazari Data 29 septembrie 2008 16:17:50
Problema Patrate2 Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.11 kb
Program Patrate2;
const nmax=1900;
type Numar=array[1..nmax] of int64;
var n : byte;
    rez : Numar;

procedure Citeste;
var Intrare : text;
begin
  assign(Intrare,'patrate2.in');
  reset(Intrare);
  read(Intrare,n);
  close(Intrare);
end;

procedure Inmulteste(var x : Numar; k : byte);
var i : integer;
begin
  for i:=1 to nmax do x[i]:=x[i]*k;
  for i:=nmax downto 2 do
   begin
     x[i-1]:=x[i-1]+x[i] div 10;
     x[i]:=x[i] mod 10;
   end;
end;

procedure Calculeaza;
var i : integer;
begin
  for i:=1 to nmax-1 do rez[i]:=0;
  rez[nmax]:=1;
  for i:=2 to n do Inmulteste(rez,i);
  for i:=1 to n*n div 10 do Inmulteste(rez,1024);
  for i:=1 to n*n mod 10 do Inmulteste(rez,2);
end;

procedure Afiseaza(var f : text; var x : Numar);
var i,k : integer;
begin
  k:=1;
  while (x[k]=0) and (k<nmax) do k:=k+1;
  if x[k]=0 then write(f,0)
   else
    for i:=k to nmax do write(f,x[i]);
end;

procedure Scrie;
var Iesire : text;
begin
  assign(Iesire,'patrate2.out');
  rewrite(Iesire);
  Afiseaza(Iesire,rez);
  close(Iesire);
end;

begin
  Citeste;
  Calculeaza;
  Scrie;
end.