home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Pascal / MAXONPASCAL3.DMS / in.adf / DEMOS-OS1.3 / sieb.p < prev    next >
Encoding:
Text File  |  1994-07-23  |  1012 b   |  48 lines
  1. { MaxonPascal3-Anpassung / Test:  Falk Zühlsdorff (PackMAN) 1994 }
  2.  
  3. Program Sieve;
  4.  
  5. Const max=2000;
  6.  
  7. { Bei größerem "max" wird auch die Variable "s" länger und unhandlicher. }
  8. { Deshalb wird das Programm auch bei kleinem "m" langsamer.              }
  9.  
  10. Type Menge = set of 1..max;
  11.  
  12. Var s:   set of 0..max;
  13.     i,j: integer;
  14.     m:   2..max;
  15.  
  16. Procedure Ausgabe(Var f:text; m:menge; a,b:integer);
  17.   Const NpL = 10; { Numbers per Line }
  18.   Var i,count:integer;
  19.   Begin
  20.     count:=0;
  21.     For i:=a to b Do
  22.       If i in m Then
  23.         Begin
  24.           write(f,i:6);
  25.           count:=count+1;
  26.           If count>=NpL Then
  27.             Begin writeln(f); count:=0 End
  28.         End;
  29.     writeln(f)
  30.   End;
  31.  
  32. Begin
  33.   writeln('Primzahlberechnung durch Sieb des Eradingsbums');
  34.   writeln;
  35.   write('Maximum: '); readln(m)
  36.   s:=[2..m];
  37.   For i:=2 to m do
  38.     If i in s then
  39.       Begin
  40.         j:=i;
  41.         write(i:8,chr($0d));
  42.         While j<=m-i do
  43.           Begin j:=j+i; s:=s-[j]; end;
  44.       End;
  45.   Ausgabe(output,s,1,m)
  46. End.
  47.  
  48.