Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Date Manipulation - Julian Date

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Date Manipulation - Julian Date

    'please post comments at: http://www.powerbasic.com/support/pb...ad.php?t=21524
    Code:
    #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).]

  • #2
    Date to Julian and back

    I have used this for some time.
    Code:
    #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
    Last edited by Steve R Geisler; 12 Feb 2015, 01:11 PM. Reason: add code tags.

    Comment


    • #3
      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

      Comment


      • #4
        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.

        Comment


        • #5
          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.
          Michael Mattias
          Tal Systems (retired)
          Port Washington WI USA
          [email protected]
          http://www.talsystems.com

          Comment


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

            A little different approach, I think..
            Code:
            #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
            Tal Systems (retired)
            Port Washington WI USA
            [email protected]
            http://www.talsystems.com

            Comment

            Working...
            X