REAL MENTAL
	INTEGER M,D,Y,ONE,TWO,DIF

	TYPE 1
1	FORMAT(1H0,10X,'Biorythmic compatability',//)

	TYPE 1000
1000	FORMAT(' First person''s birthday (Month,Day,Year) ? ',$)
	ACCEPT 1001,M,D,Y
1001	FORMAT(3I)
	IF(Y.LT.1900) Y=Y+1900
	CALL CON(1,Y,M,D,ONE)

	TYPE 1010
1010	FORMAT('+Second person''s birthday ? ',$)
	ACCEPT 1001,M,D,Y
	IF(Y.LT.1900) Y=Y+1900
	CALL CON(1,Y,M,D,TWO)

	DIF=IABS(ONE-TWO)
	CALL CALC(DIF,23,PHYS)
	CALL CALC(DIF,33,MENTAL)
	CALL CALC(DIF,28,EMO)
	AVG=(PHYS+EMO+MENTAL)/3.

	TYPE 1020,PHYS,EMO,MENTAL,AVG
1020	FORMAT(' Physical:',T15,F6.2,'%',/,' Emotional:',T15,F6.2,'%',/,
     +  ' Mental:',T15,F6.2,'%',//,' Average:',T15,F6.2,'%')

	END
	SUBROUTINE CALC(DIF,PD,PERCNT)
	INTEGER DIF,PD
	REAL PERCNT,FPD

	FPD=FLOAT(PD)
	PERCNT=2.*100./FPD*ABS(FLOAT(MOD(DIF,PD))-FPD/2.)

	RETURN
	END