PDP-10.stacken/files/games_interchange/bio.for

C	***BIORHYTHM CHARTING PROGRAM***
C		8/2/74
C		 B.J.
C
	PARAMETER TWOPI = 6.2831853
C
C	DEFINE A BLANK LINE
C
	DIMENSION LINE(60)
C
C	DEFINE ARRAYS FOR DEVICE AND VICTIM
C
	INTEGER FILE,VICTIM(6)
C
C	DEFINE DAYS PER MONTH ARRAY
C
	COMMON IDPM(12)
	DATA IDPM/31,28,31,30,31,30,31,31,30,31,30,31/
C
C	GET OUTPUT DEVICE AND OPEN IT
C
	WRITE (5,52)
52	FORMAT (' ENTER OUTPUT DEVICE:(TTY OR LPT) ',$)
	READ (5,53) FILE
53	FORMAT (6A5)
	IF (FILE .EQ. '') FILE = 'TTY'
	OPEN (UNIT=1,DEVICE=FILE,ACCESS='SEQOUT',FILE='BIORHY.THM')
C
C	FIND OUT THE GOODIES
C
	WRITE (5,54)
54	FORMAT (' WHAT IS YOUR NAME: ',$)
	READ (5,53) VICTIM
1	WRITE (5,56)
56	FORMAT (' ENTER YOUR BIRTH DATE (E.G. 5,27,1945): ',$)
	READ (5,*) IBM,IBD,IBY
C
C	YEAR MAY ALSO BE GIVEN AS JUST THE LAST TWO DIGITS,
C	IN WHICH CASE 20TH CENTURY ASSUMED
C
	IF (IBY .LT. 100) IBY = IBY + 1900
	WRITE (5,58)
58	FORMAT (' ENTER START DATE (E.G. 11,1,1975): ',$)
	READ (5,*) ISM,ISD,ISY
	IF (ISY .LT. 100) ISY = ISY + 1900
	WRITE (5,60)
60	FORMAT (' HOW MANY MONTHS WOULD YOU LIKE ? ',$)
	READ (5,*) NMONS
C
C	MAKE THE TURKEY ISN'T
C	TRYING TO CHART HIS MOTHER'S
C	PREGNANCY OR WORSE...
C
	IF (IBY - ISY) 4,2,1
2	IF (IBM - ISM) 4,3,1
3	IF (IBD - ISD) 4,4,1
C
C	COMPUTE HOW MANY DAYS OLD AT START OF CHART
C
4	IDAGE = -1
	IF ((ISY - IBY) .GT. 89) GO TO 10
	IDAGE = IDAYS(ISD,ISM,ISY) - IDAYS(IBD,IBM,IBY) + 365*(ISY - IBY)
	IF (IBY .EQ. ISY) GO TO 6
	DO 5 I = IBY, ISY
	IF (MOD(I,4) .EQ. 0) IDAGE = IDAGE + 1
	IF (IDAGE .LT. 0) GO TO 10
5	CONTINUE
	IF (MOD(ISY,4) .EQ. 0) IDAGE = IDAGE + 1
6	CONTINUE
C
C	PRINT BACKGROUND MATERIAL
C	IF REQUESTED
C
	WRITE (5,62)
62	FORMAT (' SHALL I PRINT THE BACKGROUND MATERIAL',
	1' (0=NO,1=YES) ? ',$)
	READ (5,*) I
	IF (I .NE. 1) GO TO 7
	WRITE (1,64)
64	FORMAT (
	1'    THE "B I O R H Y T H M" THEORY STATES THAT HUMAN LIVES MOVE'/
	2' IN PREDICTABLE UNDULATIONS INVOLVING THREE SEPARATE CYCLES:'/
	3'   (A) PHYSICAL		23 DAYS'/
	4'   (B) EMOTIONAL		28 DAYS'/
	5'   (C) INTELLECTUAL	33 DAYS'//
	6' THERE ARE THREE MAJOR AREAS TO THIS CHART TO BE OBSERVED:'//
	7'   MINUS - ZERO - PLUS'///
	8' ** ZERO **'//
	9' THE DAY THAT THE CYCLE SWITCHES FROM PLUS MINUS OR MINUS'/
	1' TO PLUS IS A CRITICAL DAY.  IT IS DEFINED AS CRITICAL BE-')
	WRITE (1,66)
66	FORMAT (
	1' CAUSE YOU ARE NEITHER UP NOR DOWN, BUT IN A STATE OF LIMBO.'//
	2' (A) IF PHYSICAL CYCLE THEN PEOPLE TEND TO BE ACCIDENT PRONE.'/
	3' (B) IF EMOTIONAL CYCLE THEN POSSIBLE EMOTINAL OUTBURSTS.'/
	4' (C) IF INTELLECTUAL CYCLE IT IS NOT AS IMPORTANT, BY ITSELF,'/
	5'     AS THE OTHER TWO CYCLES.  IF IT DOES COINCIDE WITH THE'/
	6'     OTHER TWO, IT HAS A CONTRIBUTORY EFFECT.'///
	7' ** PLUS **'//
	8' (A) DURING THE 11 1/2 PLUS DAYS, IT IS A GOOD TIME FOR INTEN-'/
	9'     SIVE TRAINING IN ATHLETICS OR FOR ANY ACTIVITY REQUIRING'/
	1'     PHYSICAL STAMINA.')
	WRITE (1,68)
68	FORMAT (
	1' (B) DURING THE 14 PLUS DAYS, BOTH MEN AND WOMEN ARE PRONE TO'/
	2'     CHEERFULLNESS, COOPERATION AND A POSITIVE OUTLOOK ON LIFE.'/
	3' (C) DURING THE 16 1/2 PLUS DAYS OF THIS CYCLE, A PERSON FINDS'/
	4'     IT EASIER TO STUDY, WRITE CREATIVELY, UNDERSTAND MATHE-'/
	5'     MATICS OR PURSUE ANY INTELLECTUAL EFFORTS.'///
	6' ** MINUS **'//
	7' (A) DURING THE 11 1/2 MINUS DAYS, PERSONS ARE AWARE OF A'/
	8'     REDUCED VITIALITY AND ENDURANCE.  IN SHORT, YOU WILL'/
	8'     TIRE EASILY ON THESE DAYS.'/
	9' (B) DURING THE 14 MINUS DAYS, PERSONS ARE CONVERSE TO THE'/
	1'     PLUS DAYS.  BOTH MEN AND WOMEN ARE CONDUCIVE TO MOOD-')
	WRITE (1,70)
70	FORMAT (
	1'     INESS AND NEGATIVISM.'/
	2' (C) DURING THE 16 1/2 MINUS DAYS, CAPACITIES ARE LESSENED.'/
	3'     THESE ARE DAYS BETTER SPENT ON REVIEW AND PRACTICE.'/
	4'1N O T E :'/
	5'  1. IT TAKES 58+ YEARS TO CYCLE BACK TO YOUR BIRTH DATE.'//
	6'  2. TRUE TRIPLE CRITICAL POINTS OCCUR ONLY EVERY 29 YEARS.'/
	7'     ALL TRUE AND NEAR TRIPLE POINTS WILL BE SHOWN BY "#".')
7	WRITE (1,53)
	WRITE (1,53)
	WRITE (1,53)
C
C	PRINT AGE IN DAYS AT START OF CHART
C
	WRITE (1,200) IDAGE
200	FORMAT (' AT THE START OF THIS CHART YOU WILL BE'I6' DAYS OLD.')
	WRITE (1,300) VICTIM
300	FORMAT (///' THIS CHART PREPARED ESPECIALLY FOR '6A5///)
C
C	PRINT THE CHART HEADER
C	AND INITIALIZE THEN LINE ARRAY
C
	WRITE (1,400)
400	FORMAT (T23'MINUS'T37'ZERO'T52'PLUS'/9X60('-'))
	DO 8 I = 1, 60
8	LINE(I) = ' '
C
C	IF THIS IS A LEAP YEAR THEN
C	ALTER THE DAYS PER MONTH
C
	IF (MOD(ISY,4) .EQ. 0) IDPM(2) = 29
	LINE(30) = '*'
C
C	START OF MAIN LOOP
C
C	LOCATE THE CURVES
C
9	IP = SIN(MOD(IDAGE,23)/22.*TWOPI)*28 + 30.
	IE = SIN(MOD(IDAGE,28)/27.*TWOPI)*28 + 30.
	II = SIN(MOD(IDAGE,33)/32.*TWOPI)*28 + 30.
C
C	PRINT A LINE OF THE CHART
C
	LINE(IP) = 'P'
	LINE(IE) = 'E'
	LINE(II) = 'I'
	IF ((IP .EQ. IE) .AND. (IE .EQ. II)) LINE(IP) = '#'
	I = MOD(ISY,100)
	WRITE (1,500) ISM,ISD,I,LINE
500	FORMAT(' 'I2'/'I2'/'I2,60A1)
C
C	RESTORE LINE
C
	LINE(IP) = ' '
	LINE(IE) = ' '
	LINE(II) = ' '
	LINE(30) = '*'
C
C	UPDATE CALENDAR
C
	IDAGE = IDAGE + 1
	ISD = ISD + 1
	IF (ISD .LE. IDPM(ISM)) GO TO 10
	ISD = 1
	ISM = ISM + 1
	NMONS = NMONS - 1
	IF (NMONS .EQ. 0) STOP 'HAVE A NICE DAY'
	IF (ISM .LE. 12) GO TO 10
	ISM = 1
	ISY = ISY + 1
	IDPM(2) = 28
	IF (MOD(ISY,4) .EQ. 0) IDPM(2) = 29
10	IF (IDAGE .LT. 0) STOP 'CANT HAPPEN ON DEC'
	GO TO 9
	END
	FUNCTION IDAYS(ID,IM,IY)
	COMMON IDPM(12)
	IDAYS = 0
	IF (IM .EQ. 1) GO TO 1002
	J = IM - 1
	DO 1001 I = 1, J
1001	IDAYS = IDAYS + IDPM(I)
1002	IDAYS = IDAYS + ID
	IF ((MOD(IY,4) .EQ. 0) .AND. (IM .GT. 2)) IDAYS = IDAYS + 1
	RETURN
	END