home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / interpre / p_pascal / samples / pi.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-05-03  |  2.5 KB  |  142 lines
  1. { PROGRAM SUBMITTED BY MAKOTO YAMAGIWA }
  2. program pi(input, output);
  3. { TURNING THE LISTING ON AND OFF WITHIN A PROGRAM: }
  4. (*$c+,l-*)
  5. const
  6.  maxsize = 200;
  7.  size2 = 201;
  8.  radix = 10;
  9.  r1 = 1425;
  10.  r2 = 419;
  11. type
  12.  dig = array[0 : size2] of integer;
  13.  var
  14.  s, p1, p2 : dig;
  15.  i, q, npi, sz, sz1 : integer;
  16.  
  17. procedure zero(var a: dig);
  18. var i : integer;
  19. begin
  20.   for i:=0 to size2 do a[i] := 0;
  21.   a[sz1] := -1
  22. end;
  23.  
  24. procedure add(var a, b : dig);
  25. var i : integer;
  26.  c, t : integer;
  27. begin
  28.  c := 0; i := sz;
  29.  repeat
  30.   t := a[i] + b[i] + c;
  31.   if t >= radix then
  32.    begin
  33.     a[i] := t - radix;
  34.     c := 1
  35.    end
  36.   else
  37.    begin
  38.     a[i] := t;
  39.     c := 0
  40.    end;
  41.  i := i-1;
  42.  until (i < q) and (c = 0);
  43. end;
  44.  
  45. procedure sub(var a, b : dig);
  46. var i : integer;
  47.     c,t : integer;
  48. begin
  49.  c := 0; i := sz;
  50.  repeat
  51.   t := a[i] - b[i] - c;
  52.   if t < 0 then
  53.    begin
  54.     a[i] := t + radix;
  55.     c := 1
  56.    end
  57.   else
  58.    begin
  59.     a[i] := t;
  60.     c := 0
  61.    end;
  62.   i := i - 1;
  63.  until (i < q) and (c = 0)
  64. end;
  65.  
  66. procedure divide(var a, b : dig; n : integer);
  67. var i : integer;
  68.  r, t : integer;
  69. begin
  70.  while p1[q] = 0 do
  71.   begin
  72.    p2[q] := 0;
  73.    q := q + 1
  74.   end;
  75.  r := 0;
  76.  for i:=q to sz do
  77.   begin
  78.    t := b[i] + r * radix;
  79.    a[i] := t div n;
  80.    r := t mod n
  81.   end
  82. end;
  83.  
  84. (*$l+*)
  85. { - TURNING THE LISTING ON AND OFF IN A PROGRAM - }
  86. { -- main routine -- }
  87.  
  88. begin
  89.  writeln(
  90.  'Calculate Pi to your specified precision (up to 200 digits);'
  91.  ); write(
  92.  'Enter the number of digits to follow the decimal point: ');
  93.  read(sz);
  94.  writeln('Working, please wait...');
  95.  writeln; writeln;
  96.  sz1 := sz + 1;
  97.  zero(s); zero(p1);
  98.  q := 0;
  99.  p1[0] := 80;
  100.  i := 1;
  101.  while i < r1 do
  102.   begin
  103.    divide(p1,p1,25);
  104.    divide(p2,p1,i);
  105.    add(s,p2);
  106.    i := i + 2;
  107.    divide(p1,p1,25);
  108.    divide(p2,p1,i);
  109.    sub(s,p2);
  110.    i := i + 2
  111.   end;
  112.  zero(p1); q := 0;
  113.  p1[0] := 956; i := 1;
  114.  while i < r2 do
  115.   begin
  116.    divide(p1,p1,239);
  117.    divide(p1,p1,239);
  118.    divide(p2,p1,i);
  119.    sub(s,p2);
  120.    i := i + 2;
  121.    divide(p1,p1,239);
  122.    divide(p1,p1,239);
  123.    divide(p2,p1,i);
  124.    add(s,p2);
  125.    i := i + 2
  126.   end;
  127.  writeln;
  128.  { loop to write out the computed value of PI: }
  129.  writeln('The value of pi is:');
  130.  write(' ' : 6);
  131.  for i:=0 to 1 do
  132.   begin if i > 0 then write('.'); write(s[i] : 1) end;
  133.  for i:=2 to sz do
  134.   begin
  135.    if i mod 50 = 1 then begin writeln; write(' ' : 8) end
  136.     else
  137.      if (i - 1) mod 5 = 0 then write(' ');
  138.    write(s[i] : 1)
  139.   end;
  140.  writeln;
  141. end.
  142.