home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / julian.zip / JULDATE.CMD next >
OS/2 REXX Batch file  |  1997-09-15  |  5KB  |  175 lines
  1. /*#! rexx*/
  2. /*****************************************************************
  3. * Juldate.cmd
  4. * Author Kurt A. Spaugh, Softlynks Inc.
  5. * Fort Lauderdale FL.
  6. * Copyleft (c) 1996
  7. * 
  8. * call greg2jul(gregdate) for julian day
  9. * call jul2greg(juldate) to convert julian day to gregorian date
  10. *
  11. * Useful: The naval observatory abreviates the julian date in 
  12. * their time transmissions as julianDay-2400000.
  13. * e.g. 10/13/1997 (2450735 Julian) is abbreviated as 50735
  14. * ...why they picked 11/16/1858 is beyond me...
  15. * Another common contraction subtracts  5/23/1968, or 2440000
  16. *
  17. * Bugs: they're yours to keep.  The code is free.
  18. *       None observed to date.
  19. *
  20. * Suggestions:
  21. * The code is a straight forward translation. Some economy
  22. * can be had by folding expressions. Is is worth it?
  23. * I used modulo arithmetic to int-ify real numbers.
  24. * Is trunc(exp) better/faster than epx%1 ??
  25. *
  26. * Notes:
  27. * Because of the change to Gregorian calendar,
  28. * Thursday Oct. 4,1582, is followed by Friday Oct. 15, 1582.
  29. * Entering these dates will produce correct, but odd, results:
  30. * 10/5/1582 is julian day 2299161.
  31. * Julian day 2299161 when converted to gregorian will return
  32. * 10/15/1582...this is normal, and correct, AFAIK
  33. *****************************************************************/
  34. /* sample main to try code */
  35. parse arg mm '/' dd '/' yy   /* must put in full year- eg 1999 */
  36. jul= greg2jul( mm,dd,yy)
  37. say 'Stardate:' jul
  38.  
  39. greg = jul2greg(jul)
  40. say greg 'is a' whatday(jul,'text')
  41.  
  42. DST=todst(yy)
  43. std=TOstd(yy)
  44. say 'In' yy||', DST starts on:' WHATDAY(dst,'t')||',' jul2greg(dst)
  45. say 'In' yy||', EST starts on:' WHATDAY(std,'t')||',' jul2greg(std)
  46.  
  47. if isleap(yy) then 
  48.   say yy 'is a leap year.'
  49. else
  50.   say yy 'is not a leap year.'
  51.  
  52. return
  53.  
  54. /*********************************************/
  55. /* Adapted from 'Numerical Recipes In C'     */
  56. /* Cambridge Press                           */
  57. /* Adaptation by Kurt Spaugh, Softlynks Inc. */
  58. /* Comments omitted. Some Math Buddah figured*/
  59. /* this out. It just works. Go Figure.       */
  60. /*********************************************/
  61. greg2jul: procedure
  62. do
  63.   parse arg mm,id,iyyy
  64.   igreg=(15+31*(10+12*1582))
  65.  
  66.   jy=iyyy;
  67.   if jy = 0 then
  68.   do
  69.     say "there is no year 0"
  70.     exit 255
  71.   end /* do */
  72.   if jy < 0 then jy=jy+1
  73.   if mm > 2 then jm=mm+1
  74.   else
  75.   do
  76.      jy=jy-1
  77.      jm=mm+13
  78.   end /* do */
  79.   jul=(365.25*jy)%1+(30.6001*jm)%1+id+1720995
  80.   if( id+31*(mm+12*iyyy) >= igreg) then
  81.   do
  82.      ja=(.01*jy)%1
  83.      jul=jul+(2-ja+(0.25*ja)%1)
  84.   end /* do */
  85.   return jul
  86. end
  87. /****************************************************************/
  88. /*jul2greg(juldate)  Also adapted from 'Numerical Recipes in C' */
  89. /*Adaptation by Kurt Spaugh, Softlynks Inc.                     */ 
  90. /****************************************************************/
  91. jul2greg: procedure 
  92. do
  93.    igreg=2299161
  94.    parse arg julian
  95.    if julian  >= igreg then
  96.    do
  97.       jalpha=(((julian-1867216)-0.25)/36524.25)%1
  98.       ja=julian+1+jalpha-(0.25*jalpha)%1
  99.    end /* do */
  100.    else
  101.      ja=julian
  102.    jb=ja+1524
  103.    jc=(6680+((jb-2439870)-122.1)/365.25)%1
  104.    jd=(365*jc+(0.25*jc))%1
  105.    je=(((jb-jd)/30.6001))%1
  106.    id=jb-jd-(30.6001*je)%1
  107.    mm=je-1
  108.    if(mm>12) then
  109.      mm=mm-12
  110.    iyyy=jc-4715
  111.    if( mm>2) then
  112.      iyyy=iyyy-1
  113.    if( iyyy <= 0 ) then
  114.      iyyy=iyyy-1
  115.    return mm||'/'||id||'/'||iyyy
  116. end /* do */
  117.  
  118. whatday:procedure
  119. parse arg jul,mode    /* if mode='' then just the remainder is returned */
  120.  x=(jul+1)//7
  121.  if mode \= '' then
  122.  select
  123.    when x=0 then return 'Sunday'
  124.    when x=1 then return 'Monday'
  125.    when x=2 then return 'Tuesday'
  126.    when x=3 then return 'Wednesday'
  127.    when x=4 then return 'Thursday'
  128.    when x=5 then return 'Friday'
  129.    when x=6 then return 'Saturday'
  130.  end
  131.  else
  132.    return x
  133.  
  134. /*
  135. *  when is first Sunday in April? 
  136. */
  137. ToDST:procedure        
  138. do
  139.    parse arg year
  140.    day1=greg2jul(4,1,year)
  141.    x=whatday(day1,'');
  142.    if(x > 0) then
  143.      x=7-x
  144.    return day1+x
  145. end /* do */
  146.  
  147. /*
  148. *  when is last Sunday in October?
  149. */
  150. ToSTD: procedure        
  151. do
  152.    parse arg year
  153.    day31=greg2jul(10,31,year)
  154.    x=whatday(day31,'');
  155.    return day31-x
  156. end /* do */
  157.  
  158. IsLeap: procedure
  159. do
  160.   parse arg year
  161.   if year = -1 then
  162.     adder=2
  163.   else
  164.      adder=1
  165.   if greg2jul(1,1,year+adder)-greg2jul(1,1,year) = 366 then
  166. /*  if greg2jul(1,1,year+1)-greg2jul(1,1,year) = 366 then*/
  167.     return 1
  168.   return 0
  169. end
  170.  
  171.  
  172.  
  173.  
  174.  
  175.