Cod sursa(job #251020)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 1 februarie 2009 17:11:10
Problema Patrate2 Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.33 kb
program alex;
var f:text;
    c:array[1..10000]of integer;
    k,d,z,n,i,j,c1,r:longint;
begin
assign(f,'patrate2.in');reset(f);
readln(f,n);
close(f);
c1:=n*n div 20;
r:=n*n mod 20;
k:=1;
c[1]:=1;
for j:=1 to c1 do
    begin
d:=0;
for i:=1 to k do
    begin
    z:=c[i];
    c[i]:=(c[i]*1048576+d)mod 10;
    d:=(z*1048576+d)div 10;
    end;
if d<>0 then begin
             while d<>0 do
                   begin
                   k:=k+1;
                   c[k]:=d mod 10;
                   d:=d div 10;
                   end;
             end;
     end;
for j:=1 to r do
    begin
d:=0;
for i:=1 to k do
    begin
    z:=c[i];
    c[i]:=(c[i]*2+d)mod 10;
    d:=(z*2+d)div 10;
    end;
if d<>0 then begin
             k:=k+1;
             c[k]:=d;
             end;
      end;

d:=0;
for j:=2 to n do
    begin
    d:=0;
    for i:=1 to k do
        begin
        z:=c[i];
        c[i]:=(c[i]*j+d)mod 10;
        d:=(z*j+d)div 10;
        end;
     if d<>0 then begin
                  while d<>0 do
                        begin
                        k:=k+1;
                        c[k]:=d mod 10;
                        d:=d div 10;
                        end;
                  end;
    end;
assign(f,'patrate2.out');rewrite(f);
for i:=k downto 1 do
    write(f,c[i]);
close(f);
end.