Date Manipulation - Julian Date

[Michael Mattias]

This is something I whipped up when I saw all that floating point arithmetic.

A little different approach, I think..

#COMPILE EXE
#DIM ALL
#REGISTER NONE
#COMPILER PBWIN 9


' Needed items from Win32API:
TYPE SYSTEMTIME
  wYear AS WORD
  wMonth AS WORD
  wDayOfWeek AS WORD
  wDay AS WORD
  wHour AS WORD
  wMinute AS WORD
  wSecond AS WORD
  wMilliseconds AS WORD
END TYPE
DECLARE FUNCTION SystemTimeToVariantTime LIB "OLEAUT32.DLL" ALIAS "SystemTimeToVariantTime" (lpSystemTime AS SYSTEMTIME, vbtime AS DOUBLE) AS LONG

' IN : string, YYYYMMDD OUT: integer YYYYddd
'FUNCTION DateToJulian (YYYYMMDD AS STRING) AS LONG ' will not compile gets "variable expected" at YYYYMMDD
FUNCTION DateToJulian (u_YYYYMMDD AS STRING) AS LONG

  LOCAL STdate, STNY AS SYSTEMTIME
  LOCAL vDate, vNY AS DOUBLE
  LOCAL iRet AS LONG, nDay AS LONG

  STDate.wDay = VAL (MID$(u_yyyymmdd,7,2))
  STDate.wMonth = VAL (MID$(u_yyyymmdd,5,2))
  STDate.WYear  = VAL (LEFT$(u_yyyymmdd,4))

  iRet =  SystemTimeToVariantTime (STdate, vDate)
  IF ISFALSE iret THEN
    ' invalid date in
    FUNCTION= -1&
    EXIT FUNCTION
  END IF

  ' find variant date of Jan 1 this year
  STNY = STDATE
  STNY.wMonth = 1
  STNY.wDay   = 1
  Iret = SystemTimeToVariantTime (STNY, vNY)

  nDay = FIX (vDate) - FIX (vNY) + 1 ' number of days between 'date' and Newyears + 1 for inclusive

  FUNCTION =   STDate.wYear * 1000& + nDay
END FUNCTION

FUNCTION PBMAIN() AS LONG
 LOCAL uDate AS STRING, sTxt AS STRING
 LOCAL iret AS LONG

 DO
   uDate = INPUTBOX$ ("Enter yyyymmdd", "Julian Date Testing")
   IF uDate = "" THEN
        EXIT DO
   ELSE
       iret =  DateToJulian (uDate)
       IF IRet = -1& THEN
           stxt = USING$("'&' is an Invalid yyyymmdd", udate)
       ELSE
           stxt = USING$ ("yyyymmdd '&' ==> #", uDate, iRet)
       END IF
       MSGBOX sTxt, , "Julian Date Results"
   END IF
 LOOP

END FUNCTION

[Michael Mattias]

You can add code tags by "Edit" of your post.

You can "edit" it now to see how easy it is to do. two short lines. Eight seconds start to finish. Less if you do it up front and don't have to go back and add later.

[Steve R Geisler]

My error

I have not posted to these forums for over a decade until recently.
I actually thought that I was sending Mike a private message with the code. I didn't plan on it showing up as it did. Thus I didn't post it properly for the forum.
I'll get the hang of it, like riding a bike I guess. But that said. If someone finds the code useful, great.

[Pierre Bellisle]

Steve,

If you feel like it, you could edit your post and add [code] before your code and [/code] after it to keep indentation.

Pierre

[Steve R Geisler]

Date to Julian and back

I have used this for some time.

#COMPILE EXE
#INCLUDE "WIN32API.INC"
'######################################################################################
FUNCTION DateToJulian(inDate AS STRING) AS LONG
  ' Returns Julian Date (Long Integer) from "String" Date formatted as:YYYYMMDD.
  LOCAL year AS LONG, _
  month AS LONG, _
  day AS LONG, _
  Elapsed AS LONG, _
  InvalidLeaps AS LONG, _
  ValidLeaps AS LONG, _
  dMonths AS LONG

  year = VAL(LEFT$(inDate,4))
  month = VAL(MID$(inDate,5,2))
  day = VAL(MID$(inDate,7,2))

  IF month < 3 THEN ' January or February?
     month = month + 12 ' 13th or 14th month ....
     DECR year ' .... of prev. year
  END IF

  Elapsed = INT((year + 4712) * 365.25) ' days in years elapsed
  InvalidLeaps = year \ 100 ' substract century leapdays
  ValidLeaps = year \ 400 ' re-add valid ones
  dMonths = INT(30.60001 * (month - 1) + .2) ' days of months elapsed + adjustment
  FUNCTION = Elapsed - InvalidLeaps + ValidLeaps + dMonths + day
END FUNCTION
'######################################################################################
FUNCTION JulToDate(Jul AS DOUBLE) AS STRING
  ' Returns "String" Date formatted as: YYYYMMDD from Julian Date (Long Integer)
  LOCAL HELP AS LONG, _
  Year AS LONG,_
  Month AS LONG,_
  Day AS LONG,_
  oText AS STRING * 8

  Jul = Jul + 68569
  HELP = 4 * Jul \ 146097
  Jul = Jul - ((146097 * HELP + 3) \ 4)
  Year = 4000 * (Jul + 1) \ 1461001
  Jul = Jul - (1461 * Year \ 4) + 31
  Month = 80 * Jul \ 2447
  Day = Jul - (2447 * Month \ 80)

  IF Month > 12 THEN Month =Month -12 AND Year = 100 * (HELP - 49) + Year + (Month \ 11) +1

  Year = 100 * (HELP - 49) + Year + (Month \ 11)
  Month = Month + 2 - (12 * (Month \ 11)) 'IF Month > 12 THEN Year=Year + 1

  oText = RIGHT$(STR$(Year),4) _
  +RIGHT$(STR$(Month),2) _
  +RIGHT$(STR$(Day),2)

  REPLACE " " WITH "0" IN oText
  FUNCTION = oText
END FUNCTION

'######################################################################################
FUNCTION EarthLon##(T AS DOUBLE)
  DIM EL0 AS DOUBLE,M AS DOUBLE,E AS DOUBLE, C AS DOUBLE, PI AS DOUBLE,EL AS DOUBLE
  PI=4 *ATN(1)
  EL0 =(.0003032*T+36000.76983#)*T+280.46645#
  M=(((-.00000048#*T-.0001559)*T+35999.0503#)*T+357.5291#)*PI/180
  E=(-.0000001236#*T-.000042037#)*T+.016708617#
  C=(SIN(M)*((-.000014*T-.004817)*T+1.9146)+SIN(2*M)*(.019993-.000101*T)+.00029*SIN(3*M))
  EL=EL0+C-.00569-180
  EarthLon##=EL-360*INT(EL/360)
END FUNCTION
'####################################################################
FUNCTION PBMAIN() AS LONG
  LOCAL inDate1 AS STRING, _
  inDate2 AS STRING, _
  Julian1 AS DOUBLE, _
  Julian2 AS DOUBLE, _
  T1 AS DOUBLE, _
  T2 AS DOUBLE, _
  Jul1 AS DOUBLE, _
  Jul2 AS DOUBLE

  inDate1 = "19500519"
  inDate2 = "20150211"
  Julian1 = DateToJulian(inDate1)
  Julian2 = DateToJulian(inDate2)
  T1=(Julian1-2451545)/36525
  T2=(Julian2-2451545)/36525

  PRINT inDate1
  PRINT inDate2
  PRINT Julian1
  PRINT Julian2

  Jul1 = Julian1
  Jul2 = Julian2

  PRINT JulToDate(Julian1) "    Julian1 back to date"
  PRINT JulToDate(Julian2) "    Julian2 back to date"
  PRINT Jul2 - Jul1  "     calendar days"

  IF EarthLon##(T1)> EarthLon##(T2)THEN
     PRINT 360.0001-EarthLon##(T1) + EarthLon##(T2)+ (INT((Jul2-Jul1)/365.25)*360.0001) "   degrees"
  ELSE
     PRINT (EarthLon##(T2)-EarthLon(T1)) + (INT((Jul2-Jul1)/365.25)*360.0001) "     degrees"
  END IF

  WAITKEY$
END FUNCTION

[Mike Doty]

'please post comments at: http://www.powerbasic.com/support/pb...ad.php?t=21524

#compile exe
#dim all
declare function date2julian(mm_dd_yyyy as string) as long
declare function julian2date(julian as long) as string

'quickpak equivalents using an epoch base date of 01-01-1980
'this allows easily storing dates in 2-bytes for 179 years from base date
declare function num2date(jd as long) as string
declare function date2num(mm_dd_yyyy as string) as long

function pbmain as long
  dim today&
  today& = date2julian(date$)
  print " using gregorian calendar
  print " today is julian "today
  print today& - date2julian("01-01-" + right$(date$,4)); "days since first of year"
  print date2julian("12-25-" + right$(date$,4)) - today&;"days until christmas"
  print today- date2julian("09-11-2001");"since 9/11"
  print today - date2julian("10-19-1987");"since black friday stock crash"
  print today - date2julian("06-06-1944");"since d-day"
  print " day 1 =" julian2date(1)   'wrong
  print " christmas 2005" date2julian("12-25-2005")
  print " 24573730 " julian2date(2453730)
  print
  print "using quickpak (dates after 12/13/1979 only. allows 2-bytes on disk)
  today = date2num(date$)
  print "today is day number" today
  print "days since first of year" today - date2num("01-01" + right$(date$,4))
  print "01-01-1980 is day number" date2num("01-01-1980")
  print format$(date2num("12-25-" + right$(date$,4)) - today&);" days until christmas"
  print "day number 1 is " num2date$(1)
  waitkey$
end function

function date2julian(mm_dd_yyyy as string) as long
  dim month&,day&,year&
  month = val(left$(mm_dd_yyyy$,2))
  day   = val(mid$(mm_dd_yyyy$,4,2))
  year = val (right$(mm_dd_yyyy$,4))

  local k as long, julian as long
  k = int((14 - month) / 12)
  julian = day + int(367 * (month + (k * 12) - 2) / 12) _
               + int(1461 * (year + 4800 - k) / 4) - 32113

  julian = julian - (int(3 * int((year + 100 - k) / 100) / 4) - 2)  'convert to gregorian
  date2julian = julian
end function

function julian2date(jd as long) as string
  dim yr$,mo$,da$
  dim m&,d&,y&, q&, r&, s&, t&, u&, v&
  q =  int((jd / 36524.25) - 51.12264)
  r = jd + q - int(q / 4) + 1
  s = r + 1524
  t = int((s / 365.25) - 0.3343)
  u = int(t * 365.25)
  v = int((s - u) / 30.61)
  d = s - u - int(v * 30.61)
  m = (v - 1) + 12 * (v > 13.5)
  y = t - (m < 2.5) - 4716

  yr$ = right$(str$(y), len(str$(y)) - 1)
  if len(yr$) < 2 then yr$ = "0" + yr$
  mo$ = right$(str$(m), len(str$(m)) - 1)
  if len(mo$) < 2 then mo$ = "0" + mo$
  da$ = right$(str$(d), len(str$(d)) - 1)
  if len(da$) < 2 then da$ = "0" + da$
  julian2date = mo$ + "-" + da$ + "-" + yr$
end function


function date2num(mm_dd_yyyy$) as long  '1/1/1980 = day 1
  dim month&,day&,year&
  month = val(left$(mm_dd_yyyy$,2))
  day   = val(mid$(mm_dd_yyyy$,4,2))
  year = val (right$(mm_dd_yyyy$,4))

  local k as long, julian as long
  k = int((14 - month) / 12)
  julian = day + int(367 * (month + (k * 12) - 2) / 12) _
               + int(1461 * (year + 4800 - k) / 4) - 32113
  julian = julian - (int(3 * int((year + 100 - k) / 100) / 4) - 2)  'convert to gregorian
  date2num = julian - 2444239  'subtract all days before (01-01-1980 =2444240) for quickpak
end function

function num2date(juliandate as long) as string  '01-01-1980 = day 1
  dim jd&,yr$,mo$,da$, m&,d&,y&, q&, r&, s&, t&, u&, v&
  jd = juliandate + 2444239  'add all days before (01-01-1980 =2444240) for quickpak
  q =  int((jd / 36524.25) - 51.12264)
  r = jd + q - int(q / 4) + 1
  s = r + 1524
  t = int((s / 365.25) - 0.3343)
  u = int(t * 365.25)
  v = int((s - u) / 30.61)
  d = s - u - int(v * 30.61)
  m = (v - 1) + 12 * (v > 13.5)
  y = t - (m < 2.5) - 4716
  yr$ = right$(str$(y), len(str$(y)) - 1)
  if len(yr$) < 2 then yr$ = "0" + yr$
  mo$ = right$(str$(m), len(str$(m)) - 1)
  if len(mo$) < 2 then mo$ = "0" + mo$
  da$ = right$(str$(d), len(str$(d)) - 1)
  if len(da$) < 2 then da$ = "0" + da$
  num2date = mo$ + "-" + da$ + "-" + yr$
end function

------------------


[this message has been edited by mike doty (edited february 26, 2005).]