Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	PROGRAM SIEVE

C	Multiple section Sieve of Eratosthenes
C	Demonstration program for the EXTEND subroutine

C	Alan H. Martin/AHM	5-Dec-82

C	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1982, 1983

C	THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND
C	COPIED ONLY IN ACCORDANCE WITH  THE TERMS OF SUCH LICENSE  AND
C	WITH THE  INCLUSION  OF  THE  ABOVE  COPYRIGHT  NOTICE.   THIS
C	SOFTWARE OR ANY OTHER  COPIES THEREOF MAY  NOT BE PROVIDED  OR
C	OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON.  NO TITLE TO AND
C	OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.

C	THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT
C	NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY  DIGITAL
C	EQUIPMENT CORPORATION.

C	DIGITAL ASSUMES NO RESPONSIBILITY  FOR THE USE OR  RELIABILITY
C	OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

C	This software is provided for informational purposes only, and
C	is not supported by Digital.

C			***** WARNING *****

C	You must  be running  a KL  microcode later  than version  275
C	(which is the current field image version for Tops-20 releases
C	5 and 5.1) in order to use SIEVE.

C	To try running SIEVE, do the following:
C	@LOAD SIEVE.FOR,SYS:EXTEND.REL	;Load the program into section 0
C	@SAVE SIEVE			;Save the core image as an EXE file
C	@GET SIEVE/USE-SECTION:1	;Get the core image into section 1
C	@SAVE SIEVE			;Save it as a non-zero section image
C	@RUN SIEVE			;Run the program in section 1


	INTEGER M,N
	LOGICAL HITTBL !(N)	! Gives the type of the array to allocate
	EXTERNAL DOWORK		! The subroutine that does the actual work

	CALL EXTINI		! Initialize the EXTEND routine

	TYPE (FMT='(''$Smallest prime to display ?'')')
	ACCEPT *,M
	TYPE (FMT='(''$Largest prime to display ?'')')
	ACCEPT *,N

	CALL EXTEND(DOWORK,	! Call subroutine DOWORK (on next page)
	1	1,		!  and create one large array with elements
	2	HITTBL,		!  of the same datatype as HITTBL (LOGICAL)
	3	N,		!  which has N elements.
	4	M)		! Also pass along M because DOWORK needs it

	STOP
	END

	SUBROUTINE DOWORK(HITTBL,N,M)

C	Create an N element Sieve of Eratosthenes in HITTBL, and  type
C	out all the primes that are found which are at least as  large
C	as M.  Demonstrates how DOWORK accepts large arrays and  other
C	arguments from EXTEND.  Also  demonstrates that EXTEND can  be
C	called recursively.   Notice  that  the  main  program  called
C	EXTEND which  called  DOWORK,  but DOWORK  then  calls  EXTEND
C	recursively to call  STORE.  This does  not mean that  Fortran
C	routines can recurse on each other, however.

	INTEGER M,N,PRIME
	LOGICAL HITTBL(N)
	INTEGER TABLE !(N)	! Gives type of large array to pass to "STORE"
	INTEGER I
	EXTERNAL STORE

	CALL INIT(HITTBL,N)	! Initialize HITTBL

	PRIME = 2		! First prime number

	DO WHILE(PRIME#0)	! As long as there is room left in the sieve
				! for more primes

		DO I = 2*PRIME,N,PRIME		! Cast out all the multiples of
			HITTBL(I) = .FALSE.	! "PRIME" in the table
		END DO

		DO I = PRIME+1,N		! Look in the rest of the slots
			IF (HITTBL(I)) THEN	! True?  Must be prime
				PRIME = I	! Remember the number
				GOTO 10		! and cast out multiples again
			END IF
		END DO				! No stone left unturned,
		PRIME = 0			! no more primes left

10		CONTINUE

	END DO

C Find all slots marked true and print their index out

	CALL EXTEND(STORE,	! Call subroutine STORE (a few pages down),
	1	1,		!  and create one large array with elements
	2	TABLE,		!  of the same datatype as TABLE (INTEGER)
	3	N,		!  which has N elements.
	4	HITTBL,		!  Also pass along the large array HITTBL,
	5	N,		!  and HITTBL's size
	6	M)		!  and the number M because STORE needs them

	RETURN
	END

	SUBROUTINE INIT(HITTBL,N)

C	Initialize HITTBL(1..N)  to be  a pristine  sieve for  primes.
C	Shows a large array being passed to a normal subroutine.

	INTEGER N
	LOGICAL HITTBL(N)

	HITTBL(1) = .FALSE.			! 1 is not prime

	DO I = 2,N
		HITTBL(I) = .TRUE.		! 2 through N might be
	END DO

	RETURN
	END

	SUBROUTINE STORE(TABLE,TABSIZ,HITTBL,N,M)

C	Put the indices of all true elements of HITTBL(M..N) into
C	TABLE and type them out.

	INTEGER N
	LOGICAL HITTBL(N)
	INTEGER TABSIZ
	INTEGER TABLE(TABSIZ)
	INTEGER NEXT

	LAST = 0				! Nothing used in TABLE so far

	DO I = M,N				! Look for potential primes
		IF (HITTBL(I)) THEN		! Is "I" prime?
			LAST = LAST+1		! Yes, save the number
			TABLE(LAST) = I
		END IF
	END DO

	TYPE *,(TABLE(I),I=1,LAST)

	RETURN
	END