From:	MERC::"uunet!CRVAX.SRI.COM!RELAY-INFO-VAX" 22-JUN-1992 13:05:43.01
To:	info-vax@kl.sri.com
CC:	
Subj:	Re: Phases of the Moon (The Epic Continues)

In article <01GLFLFSR9R4000LSN@EKU.BITNET>, STUBRBEE@EKU.BITNET (Oooooooops) writes:
> Vaxpeoples,
> 
>      Some time ago I requested info about finding what day of the week any
> given date is on.

I've been using the following Bliss routine for many years and
it seems to be pretty accurate.  

I'll ship you a MACROized version if you want to spare yourself
of converting it to another language (for those of you sans bliss compilers).

Jonathan Welch  VAX Systems Manager  Umass/Amherst  JHWELCH@ecs.umass.edu

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

MODULE LIB_pom(IDENT='V04-000',ADDRESSING_MODE(EXTERNAL=GENERAL)) =
BEGIN
  LIBRARY 'SYS$LIBRARY:starlet';

GLOBAL ROUTINE LIB_pom(time,phase_code,age) =
!Phase of the Moon routine:
!	status.wlc.v = LIB_pom(time.rq.r,phase_code.wbu.r,age.wbu.r)
!	Arguments:
!		TIME -		optional time for computation; address 0 = now.
!		PHASE_CODE -	code for the phase:
!			0 = new, 1 = waxing crescent, 2 = first quarter
!			3 = waxing gibbous, 4 = full, 5 = waning gibbous,
!			6 = last quarter, 7 = waning crescent.
!		AGE -		days since new moon.
!	All arguments are optional.
!Times:  The moon's period is taken as 2551440 seconds (29d 12h44m).
!  The phases are New: 0 sec, FQ: 638100 sec, Full: 1276127 sec, LQ: 1913785.
!  Each of these primary phases is held to last 12 hours (43200 sec) to each 
!  side of the given value.  Computations are made in 10 second units to avoid
!  EDIV overflow.
BEGIN
  EXTERNAL LITERAL
    LIB__early;
  LITERAL
    period = 255144;
  LOCAL
    timadr : VECTOR[2],
    basetime : VECTOR[2] INITIAL(%X'85E8A000',%X'86C199'), !28-JAN-79 0120
    seconds,
    phase_table : VECTOR[9] INITIAL(4320,59466,68106,123252,131892,
    					187038,195678,250824,255144);
  BUILTIN
    EDIV, SUBM,
    actualcount,
    nullparameter;
  MACRO test(val) = (LOCAL sts; IF NOT (sts = (val)) THEN RETURN .sts)%;
  IF nullparameter(1) THEN test($gettim(TIMADR=timadr))
  ELSE IF actualcount() EQL 1 THEN RETURN 1
    ELSE
      (CH$move(8,.time,timadr);
       IF (.timadr[1] EQL 0) AND (.timadr[0] EQL 0)
	 THEN test($gettim(TIMADR=timadr))
      );
  SUBM(2,basetime,timadr,timadr); IF .timadr[1] LEQ 0 THEN RETURN LIB__early;
  EDIV(%REF(100000000),timadr,seconds,basetime);
  seconds = .seconds MOD period;
  IF NOT nullparameter(2) THEN
    (.phase_code)<0,8,0> = (INCR i FROM 0 TO 8 DO
    		    IF .seconds LSS .phase_table[.i] THEN EXITLOOP .i) MOD 8;
  IF NOT nullparameter(3) THEN
    (.age)<0,8,0> = .seconds/(24*360);
  1
END;
END
ELUDOM

