home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Pascal / MAXONPASCAL3.DMS / in.adf / DEMOS-OS1.3 / sieb2.p < prev    next >
Encoding:
Text File  |  1994-07-23  |  1.2 KB  |  58 lines
  1. { MaxonPascal3-Anpassung / Test:  Falk Zühlsdorff (PackMAN) 1994  }
  2.  
  3. Program Sieb_des_Eratosthenes;
  4.  
  5. { written by MJ und JG }
  6.  
  7. Const max=10000;
  8.  
  9. { Diese Version benutzt ein Array statt SET: }
  10.  
  11. Var sieb: ARRAY [1..max] OF BOOLEAN;
  12.     i, j, a, b, m: INTEGER;
  13.  
  14. Procedure Ausgabe(Var f:text; a,b:integer);
  15.   Const NpL = 10;     { Numbers per Line }
  16.   Var i, count:integer;
  17.   Begin
  18.     count:=0;
  19.     IF (a<=2) THEN    { Feld repräsentiert nur die ungeraden Zahlen }
  20.     BEGIN
  21.        Write(f, 2:6);
  22.        count := 1;
  23.     END;
  24.     For i:=a to (b DIV 2) Do
  25.       If sieb[i] Then
  26.         Begin
  27.           write(f,(2*i+1):6);
  28.           count:=count+1;
  29.           If count>=NpL Then
  30.             Begin writeln(f); count:=0 End
  31.         End;
  32.     writeln(f)
  33.   End;
  34.  
  35. Begin
  36.   a :=3; b := 4;
  37.   writeln('Primzahlberechnung durch Sieb des Eradingsbums');
  38.   writeln;
  39.   REPEAT
  40.      write('Maximum: '); readln(m)
  41.   UNTIL (m>0) and (m<2*max);
  42.   FOR i:=1 to (m DIV 2) DO
  43.      sieb[i] := TRUE;
  44.   FOR i:=1 TO TRUNC(sqrt(m)+1) DO
  45.     IF sieb[i] THEN
  46.     Begin
  47.        FOR j:=0 TO ((m-1-b) DIV a) DO
  48.           sieb[b+j*a] := FALSE;
  49.        write((2*i+1):8,chr(13));
  50.        i := succ(i);
  51.        a := a + 2;
  52.        b := b + 2*a-2;
  53.    End;
  54.    Ausgabe(output,1,m)
  55. End.
  56.  
  57.  
  58.