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