home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / modula2 / harmonic.mod < prev    next >
Encoding:
Text File  |  1987-01-08  |  1.2 KB  |  47 lines
  1. (* Compute the harmonic function H(n) = 1 + 1/2 + 1/3 + ... + 1/n
  2.    with m digits accuracy. *)
  3.  
  4. MODULE harmonic;
  5.  
  6. FROM InOut IMPORT WriteString, WriteLn, WriteCard, ReadCard, Write;
  7.  
  8. CONST lim = 100;
  9.  
  10. VAR i,k,m,n,c,r,q,sum: CARDINAL;
  11.     d,s: ARRAY [0..lim] OF CARDINAL;
  12.  
  13. BEGIN
  14.   WriteString('Digits of Accuracy> '); ReadCard(m);
  15.   WriteLn; WriteString('n> '); ReadCard(n);
  16.   IF (m > 0) AND (m < lim) THEN
  17.     d[0] := 0; s[0] := 1;
  18.     FOR i := 1 TO m DO s[i] := 0 END;
  19.     FOR k := 2 TO n DO
  20.       (* compute 1/k *)
  21.       r := 1;
  22.       FOR i := 1 TO m DO
  23.         r := 10*r; q := r DIV k;
  24.         r := r - q*k; d[i] := q;
  25.       END;
  26.       IF (10*r DIV k) >= 5 THEN d[m] := d[m]+1 END; (* round *)
  27.       WriteString(' 0.'); (* intermediate output *)
  28.       FOR i := 1 TO m DO WriteCard(d[i],1) END;
  29.       WriteLn;
  30.       (* compute s := s + 1/k *)
  31.       c := 0;
  32.       FOR i := m TO 0 BY -1 DO
  33.         sum := s[i]+d[i]+c;
  34.         IF sum >= 10 THEN
  35.           sum := sum-10; c := 1
  36.         ELSE
  37.           c := 0;
  38.           s[i] := sum
  39.         END
  40.       END
  41.     END;
  42.     Write(' '); WriteCard(s[0],1); Write(' ');
  43.     FOR i := 1 TO m DO WriteCard(s[i],1) END;
  44.     WriteLn;
  45.   END
  46. END harmonic.
  47.