home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rexxalgo.zip / TESTALGO / J2G.CMD < prev    next >
OS/2 REXX Batch file  |  1997-08-11  |  4KB  |  142 lines
  1. /* REXX **********************************************/
  2. /*                                                   */
  3. /* Program name: J2G                                 */
  4. /* Function    : translates julian date to gregorian */
  5. /*               date                                */
  6. /* Syntax      : gDat = J2G(yyyy.ddd)                */
  7. /* Changes     :                                     */
  8. /* Author      : Janosch R. Kowalczyk                */
  9. /*                                                   */
  10. /* (C) Copyright Janosch R. Kowalczyk, 1996.         */
  11. /* All rights reserved.                              */
  12. /* Made use of GREED.  09 Jul 1996 / 18:08:30   JRK  */
  13. /*****************************************************/
  14. Parse Arg julDate
  15.  
  16. If julDate = '' Then julDate = 1983.267
  17.  
  18. /*-------------(Exceptions handling)--------------*/
  19. Signal On Failure Name CLEANUP
  20. Signal On Halt    Name CLEANUP
  21. Signal On Syntax  Name CLEANUP
  22.  
  23. If RxFuncQuery('SysLoadFuncs') Then Do
  24.   Call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  25.   Call SysLoadFuncs
  26. End /* If RxFuncQuery... */
  27.  
  28. If julDate > '' Then Do
  29.   Say
  30.   text = 'Test J2G (translate Julian date to Gregorian date):'
  31.   Say Center( "(" text ")", 80, '*')
  32.   julDate = TestDate(julDate)
  33.   Say julDate '--->' J2G(julDate)
  34.   Say '1900.001 --->' J2G('1900.001')
  35.   Say '1900.059 --->' J2G('1900.059')
  36.   Say '1900.060 --->' J2G('1900.060')
  37.   Say '1900.061 --->' J2G('1900.061')
  38.   Say '1900.365 --->' J2G('1900.365')
  39.   Say '1996.001 --->' J2G('1996.001')
  40.   Say '1996.059 --->' J2G('1996.059')
  41.   Say '1996.060 --->' J2G('1996.060')
  42.   Say '1996.061 --->' J2G('1996.061')
  43.   Say '1996.365 --->' J2G('1996.365')
  44.   Say '2000.001 --->' J2G('2000.001')
  45.   Say '2000.059 --->' J2G('2000.059')
  46.   Say '2000.060 --->' J2G('2000.060')
  47.   Say '2000.061 --->' J2G('2000.061')
  48.   Say '2000.365 --->' J2G('2000.365')
  49.   Say
  50. End
  51. Else
  52.   Call HelpText
  53.  
  54. /*-------------------(End program)------------------*/
  55. Call CharOut , "Press any key to exit "
  56. Call LineIn
  57.  
  58. Exit
  59.  
  60. CLEANUP:
  61.   Say
  62.   Say 'GREED001E - Break, Failure or Syntax Error'
  63. Exit
  64.  
  65.  
  66. HelpText: Procedure
  67.  
  68. Say 'Syntax:'
  69. Say
  70. Say 'J2G julian_date'
  71. Say
  72. Say 'julian_date has format: yyyy.ddd (0 < ddd < 367)'
  73.  
  74. Return
  75.  
  76.  
  77. /*===============(Test plausibilty)================*/
  78. TestDate: Procedure
  79. Arg julDate
  80.  
  81. Parse Var julDate year '.' jday
  82. If jday = '' Then Do
  83.   jday = year
  84.   Parse Value Date() With . . year .
  85. End
  86. If jday < 0 ! jday > 366 Then Do
  87.   Call HelpText
  88.   Exit
  89. End
  90. If Length(year) = 2 Then year = '19' || year
  91.  
  92. Return year || '.' || jday
  93.  
  94.  
  95. /*==========(Julian Date to Gregorian Date)==========*/
  96. J2G: Procedure
  97. /*---------------------------------------------------*/
  98. /*                                                   */
  99. /* Program name: J2G                                 */
  100. /* Function    : translates julian to gregorian      */
  101. /*               date                                */
  102. /* Syntax      : J2G yyyy.ddd                        */
  103. /* Author      : Janosch R. Kowalczyk                */
  104. /* Changes     :                                     */
  105. /*                                                   */
  106. /* (C) Copyright Janosch R. Kowalczyk, 1996.         */
  107. /* All rights reserved.                              */
  108. /* Made use of GREED.  09 Jul 1996 / 18:08:30   JRK  */
  109. /*---------------------------------------------------*/
  110. Arg julDate
  111.  
  112. Parse Var julDate year'.'jday
  113.  
  114. mon.0  = 12
  115. mon.1  = 0
  116. mon.2  = 31
  117. mon.3  = 59
  118. mon.4  = 90
  119. mon.5  = 120
  120. mon.6  = 151
  121. mon.7  = 181
  122. mon.8  = 212
  123. mon.9  = 243
  124. mon.10 = 273
  125. mon.11 = 304
  126. mon.12 = 334
  127.  
  128. If year // 400 = 0 | (year // 100 > 0 & year // 4 = 0) Then
  129.   leap = 1
  130. Else
  131.   leap = 0
  132.  
  133. Do i = 1 To mon.0 
  134.   If i > 2 Then mon.i = mon.i + leap
  135.   If jday > mon.i Then mon = i
  136. End
  137.  
  138. day = jday - mon.mon
  139. gregDate = year'.'Right(mon,2,'0')'.'Right(day,2,'0')
  140.  
  141. return gregDate
  142.