PARAMETER SIZE=100

	IMPLICIT INTEGER (A-Z)
	LOGICAL*1 WORLDA(SIZE,SIZE), WORLDB(SIZE,SIZE)
	BYTE COUNT(SIZE,SIZE),XCOUNT(SIZE*SIZE)
	EQUIVALENCE (COUNT,XCOUNT)
	COMMON /UNIVERS/ WORLDA, WORLDB, COUNT
	COMMON /OTHER/ GEN, POP, NUM_GEN_DIS

	CALL INITIT

100	GEN=GEN+1
	IF (IAND(GEN,1).EQ.1) THEN	!EVERY OTHER TIME USE WORLDA
		CALL DOCOUNT(WORLDA)
C		CALL DOGEN(WORLDA,WORLDB,.TRUE.)
		CALL DOGEN(WORLDA,WORLDB,MOD(GEN,NUM_GEN_DIS).EQ. 0)
	ELSE
		CALL DOCOUNT(WORLDB)
		CALL DOGEN(WORLDB,WORLDA,MOD(GEN,NUM_GEN_DIS).EQ.0)
	ENDIF

	CALL DPLSTAT
	GO TO 100

	END


	SUBROUTINE INITIT
	IMPLICIT INTEGER (A-Z)
	PARAMETER SIZE=100
	LOGICAL*1 WORLDA(SIZE,SIZE), WORLDB(SIZE,SIZE)
	BYTE COUNT(SIZE,SIZE),XCOUNT(SIZE*SIZE)
	EQUIVALENCE (COUNT,XCOUNT)
	COMMON /UNIVERS/ WORLDA, WORLDB, COUNT
	COMMON /OTHER/ GEN, POP, NUM_GEN_DIS
	CHARACTER*80 PAT

	OPEN(UNIT=6,CARRIAGECONTROL='NONE')


	POP=0
	GEN=0
	CALL CLRSCREEN

	DO 10 J=1,SIZE
	DO 10 I=1,SIZE
	WORLDA(I,J)=.FALSE.
10	WORLDB(I,J)=.FALSE.

	NUM_GEN_DIS = 1

	PRINT *,' ENTER INITIAL PATTERN'
	DO 100 J=SIZE/3,SIZE/3+10
	PAT = ' '
	ACCEPT 1,PAT
1	FORMAT(A)
	DO 100 I=1,80
	IF (PAT(I:I) .NE. ' ') THEN
		WORLDA(J,I)=.TRUE.
		POP=POP+1
	ENDIF
100	CONTINUE
	CALL CLRSCREEN
	DO 200 J=1,SIZE
	DO 200 I=1,SIZE
200	IF (WORLDA(I,J) .EQ. .TRUE.)CALL BIRTH(I,J)
	CALL DPLSTAT

	RETURN
	END



	SUBROUTINE DOCOUNT(WORLD)
	IMPLICIT INTEGER (A-Z)
	PARAMETER SIZE=100
	LOGICAL*1 WORLDA(SIZE,SIZE), WORLDB(SIZE,SIZE)
	BYTE COUNT(SIZE,SIZE),XCOUNT(SIZE*SIZE)
	EQUIVALENCE (COUNT,XCOUNT)
	COMMON /UNIVERS/ WORLDA, WORLDB, COUNT
	COMMON /OTHER/ GEN, POP, NUM_GEN_DIS

	LOGICAL*1 WORLD(SIZE,SIZE)

	DO 10 I=1,SIZE*SIZE
10	XCOUNT(I)=0


	DO 1000 J=1,SIZE
	DO 1000 I=1,SIZE
	IF (.NOT. WORLD(I,J)) GO TO 1000

	IM1=I-1
	IF (IM1 .EQ. 0)IM1=SIZE
	IP1=I+1
	IF (IP1 .GT. SIZE)IP1=1
	JM1=J-1
	IF (JM1 .EQ. 0)JM1=SIZE
	JP1=J+1
	IF (JP1 .GT. SIZE)JP1=1

	COUNT(IM1,JM1)	=COUNT(IM1,JM1)+1
	COUNT(IM1,J)	=COUNT(IM1,J)+1
	COUNT(IM1,JP1)	=COUNT(IM1,JP1)+1
	COUNT(I,JM1)	=COUNT(I,JM1)+1
	COUNT(I,JP1)	=COUNT(I,JP1)+1
	COUNT(IP1,JM1)	=COUNT(IP1,JM1)+1
	COUNT(IP1,J)	=COUNT(IP1,J)+1
	COUNT(IP1,JP1)	=COUNT(IP1,JP1)+1

1000	CONTINUE

	RETURN
	END



	SUBROUTINE DOGEN(A,B,DPLMOV)
	IMPLICIT INTEGER (A-Z)
	PARAMETER SIZE=100
	LOGICAL*1 WORLDA(SIZE,SIZE), WORLDB(SIZE,SIZE)
	BYTE COUNT(SIZE,SIZE),XCOUNT(SIZE*SIZE)
	EQUIVALENCE (COUNT,XCOUNT)
	COMMON /UNIVERS/ WORLDA, WORLDB, COUNT
	COMMON /OTHER/ GEN, POP, NUM_GEN_DIS

	LOGICAL DPLMOV
	LOGICAL*1 A(SIZE,SIZE), B(SIZE,SIZE)
	POP=0

	DO 100 J=1,SIZE
	DO 100 I=1,SIZE
	IF (A(I,J)) THEN		!CELL IS ALIVE AT GEN N
		IF(COUNT(I,J).EQ.2 .OR. COUNT(I,J).EQ.3) THEN
			B(I,J)=.TRUE.	!NEXT GEN STAYING ALIVE
			POP=POP+1
		ELSE
			B(I,J)=.FALSE.	!CELL MUST DIE
			IF (DPLMOV) CALL DEATH(I,J)
		ENDIF
	ELSE				!HERE FOR CELL AT GEN N DEAD
		IF(COUNT(I,J) .EQ. 3) THEN		!A LITTLE THREESOME
			POP=POP+1
			B(I,J)=.TRUE.
			IF (DPLMOV) CALL BIRTH(I,J)	!QUICK RESULTS
		ELSE
			B(I,J)=.FALSE.			!ONLY THREE CAN DO IT
		ENDIF
	ENDIF

100	CONTINUE

	RETURN
	END



	SUBROUTINE CLRSCREEN
	IMPLICIT INTEGER (A-Z)
	PARAMETER SIZE=100
	LOGICAL*1 WORLDA(SIZE,SIZE), WORLDB(SIZE,SIZE)
	BYTE COUNT(SIZE,SIZE),XCOUNT(SIZE*SIZE)
	EQUIVALENCE (COUNT,XCOUNT)
	COMMON /UNIVERS/ WORLDA, WORLDB, COUNT
	COMMON /OTHER/ GEN, POP, NUM_GEN_DIS

	CHARACTER*5 POPNUM,GENNUM
	CHARACTER*100 OUTBUF
	CHARACTER*1 ESC,HOME,ERAS,MOVCUR,NULL,VCHAR
	DATA ESC,HOME,ERAS,MOVCUR,NULL/'033'O,'110'O,'112'O,'131'O,'0'O/

	OUTBUF=ESC//HOME//NULL//ESC//ERAS//NULL//NULL
	WRITE(6,66) OUTBUF(1:7)
66	FORMAT(A)
	RETURN


	ENTRY BIRTH(X,Y)
	VCHAR='+'

100	IF(X.LE.0 .OR. X.GT.80)RETURN		!OUT OF RANGE
	IF(Y.LE.0 .OR. Y.GT.24)RETURN

	OUTBUF=ESC//HOME//NULL//NULL//NULL//ESC//MOVCUR//
     1	CHAR('040'O+24-Y)//CHAR('040'O+X-1)//NULL//NULL//NULL//VCHAR
	WRITE(6,66) OUTBUF(1:13)
	RETURN


	ENTRY DEATH(X,Y)
	VCHAR = ' '
	GO TO 100

	ENTRY DPLSTAT
	ENCODE(5,55,POPNUM) POP
	ENCODE(5,55,GENNUM) GEN
55	FORMAT(I5)

	OUTBUF=ESC//HOME//NULL//NULL//NULL//ESC//MOVCUR//CHAR('040'O)//
     1	CHAR('040'O+10)//NULL//NULL//NULL//'POPULATION'//
     2	POPNUM//NULL//NULL//ESC//HOME//NULL//NULL//NULL//
     3	ESC//MOVCUR//CHAR('040'O)//CHAR('040'O+45)//
     4	NULL//NULL//NULL//
     5	'GENERATION'//GENNUM//NULL

	WRITE(6,66) OUTBUF(1:58)
	RETURN


99	PRINT *,' ERROR IN BIRTH,DEATH..X,Y,VCHAR=',X,Y,VCHAR
	RETURN
	END