home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROCS.ZIP / FULL13TH.ICN < prev    next >
Encoding:
Text File  |  1992-11-20  |  2.3 KB  |  78 lines
  1. ############################################################################
  2. #
  3. #    File:     full13th.icn
  4. #
  5. #    Subject:  Procedure to give days when a full moon occurs on
  6. #              Friday the 13th
  7. #
  8. #    Author:   Ralph E. Griswold
  9. #
  10. #    Date:     September 6, 1992
  11. #
  12. ###########################################################################
  13. #
  14. #  full13th(year1, year2) generates records giving the days on
  15. #  which a full moon occurs on Friday the 13th in the range from
  16. #  year1 though year2.
  17. #
  18. ############################################################################
  19. #
  20. #  Acknowledgement:  This procedure is based on an algorithm given in
  21. #  "Numerical Recipes; The Art of Scientific Computing"; William H. Press,
  22. #  Brian P. Flannery, Saul A. Teukolsky. and William T. Vetterling;
  23. #  Cambridge University Press, 1986.
  24. #
  25. ############################################################################
  26. #
  27. #  Links: pom, julian
  28. #
  29. ############################################################################
  30.  
  31. record date(month, year, fraction)
  32.  
  33. link julian
  34. link pom
  35.  
  36. procedure full13th(year1, year2)
  37.    local time_zone, jd, jday, fraction, jul
  38.    local year, month, julday, n, icon, day_of_week, c
  39.  
  40.    time_zone :=  -5.0 / 24.0
  41.  
  42.    every year := year1 to year2 do {
  43.       every month := 1 to 12 do {
  44.          jday := julian(month, 13, year)
  45.          day_of_week := (jday + 1) % 7
  46.          if day_of_week = 5 then {
  47.             n := integer(12.37 * (year - 1900 + integer((month - 0.5) / 12.0)))
  48.             icon := 0
  49.             repeat {
  50.                jul := pom(n,2)
  51.                jd := jul.number
  52.                fraction := 24.0 * (jul.fraction + time_zone)
  53.                if (fraction < 0.0) then {
  54.                   jd  -:= 1
  55.                   fraction  +:= 24.0
  56.                   }
  57.                if fraction > 12.0 then {
  58.                   jd +:= 1
  59.                   fraction -:= 12.0
  60.                   }
  61.                else fraction  +:= 12.0
  62.                if jd = jday then {
  63.                   suspend date(month, year, fraction)
  64.                   break
  65.                   }
  66.                else {
  67.                   c := if jday >= jd then 1 else -1
  68.                   if c = -icon then break
  69.                   icon := c
  70.                   n +:= c
  71.                   }
  72.                }
  73.             }
  74.          }
  75.       }
  76.  
  77. end
  78.