program pigauss;
 {10000 Stellen von pi mit der Gauss-Formel}
 {pi=48*atn(1/38)+80*atn(1/57)+28*atn(1/239)+96*atn(1/268)}

 uses crt,dos;
 const n=10005;    {5 Sicherheitsstellen}
 var i,j,k,m,nr,di:integer;
     c,d,q,u,x:word;
     a:array[1..2,1..n] of word;
     ch:char;

 procedure divi(y:word);
 begin
  c:=0;for j:=1 to n+1 do
  begin x:=a[nr,j]+c;q:=x div y;a[nr,j]:=q;
  d:=x-y*q;c:=10*d;end;
 end;

 procedure mult(y:word);
 begin
  for j:=1 to n+1 do a[nr,j]:=y*a[nr,j];
  for j:=n+1 downto 2 do
  begin u:=a[nr,j] div 10;a[nr,j-1]:=a[nr,j-1]+u;
  a[nr,j]:=a[nr,j] mod 10;end;
 end;

 procedure atn;
 begin
  a[nr,1]:=1;k:=trunc(n*ln(10)/ln(m)/2);
  for i:=k downto 1 do
  begin
   divi(2*i+1);mult(2*i-1);divi(m);divi(m);
   for j:=2 to n-1 do a[nr,j]:=9-a[nr,j];
   a[nr,n]:=10-a[nr,n];
  end;
  divi(m);
 end;

 procedure addi;
 begin
  for i:=n downto 2 do
   begin
    a[1,i]:=a[1,i]+a[2,i];u:=a[1,i]div 10;
    a[1,i-1]:=a[1,i-1]+u;
   end;
  for i:=1 to n do a[1,i]:=a[1,i] mod 10;
  end;

  procedure warten;
  begin
   writeln;writeln;
   write(i-1,' Stellen. ');
   if (i<n-4) then write('Weiter mit der Leertaste.')
   else write('Zurueck zum Programm mit der Leertaste.');
   repeat ch:=readkey until ch=' ';
   clrscr;writeln;
  end;

  Begin
   clrscr;writeln('Berechnet werden 10000 Stellen von Pi.');
   writeln('Bitte (bei 500 MHz Taktfrequenz) eine Minute warten!');
   nr:=1;m:=38;atn;mult(12);nr:=2;m:=57;atn;mult(20);addi;
   m:=239;atn;mult(7);addi;m:=268;atn;mult(24);addi;
   nr:=1;mult(4);clrscr;writeln('3.');
   for i:=2 to n-4 do
   begin
    write(a[1,i]);if i=1 then write('.');
    if (i-1) mod 4=0 then write(' ');
    if (i-1) mod 1000=0 then warten;
   end;
  End.
 
  
 
 
 
 
 
 
 
 
 
 
 
 
 
 
_