INTEGER ONE,TWO,M,Y,D,NZER,BORN,DIF REAL OHYS,DPHYS,MENTAL,DMENT,EMO,DEMO 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 ? ',$) ACCEPT 1001,M,D,Y 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,'/',I4) 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 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