'===========================================================================
' Subject: CALENDAR DATE TO JULIAN NUMBER     Date: 03-15-00 (22:08)       
'  Author: Wayne Henderson                    Code: QB, QBasic, PDS        
'  Origin: whenders@becon.org               Packet: DATETIME.ABC
'===========================================================================
'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
'º Calendar date to Julian Number & vice-versa; input TIME as local (H/M/S) º
'º Program gives the correct Julian Day when local DATE/TIME is entered and º
'º the correct local DATE/TIME when a Julian Number is entered.             º
'º by Wayne Henderson___March 16th, 2000 (Thu)___7:00 am, EST___(2,451,620) º
'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
'
DEFINT A-Z
DECLARE FUNCTION EDT (Y)    'rename these two FUNCTIONs as required (see EDT)
DECLARE FUNCTION EST (Y)    'Change all occurrences of EDT & EST accordingly.
DECLARE FUNCTION Leap (Year)
DECLARE FUNCTION Weekday (Month, Day, Year)
DECLARE FUNCTION To12 (Hour)
DECLARE FUNCTION MTRIM$ (a$, b$)
DECLARE FUNCTION Julian# (Year, Month, Day, utc#)
DECLARE SUB ParseInp (a$)
DIM Month$(12), m(12), D$(6): COLOR 7, 0
tz = 5: dtz = 4    'EST/EDT correction west of UT, change as required.
                   'Set dtz to same value as tz if Daylight Saving Time is
                   'not observed in the area (for example, Saskatchewan).
FOR c = 1 TO 12: READ Month$(c): NEXT
FOR c = 1 TO 12: READ m(c): NEXT: FOR c = 0 TO 6: READ D$(c): NEXT
DATA January,February,March,April,May,June,July
DATA August,September,October,November,December
DATA 30,28,31,30,31,30,31,31,30,31,30,31,Sun,Mon,Tue,Wed,Thu,Fri,Sat
'
cL$ = LTRIM$(RTRIM$(COMMAND$))                         'if no CMD Line, then
IF cL$ = "" THEN cL$ = DATE$ + " " + TIME$: v = 1      'calculate current JD
IF INSTR(cL$, "?") THEN GOTO help
IF INSTR(cL$, " ") = 0 AND VAL(cL$) > 12 THEN   'a Julian Number was entered
   IF VAL(cL$) < 2299161# THEN
      PRINT
      PRINT "Before Gregorian Calendar."
      END
   ELSEIF VAL(cL$) > 3000000# THEN
      PRINT
      PRINT "Invalid JD, too high."
      END
   END IF
   'Julian Day to calendar date by Peter Baum (pbaum@capecod.net)
   jd# = VAL(cL$): s# = INT(jd# - 1721118.5#)
   h# = jd# - 1721118.5# - s#: m# = 100 * s# - 25
   a& = m# \ 3652425: b = a& - a& \ 4: Y& = (100 * b + m#) \ 36525
   c = b + s# - 365 * Y& - Y& \ 4: Month = (5 * c + 456) \ 153
   D# = c - FIX((153 * Month - 457) / 5) + h#: Year = Y&
   IF Month > 12 THEN Year = Year + 1: Month = Month - 12
   IF Leap(Year) THEN m(2) = 29
   h# = (D# - INT(D#)) * 24: Day = INT(D#)
   min! = (h# - INT(h#)) * 60: hr = INT(h#)
   sec = CINT((min! - INT(min!)) * 60): min = INT(min!)
   IF sec = 60 THEN sec = 0: min = min + 1
   IF min = 60 THEN min = 0: hr = hr + 1
   IF hr = 24 THEN hr = 0: Day = Day + 1
   IF Day > m(Month) THEN Day = 1: Month = Month + 1
   IF Month > 12 THEN Month = 1: Year = Year + 1
   EDTbegins! = VAL(STR$(4 + EDT(Year) / 100) + "07") 'GMT at EDT switchover
   ESTbegins! = VAL(STR$(10 + EST(Year) / 100) + "06")         'same for EST
                                                    'change "07" and "06" to
                                        ' "10" and "09" for PST (an example)
   IF hr < 10 THEN tmp$ = "0" ELSE tmp$ = ""
   now! = VAL(STR$(Month + Day / 100) + tmp$ + LTRIM$(STR$(hr)))
   IF now! >= EDTbegins! AND now! < ESTbegins! THEN adj = dtz ELSE adj = tz
   hr = hr - adj: IF hr < 0 THEN hr = hr + 24: Day = Day - 1
   IF Day < 1 THEN
      IF Month = 1 THEN
         Month = 12
         Year = Year - 1
      ELSE
         Month = Month - 1
      END IF
      Day = m(Month)
   END IF
   PRINT : PRINT cL$; " = "; Month$(Month); " ";
   IF Day < 10 THEN PRINT "0";
   PRINT LTRIM$(STR$(Day)); ","; Year; "(";
   PRINT D$(Weekday(Month, Day, Year)); ")  "
   PRINT LTRIM$(STR$(To12(hr2))); ":"; : IF min < 10 THEN PRINT "0";
   PRINT LTRIM$(STR$(min)); ":"; : IF sec < 10 THEN PRINT "0";
   PRINT LTRIM$(STR$(sec)); " "; ap$;
   IF adj = 4 THEN PRINT " (EDT)";  ELSE PRINT " (EST)";
   utc# = hr + adj + min / 60 + sec / 3600
   IF utc# >= 24 THEN utc# = utc# - 24: v$ = "tomorrow" ELSE v$ = ""
   PRINT "  UT ="; utc#; v$
ELSE                    'a calendar DATE and, optionally, a TIME was entered
   a$ = cL$                            'work with a$ instead of changing cL$
   FOR c = 1 TO 5: PRINT : NEXT
   IF v THEN
      PRINT
      PRINT CHR$(34); cL$; CHR$(34); " Using System DATE/TIME (?=help)"
   END IF
   CALL ParseInp(a$)
   'Scan modified COMMAND line and retrieve numerical values
   a$ = MTRIM$(a$, "__"): c = 1
   WHILE a$ <> ""
      IF VAL(a$) > 32767 THEN GOTO errer
      TD(c) = VAL(a$): a$ = MID$(a$, INSTR(a$, "_") + 1)
      PRINT TD(c), "a$="; CHR$(34); a$; CHR$(34)
      c = c + 1
   WEND
   Month = TD(1): Day = TD(2): Year = TD(3)
   hr = TD(4): min = TD(5): sec = TD(6)
   IF hr > 23 OR min > 59 OR sec > 59 THEN GOTO errer
   IF Year >= 0 AND Year < 100 THEN Year = 1900 + Year
   IF Year < 1583 OR Year > 9999 THEN GOTO errer
   m(2) = 28 - Leap(Year)                'Set days in Feb. if YEAR is valid
   IF Month < 1 OR Month > 12 THEN GOTO errer        'Check for valid month
   IF Day < 1 OR Day > m(Month) THEN GOTO errer        'Check for valid day
   '
   'Example of using the remaining subprograms: To12, Weekday, EDT, EST
   PRINT : PRINT "("; D$(Weekday(Month, Day, Year)); ") ";
   PRINT Month$(Month); STR$(Day); ","; Year;
   EDTbegins! = VAL(STR$(4 + EDT(Year) / 100) + "02")
   ESTbegins! = VAL(STR$(10 + EST(Year) / 100) + "02")
   IF hr < 10 THEN tmp$ = "0" ELSE tmp$ = ""
   now! = VAL(STR$(Month + Day / 100) + tmp$ + LTRIM$(STR$(hr)))
   IF now! >= EDTbegins! AND now! < ESTbegins! THEN adj = dtz ELSE adj = tz
   IF m(2) = 29 THEN PRINT " {Leap Year} ";
   IF c > 4 THEN                                        'a TIME was entered
      IF ap$ = "am" AND hr = 12 THEN hr = 0                       'to 24-hr
      IF ap$ = "pm" AND hr < 12 THEN hr = hr + 12
      h$ = STR$(To12(hr))
      m$ = LTRIM$(STR$(min)): IF LEN(m$) = 1 THEN m$ = "0" + m$
      s$ = LTRIM$(STR$(sec)): IF LEN(s$) = 1 THEN s$ = "0" + s$
      PRINT h$ + ":" + m$ + ":" + s$; " "; ap$;
      IF adj = dtz THEN PRINT " EDT" ELSE PRINT " EST"
      IF ap$ = "am" AND hr = 12 THEN hr = 0
      h$ = LTRIM$(STR$(hr)): IF LEN(h$) = 1 THEN h$ = "0" + h$
      m$ = LTRIM$(STR$(min)): IF LEN(m$) = 1 THEN m$ = "0" + m$
      s$ = LTRIM$(STR$(sec)): IF LEN(s$) = 1 THEN s$ = "0" + s$
      PRINT h$; ":"; m$; ":"; s$; " ";
   END IF
   'set local time to UT to calculate JD
   utc# = hr + min / 60 + sec / 3600 + adj
   IF h$ = "" THEN utc# = 12: w$ = "Setting " ELSE w$ = ""
   jul# = Julian#(Year, Month, Day, utc#)
   IF utc# >= 24 THEN
      utc# = utc# - 24: v$ = " tomorrow"
   ELSE
      v$ = ""
   END IF
   PRINT "("; w$; "UT:"; STR$(utc#); v$; ") ="; jul#
END IF
'
help:
IF INSTR(cL$, "?") THEN
   PRINT : COLOR 14, 0: PRINT "SYNTAX:";
   COLOR 3: PRINT " jd  m d yyyy"; : COLOR 7: PRINT "[";
   COLOR 3: PRINT " h/m/s"; : COLOR 7: PRINT "]";
   COLOR 3: PRINT "  or  jd Julian# (>= 2,299,161)": COLOR 7
   PRINT " m = 1 or 2 digits, or at least 3 letters of the month name"
   PRINT " d = 1 or 2 digits"
   PRINT " y = 4 digits (2 digits may be used for years in the 1900s)"
   PRINT : COLOR 15
   PRINT "If a TIME is entered it must follow these conventions:"
   COLOR 7
   PRINT " h = 1 or 2 digits (24-hour or 12-hour TIME [AM/PM])"
   PRINT " m = 1 or 2 digits (m may be left out if it is zero)"
   PRINT " s = 1 or 2 digits (s may be left out if it is zero)"
END IF
COLOR 3: SYSTEM
errer: PRINT : PRINT "Error: "; cL$; Month; Day#; Year; hr; min; sec
SYSTEM
'NOTE:  The statements that show it working should be removed. They make
'       understanding the program a bit easier.

'These FUNCTIONS are derived from the Weekday(Month,Day,Year) function by
'substituting known values for Month and Day. It could also be written as:
'
'   FUNCTION EDT (Year)
'      Day = 1 'start at the first of April and search for a Sunday
'      WHILE Weekday (4, Day, Year) <> 0     '4 = April, 0 = Sunday
'         Day = Day + 1
'      WEND: EDT = Day
'   END FUNCTION
'
'...but calling one FUNCTION from another reduces portability (both must be
'included even if only one is required by the program). EST() and EDT() may
'both be moved to another program module since they are written as stand-
'alone FUNCTIONs.
'
'EXAMPLE: Find the date of Daylight Saving Time in Holland, UT + 2,
'where the change from CET (Central European Time, UT + 1) occurs on
'the last Sunday in March (at 3:00 am).
'
'from the Weekday FUNCTION:
'   tmp = (14 - Month) \ 12: y = Year - tmp: m = Month - 2 + 12 * tmp
'   Weekday = (Day + y + y \ 4 - y \ 100 + y \ 400 + (31 * m) \ 12) MOD 7
'
'tmp = (14 - 3) \ 12       '= zero
'y = Year - tmp            '= Year
'm = Month - 2 + 12 * tmp  '= 3-2+12*0 = 1
'(31 * m) \ 12             '(31 * 1) \ 12 = 2
'
'hence:
'
'FUNCTION CEDT (y&)
'   c = 25  'Start on the 25th of March.
'   WHILE (c + y& + y& \ 4 - y& \ 100 + y& \ 400 + 2) MOD 7 <> 0
'      c = c + 1
'   WEND: CEDT = c    'c is the date of the last Sunday in March
'END FUNCTION
'
'EXAMPLE 2: Find MST for the year 2001 (UT - 7 hours, last Sunday
'                                       in October at 2:00 am MDT)
'
'tmp = (14 - 10) \ 12      '= 0
'y = 2001 - 0              '= 2001
'm = Month - 2 + 12 * tmp  '= 10-2+12*0 = 8
'(31 * m) \ 12             '(31 * 8) \ 12 = 20
'
'   c = 25  'Start on Oct. 25th
'   WHILE (c + y& + y& \ 4 - y& \ 100 + y& \ 400 + 20) MOD 7 <> 0
'   ... etc:
'
'same as EST, except tz would be set to 7, instead
'of 5 (and dtz = 6 vs. 4) in the Main Module and the
'FUNCTION renamed to 'FUNCTION MST (y)'. Search and
'Change all occurrences of EST with MST and EDT with MDT.
'
'finally, here is the FUNCTION:
'
FUNCTION EDT (Y)
   c = 1    'Get date of first Sunday in April (EDT begins)
   WHILE (c + Y + Y \ 4 - Y \ 100 + Y \ 400 + 5) MOD 7 <> 0
      c = c + 1
   WEND: EDT = c
END FUNCTION

FUNCTION EST (Y) STATIC  'change FUNCTION Name to your timezone
   c = 25   'Get date of last Sunday in October (EST begins)
   WHILE (c + Y + Y \ 4 - Y \ 100 + Y \ 400 + 20) MOD 7 <> 0
      c = c + 1
   WEND: EST = c
END FUNCTION

'by Meeus, all values are integers, except JD.
'y = y + (m < 3): m = m - 12 * (m < 3): a = y \ 100: b = 2 - a + a \ 4
'JD = INT(365.25 * (y + 4716)) + INT(30.6001 * (m + 1)) + d + b - 1524
'
'from Pacific Exchange, UBC, Canada.
FUNCTION Julian# (Year, Month, Day, utc#)
   Y& = Year: D# = Day: tmp# = 367 * Y& - 7 * (Y& + (Month + 9) \ 12) \ 4
   tmp# = tmp# - 3 * ((Y& + (Month - 9) / 7) \ 100 + 1) \ 4
   Julian# = tmp# + 275 * Month \ 9 + D# + 1721028.5# + utc# / 24
END FUNCTION

FUNCTION Leap (Y)     'from the ABC Archives, author unknown.
   Leap = Y MOD 4 = 0 AND (Y MOD 100 = 0 IMP Y MOD 400 = 0)
END FUNCTION

'remove duplicated B$ in A$, "--1---2----3----" becomes "1-2-3-" if b$ = "--"
FUNCTION MTRIM$ (a$, b$)
   IF a$ = "" OR b$ = "" THEN EXIT FUNCTION
   WHILE LEFT$(a$, 1) = LEFT$(b$, 1)               'remove leading duplicates
      a$ = MID$(a$, 2)
   WEND
   k = INSTR(a$, b$): flag = 0
   WHILE k
      a$ = LEFT$(a$, k) + MID$(a$, k + 2)
      k = INSTR(a$, b$): PRINT CHR$(34); a$; CHR$(34); " ";
      IF flag = 0 THEN               'Remove this IF...ELSE...ENDIF structure
         flag = 1
         PRINT "start MTRIM$"
      ELSE
         PRINT "working"
      END IF
   WEND
   PRINT "Done: a$="; CHR$(34); a$; CHR$(34): PRINT
   MTRIM$ = a$
END FUNCTION

SUB ParseInp (a$)
   SHARED ap$
   ap$ = "": dt$ = "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"
   PRINT CHR$(34); a$; CHR$(34); " Original input"
   IF a$ <> COMMAND$ THEN
      a$ = UCASE$(a$): PRINT CHR$(34); a$; CHR$(34); " to UPPERCASE"
   END IF
   FOR c = 1 TO 34 STEP 3
      k = INSTR(a$, MID$(dt$, c, 3))
      IF k THEN
         MID$(a$, k) = STR$(c \ 3 + 1)
         PRINT CHR$(34); a$; CHR$(34);
         PRINT " Month-name detected, replaced with Number"
      END IF
   NEXT
   FOR c = 1 TO LEN(a$)
      ascii = ASC(MID$(a$, c, 1))
      IF ascii < 48 OR ascii > 57 AND ascii <> 80 AND ascii <> 65 THEN
         MID$(a$, c, 1) = " "
      END IF
   NEXT: PRINT CHR$(34); a$; CHR$(34); " Nonessentials replaced"
   a$ = LTRIM$(RTRIM$(a$)): PRINT CHR$(34); a$; CHR$(34); " squeezed";
   k$ = ""
   IF RIGHT$(a$, 1) = "A" THEN
      ap$ = "am"
      PRINT " (AM detected)"
   ELSEIF RIGHT$(a$, 1) = "P" THEN
      ap$ = "pm"
      PRINT " (PM detected)"
   ELSE
      k$ = "_"
      a$ = a$ + k$
      PRINT
   END IF
   FOR c = 1 TO LEN(a$)
      ascii = ASC(MID$(a$, c, 1))
      IF ascii < 48 OR ascii > 57 THEN
         MID$(a$, c, 1) = "_"
      END IF
   NEXT
   PRINT CHR$(34); a$; CHR$(34); " All ALPHA replaced";
   IF k$ <> "" THEN
      PRINT ", "; CHR$(34); k$; CHR$(34); " added."
   ELSE
      PRINT
   END IF
END SUB

FUNCTION To12 (Hour)  'changes 24-hour format to 12-hour, AM/PM
   SHARED ap$: IF Hour = 24 THEN Hour = 0
   IF Hour < 12 THEN ap$ = "am" ELSE ap$ = "pm"
   IF Hour = 0 THEN Hour = 12
   IF Hour > 12 THEN To12 = Hour - 12 ELSE To12 = Hour
END FUNCTION

'from the ABC Archives, author unknown.
FUNCTION Weekday (Month, Day, Year)
   tmp = (14 - Month) \ 12: Y = Year - tmp: m = Month - 2 + 12 * tmp
   Weekday = (Day + Y + Y \ 4 - Y \ 100 + Y \ 400 + (31 * m) \ 12) MOD 7
END FUNCTION