INTEGER ONE,TWO,M,Y,D,NZER,BORN,DIF
	REAL OHYS,DPHYS,MENTAL,DMENT,EMO,DEMO
	INTEGER MTHS(12)
	DATA MTHS /'Jan','Feb','Mar','Apr','May','Jun','Jul',
	1	   'Aug','Sep','Oct','Nov','Dec'/
	CHARACTER*10 DA

	CALL DATE(DA)
	READ(DA,FMT='I2,1X,A3,1X,I2') D,M1,Y
	M = -1
	DO M2 = 1,12
		IF( MTHS(M2) .EQ. M1 ) M = M2
	END DO
	IF( M .EQ. -1) STOP 'BAD MONTH'

!	TYPE 1000
!1000	FORMAT(' Start date (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 1090
!1090	FORMAT(' End date (Month,Day,Year) ? ',$)
!	ACCEPT 1001,M,D,Y
!	IF(Y.LT.1900) Y=Y+1900
	CALL CON(1,Y,M,D,TWO)

!	TYPE 1010
!1010	FORMAT('+Your birthday ? ',$)
	OPEN(1,FILE='BIRTH.DAY',ERR=999)
	READ(1,1001,ERR=999)M,D,Y
	CLOSE(1)
	IF(Y.LT.1900) Y=Y+1900
	CALL CON(1,Y,M,D,BORN)

	DO IDAY = ONE, TWO
	DIF = IDAY-BIRTH
	CALL CON(2,Y,M,D,IDAY)
	TYPE 1100,M,D,Y
1100	FORMAT(1X,I2,'/',I2,'/',I2,
	1	T15,'  Value',T25,'  dV/dT')

	NZER = 0
	CALL CALC(NZER,DIF,23,PHYS  ,DPHYS)
	CALL CALC(NZER,DIF,33,MENTAL,DMENT)
	CALL CALC(NZER,DIF,28,EMO   ,DEMO)
	AVG=(PHYS+EMO+MENTAL)/3.

	IF( NZER .EQ. 1 ) TYPE *,'ZERO DAY!'
	IF( NZER .EQ. 2 ) TYPE *,'DOUBLE ZERO DAY!!'
	IF( NZER .EQ. 3 ) TYPE *,'TRIPLE ZERO DAY!!!'

	TYPE 1020,PHYS,  DPHYS
	TYPE 1030,EMO,   DEMO
	TYPE 1040,MENTAL,DMENT
	TYPE 1050,AVG

1020	FORMAT(' Physical:',T15,F7.2,'%',T25,F7.2)
1030	FORMAT(' Emotional:',T15,F7.2,'%',T25,F7.2)
1040	FORMAT(' Mental:',T15,F7.2,'%',T25,F7.2)
1050	FORMAT(' Average:',T15,F7.2,'%',/)
	END DO
	CALL QUIETX
	CALL EXIT
999	STOP 'FILE BIRTH.DAY SHOULD CONTAIN M,D,Y'
	END
********
	SUBROUTINE CALC(NZER,DIF,PD,PERCNT,DERIV)
	INTEGER NZER,DIF,PD
	REAL PERCNT,THETA,PI,DDRIV,DERIV,THETA1
	DATA PI /3.141592653584626323/
	
	THETA1 = MOD(DIF,PD) / FLOAT(PD)
	THETA =  2.*PI*THETA1
!	TYPE *,DIF,PD,THETA1,THETA
	PERCNT = SIN( THETA ) * 100.
	DERIV  = COS( THETA ) * PD
	IF( ABS(PERCNT) .LT. .05 ) NZER = NZER + 1
	END