home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / modula2 / library / fst / mod2brd1 / primzahl.mod < prev    next >
Text File  |  1990-04-08  |  6KB  |  172 lines
  1. MODULE prim;
  2.  
  3. (**********************************************************************
  4.    Primzahlen.
  5.    Dieses Programm kann Primzahlen zwischen 1 und 65000 berechnen.
  6.    Die Grenzen, in welchen die Primzahlen berechnet werden sollen,
  7.    können explizit angegeben werden.
  8.    Z. B. nur die Primzahlen zwischen 50 und 250.
  9.  **********************************************************************)
  10.  
  11.  
  12. FROM InOut IMPORT ReadCard,
  13.                   WriteCard,
  14.                   WriteString,
  15.                   WriteLn;
  16. FROM MathLib0 IMPORT sqrt;
  17.  
  18. CONST
  19.   Max = 65000;  (* groesztmoegliche Zahl *)
  20.  
  21. TYPE
  22.    primarray = ARRAY[1..Max] OF BOOLEAN;
  23.  
  24. VAR
  25.   primt : primarray;  (* "Wahrheitswerte" der Zahlen 1 bis Max *)
  26.   k, n, anzahlprim : CARDINAL;
  27.  
  28.  
  29. (*******************************************************************)
  30. (* PROCEDURE Init                                                  *)
  31. (*******************************************************************)
  32. (* -Gibt eine Nachricht aus.                                       *)
  33. (* -Setzt die Variablen k, n auf 0.                                *)
  34. (* -Setzt primt[1] auf FALSE                                        *)
  35. (* -Setzt primt[2..Max] auf TRUE                                    *)
  36. (*******************************************************************)
  37. PROCEDURE init();
  38. VAR
  39.   zahl : CARDINAL;
  40.  
  41. BEGIN
  42.   WriteLn; WriteLn;
  43.   WriteString('Das Programm berechnet Primzahlen nach dem Sieb ');
  44.   WriteString('des Eratosthenes.');
  45.   WriteLn;
  46.   k:=0;
  47.   n:=0;
  48.   primt[1]:=FALSE;
  49.   FOR zahl:=2 TO Max DO
  50.     primt[zahl]:=TRUE;
  51.   END;
  52. END init;
  53.  
  54.  
  55. (*******************************************************************)
  56. (* PROCEDURE LeseZahl                                              *)
  57. (*******************************************************************)
  58. (* Liest eine Zahl ein und gibt sie an das aufrufende Prg zurueck. *)
  59. (* Die zurueckgegebene Zahl erfuellt folgende Bedingung:           *)
  60. (*     min <= zahl <= max                                          *)
  61. (*******************************************************************)
  62. PROCEDURE lesezahl(min, max : CARDINAL) : CARDINAL;
  63. VAR
  64.   z : CARDINAL;
  65.  
  66. BEGIN
  67.   REPEAT
  68.     WriteString('Bitte eine Zahl zwischen ');
  69.     WriteCard(min, 0);
  70.     WriteString(' und ');
  71.     WriteCard(max, 0);
  72.     WriteString(' eingeben: ');
  73.     ReadCard(z);
  74.     WriteLn;
  75.   UNTIL (z>=min) AND (z<=max);
  76.   RETURN z;
  77. END lesezahl;
  78.  
  79.  
  80. (*******************************************************************)
  81. (* PROCEDURE PrimBerechnung                                        *)
  82. (*******************************************************************)
  83. (* Berechnet die Primzahlen von 2 bis Max.                         *)
  84. (*******************************************************************)
  85. PROCEDURE primberechnung(p : primarray);
  86. VAR
  87.   zahl, vielfache, wurzel : CARDINAL;
  88.   maxnreal : REAL;
  89.  
  90. BEGIN
  91.   WriteLn;
  92.   WriteString('Bitte warten - es können Primzahlen von 2 bis ');
  93.   WriteCard(Max, 0);
  94.   WriteLn;
  95.   WriteString('berechnet werden.');
  96.   WriteLn;WriteLn;
  97.   maxnreal:=FLOAT(Max);
  98.   wurzel:=TRUNC(sqrt(maxnreal));
  99.   FOR zahl:=2 TO wurzel DO
  100.     IF primt[zahl] THEN
  101.       vielfache:=zahl+zahl;
  102.       WHILE (vielfache<=Max) DO
  103.         primt[vielfache]:=FALSE;
  104.         vielfache:=vielfache+zahl;
  105.       END;
  106.     END;
  107.   END;
  108. END primberechnung;
  109.  
  110.  
  111. (*******************************************************************)
  112. (* PROCEDURE PrimAusgabe                                           *)
  113. (*******************************************************************)
  114. (* -Gibt die Primzahlen zwischen min und max aus.                  *)
  115. (* -Zusaetzlich wird ausgegeben, wieviele Primzahlen gefunden      *)
  116. (*  wurden.                                                        *)
  117. (*******************************************************************)
  118. PROCEDURE primausgabe(min, max : CARDINAL);
  119. VAR
  120.   zahl, counter : CARDINAL;
  121.  
  122. BEGIN
  123.   WriteLn;
  124.   WriteString('Primzahlentabelle:'); WriteLn;
  125.   WriteString('------------------'); WriteLn;
  126.   WriteLn;
  127.   counter:=1;
  128.   anzahlprim:=0;
  129.   FOR zahl:=min TO max DO
  130.     IF primt[zahl] THEN    (* Falls Primzahl *)
  131.       WriteCard(zahl, 7); (* dann ausgeben und *)
  132.       INC(counter);
  133.       INC(anzahlprim);    (* anzahlprim erhoehen *)
  134.     END;
  135.     IF (counter=11) THEN   (* dient zur schoenen Ausgabe *)
  136.       counter:=1;
  137.       WriteLn;
  138.     END;
  139.   END;
  140.   WriteLn; WriteLn;
  141.   WriteCard(anzahlprim, 0);
  142.   WriteString(' Primzahlen ausgegeben.');
  143.   WriteLn; WriteLn;
  144. END primausgabe;
  145.  
  146.  
  147. (*******************************************************************)
  148. (* PROCEDURE sde                                                   *)
  149. (*******************************************************************)
  150. (* Sieb des Eratosthenes:                                          *)
  151. (* Installiert das Programm, berechnet die Primzahlentabelle,      *)
  152. (* liest k und n ein und gibt die Primzahlen aus.                  *)
  153. (*******************************************************************)
  154. PROCEDURE sde;
  155. BEGIN
  156.   init;
  157.   primberechnung(primt);
  158.   k:=lesezahl(1, Max-10);
  159.   n:=lesezahl(k+1, Max);
  160.   primausgabe(k, n);
  161.   WriteString('Auf Wiedersehen bis zum naechsten Mal...');
  162.   WriteLn; WriteLn;
  163. END sde;
  164.  
  165.  
  166. (*******************************************************************)
  167. (* Hauptprogramm                                                   *)
  168. (*******************************************************************)
  169. BEGIN
  170.   sde;
  171. END prim.
  172.