Cod sursa(job #70362)

Utilizator raduzerRadu Zernoveanu raduzer Data 5 iulie 2007 17:15:44
Problema Sarpe Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.84 kb
type numar=array[0..1010]of integer;
var a,b,c:array[0..1010]of integer;
    i,j,z:integer;
    s:char;

procedure scade(var a:numar);
var i,t:integer;
begin
     t:=1;
     i:=0;
     while t>0 do
     begin
          inc(i);
          a[i]:=a[i]-t;
          t:=0;
          if a[i]=-1 then
          begin
               t:=1;
               a[i]:=9;
          end;
     end;
     if a[a[0]]=0 then dec(a[0]);
end;

procedure inmulteste(a,b:numar; var c:numar);
var i,j,t:integer;
begin
     for i:=1 to c[0] do c[i]:=0;
     for i:=1 to a[0] do
     begin
          t:=0;
          j:=0;
          while (j<b[0])or(t>0) do
          begin
               inc(j);
               c[i+j-1]:=c[i+j-1]+a[i]*b[j]+t;
               t:=c[i+j-1] div 10;
               c[i+j-1]:=c[i+j-1]mod 10;
               if i+j-1>c[0] then c[0]:=i+j-1;
          end;
     end;
end;

procedure add;
var i,t:integer;
begin
     t:=4;
     i:=0;
     while t>0 do
     begin
          inc(i);
          c[i]:=c[i]+t;
          t:=c[i] div 10;
          c[i]:=c[i] mod 10;
     end;
end;

begin
     assign(input,'sarpe.in');
     reset(input);
     assign(output,'sarpe.out');
     rewrite(output);
     while not eoln do
     begin
          read(s);
          if s=' ' then break;
          inc(a[0]);
          a[a[0]]:=ord(s)-ord('0');
          b[0]:=a[0];
          b[b[0]]:=a[a[0]];
     end;
     for i:=1 to a[0] div 2 do
     begin
          z:=a[i];
          a[i]:=a[a[0]+1-i];
          a[a[0]+1-i]:=z;
          z:=b[i];
          b[i]:=b[b[0]+1-i];
          b[b[0]+1-i]:=z;
     end;
     scade(b);
     inmulteste(a,b,c);
     b[0]:=1;
     b[1]:=2;
     for i:=1 to c[0] do a[i]:=c[i];
     a[0]:=c[0];
     inmulteste(a,b,c);
     add;
     for i:=c[0] downto 1 do write(c[i]);
close(output);
end.