'===========================================================================
' Subject: JULIAN DAY <> GREGORIAN DATE       Date: 12-26-00 (10:25)       
'  Author: David Williams                     Code: QB, QBasic, PDS        
'  Origin: david.williams@capcanada.com     Packet: DATETIME.ABC
'===========================================================================
'Julian Day <> Gregorian date interconverter
'David Williams 2000
'david.williams@ablelink.org
'Public Domain. No price. No warranty
DECLARE FUNCTION Jday& (Y&, M&, D&)
DECLARE SUB Greg (J&, Y&, M&, D&)
DECLARE FUNCTION DM& (V&)
DECLARE FUNCTION DM2& (V&)
DEFLNG A-Z
COMMON SHARED N, Z
Z = 1721120
CLS
Start:
PRINT "1. Gregorian to Julian"
PRINT "2. Julian to Gregorian"
PRINT
PRINT "Which? (1 or 2): ";
DO
  K$ = INKEY$
LOOP UNTIL K$ = "1" OR K$ = "2"
PRINT K$
PRINT
IF K$ = "1" THEN
  DO
    INPUT "Year, Month, Day (YYYY,MM,DD including commas)"; Y, M, D
    J = Jday(Y, M, D)
    CALL Greg(J, P, Q, R)
    IF P = Y AND Q = M AND R = D THEN EXIT DO
    BEEP
    PRINT "Illegal Gregorian date!"
  LOOP
  PRINT "Julian Day is"; J
ELSE
  INPUT "Julian Day"; J
  CALL Greg(J, Y, M, D)
  PRINT "Gregorian date (Y,M,D) is: "; Y; ","; M; ","; D
END IF
PRINT
PRINT "Another? (y/n) ";
DO
  K$ = LCASE$(INKEY$)
LOOP UNTIL K$ = "y" OR K$ = "n"
PRINT K$
IF K$ = "y" THEN
  PRINT
  GOTO Start
END IF
END

FUNCTION DM (V)
  Q = N \ V
  N = N MOD V
  DM = Q
END FUNCTION

FUNCTION DM2 (V)
  Q = N \ V
  IF Q = 4 THEN Q = 3
  N = N - Q * V
  DM2 = Q
END FUNCTION

SUB Greg (J, Y, M, D)
  N = J - Z
  A = 400 * DM(146097) + 100 * DM2(36524) + 4 * DM(1461) + DM2(365)
  B = 5 * DM(153) + 2 * DM(61) + DM(31)
  IF B < 10 THEN
    M = B + 3
    Y = A
  ELSE
    M = B - 9
    Y = A + 1
  END IF
  D = N + 1
END SUB

FUNCTION Jday (Y, M, D)
  IF M > 2 THEN
    B = M - 3
    A = Y
  ELSE
    B = M + 9
    A = Y - 1
  END IF
  L = A \ 4 - A \ 100 + A \ 400
  C = CLNG(30.6 * B)
  Jday = Z + 365 * A + L + C + D - 1
END FUNCTION