MILLENNIUM SS SOURCE CODE
PROGRAM MILLENNIUM
INTEGER CTR,C,DAY,MONTH,YEAR,C2,C3,A,LEAP,WEEK,EXC,Y
CHARACTER(9) DAYN,INPUT
CHARACTER(3) MONTHN
CCCCCCC FIRST DAY OF JAN 2000, THE START OF THE MILLENNIUM WAS A SATURDAY
CCCCCCC C VARS ARE CHECKER NUMBERS
CCCCCCC A VAR IS THE DAY COUNTER IT COUNTS HOW MANY DAYS IT HAS BEEN SINCE START OF THE MILLENNIUM
CCCCCCC EXC VAR IS THE EXCESS VARIABLE, COUNTS HOW MANY DAYS THERE ARE AFTER THE WEEK VAR
CCCCCCC DAYN STANDS FOR DAY NAME, SPECIFIES WHICH DAY OF THE WEEK IT IS
CCCCCCC Y EQUALS YEAR MINUS ONE
A=0
CCCCCCC INPUTIA
3 PRINT*,"MILLENNIUM SS 0.0.1 BY KEREM -DEFUSION69- INCE"
PRINT*,"ENTER DAY NUMBER"
READ*,DAY
IF(DAY==69) GOTO 21
PRINT*,"ENTER MONTH NUMBER"
READ*,MONTH
PRINT*,"ENTER YEAR"
READ*,YEAR
CCCCCCC YEAR DIFFUSER
31 IF(YEAR.LT.2000) GOTO 14
Y=YEAR-1
DO CTR=2000,Y
C=CTR/4
C=C*4
C2=CTR/100
C2=C2*100
C3=CTR/400
C3=C3*400
IF(C.EQ.CTR.AND.C2.NE.CTR) THEN
A=A+366
ELSE IF(C.EQ.CTR.AND.C2.EQ.CTR.AND.C3.NE.CTR) THEN
A=A+365
ELSE IF(C.EQ.CTR.AND.C2.EQ.CTR.AND.C3.EQ.CTR) THEN
A=A+366
ELSE
A=A+365
END IF
END DO
CCCCCCC CURRENT YEAR'S LEAP STAT CALC
C=YEAR/4
C=C*4
C2=YEAR/100
C2=C2*100
C3=YEAR/400
C3=C3*400
IF(C.EQ.YEAR.AND.C2.NE.YEAR) THEN
LEAP=1
ELSE IF(C.EQ.YEAR.AND.C2.EQ.YEAR.AND.C3.NE.YEAR) THEN
LEAP=0
ELSE IF(C.EQ.YEAR.AND.C2.EQ.YEAR.AND.C3.EQ.YEAR) THEN
LEAP=1
ELSE
LEAP=0
END IF
CCCCCCC MONTH DIFFUSER
IF (MONTH.GT.12.OR.MONTH.LT.1) GOTO 11
IF (MONTH==1) MONTHN="JAN"
IF (MONTH==2) MONTHN="FEB"
IF (MONTH==3) MONTHN="MAR"
IF (MONTH==4) MONTHN="APR"
IF (MONTH==5) MONTHN="MAY"
IF (MONTH==6) MONTHN="JUN"
IF (MONTH==7) MONTHN="JUL"
IF (MONTH==8) MONTHN="AUG"
IF (MONTH==9) MONTHN="SEP"
IF (MONTH==10) MONTHN="OCT"
IF (MONTH==11) MONTHN="NOV"
IF (MONTH==12) MONTHN="DEC"
DO CTR=1,MONTH
SELECT CASE(CTR)
CASE(1)
A=A+0
CASE(2,4,6,9,8,11)
A=A+31
CASE(5,7,10,12)
A=A+30
CASE(3)
IF(LEAP==1) A=A+29
IF(LEAP==0) A=A+28
CASE DEFAULT
GOTO 11
END SELECT
END DO
CCCCCCC DAY DIFFUSER
IF(DAY.GT.31.OR.DAY.LT.1) GOTO 13
A=A+DAY-1
CCCCCCC WEEK DIFFUSER
WEEK=A/7
IF(WEEK.LT.0) GOTO 11
EXC=A-(WEEK*7)
SELECT CASE(EXC)
CASE(6)
DAYN="FRIDAY"
CASE(0)
DAYN="SATURDAY"
CASE(1)
DAYN="SUNDAY"
CASE(2)
DAYN="MONDAY"
CASE(3)
DAYN="TUESDAY"
CASE(4)
DAYN="WEDNESDAY"
CASE(5)
DAYN="THURSDAY"
CASE DEFAULT
GOTO 12
END SELECT
PRINT*,"DAY:",DAY," ",DAYN
PRINT*,"MONTH:",MONTHN
PRINT*,"YEAR:",YEAR
PRINT*,"WEEK:",WEEK
PRINT*,A," DAYS SINCE THE START OF THE MILLENNIUM"
PRINT*,"GO AGAIN? Y/N"
READ*,INPUT
SELECT CASE(INPUT)
CASE("YES","Y")
GOTO 3
CASE("NO","N")
GOTO 2
CASE DEFAULT
PRINT*,"ERROR006-CHARACTER INPUT ENTERED INCORRECTLY"
GOTO 2
END SELECT
CCCCCCC CONSOLE
21 PRINT*,"MILLSS 0.0.1 CONSOLE"
READ*,INPUT
SELECT CASE(INPUT)
CASE("HELP")
PRINT*,"DAY MONTH YEAR GO HELP KYS INFO"
GOTO 21
CASE("DAY")
READ*,DAY
GOTO 21
CASE("MONTH")
READ*,MONTH
GOTO 21
CASE("YEAR")
READ*,YEAR
GOTO 21
CASE("GO")
GOTO 31
CASE("KYS")
GOTO 12
CASE("INFO")
PRINT*,"MILLENNIUM SS 0.0.1 - BUILT 10.05.2024"
PRINT*,"BY KEREM -DEFUSION69- INCE"
GOTO 21
CASE DEFAULT
PRINT*,"ERROR005-CONSOLE INPUT WRONG"
GOTO 21
END SELECT
GOTO 2
CCCCCCC HALL OF DAMNATION
11 PRINT*,"ERROR001-MONTH ENTERED INCORRECTLY"
GOTO 2
12 PRINT*,"ERROR002-UNKNOWN"
GOTO 2
13 PRINT*,"ERROR003-DAY ENTERED INCORRECTLY"
GOTO 2
14 PRINT*,"ERROR004-YEAR ENTERED INCORRECTLY"
2 END PROGRAM