1 files changed, 70 insertions, 0 deletions
diff --git a/Ganlib/data/badluk.x2m b/Ganlib/data/badluk.x2m
new file mode 100644
index 0000000..2bdb2e5
--- /dev/null
+++ b/Ganlib/data/badluk.x2m
@@ -0,0 +1,70 @@
+ ! "badluk" program to look for full moons on Friday the 13-th
+ !
+ !  REFERENCE: "Numerical recipes in FORTRAN,
+ !              The Art of Scientific Computing, Second Edition"
+ !              Press, Teukolsky, Vetterling, Flannery
+ !              Cambridge University Press
+ !              ISBN 0-521-43064-X
+ !      PAGES:  14 ("PROGRAM badluk")
+ 
+ INTEGER ic icon idwk ifrac im iyyy jd jday n ;
+ REAL    TIMZON := -5. 24. / ;  ! Time zone -5 is Eastern Standard Time
+ REAL    frac ;
+ INTEGER iybeg iyend := 1970 2000 ; ! Range to be searched
+ REAL    ifrac_R ;
+ LOGICAL LFLAG ;
+
+ PROCEDURE julday flmoon ;
+
+ ECHO "Full moons on Friday the 13th from" iybeg "to" iyend ;
+
+ EVALUATE iyyy := iybeg ;
+ WHILE iyyy iyend <= DO           ! Loop over each year
+   EVALUATE im := 1 ;
+   WHILE im 12 <= DO              ! Loop over each month
+     julday :: <<im>> 13 <<iyyy>> >>jday<< ; ! Call julday
+     EVALUATE idwk := jday 1 + jday 1 + 7 / 7 * - ;
+     IF idwk 5 = THEN             ! Is the 13-th a Friday
+       EVALUATE n := 12.37 iyyy I_TO_R 1900. -
+                           im   I_TO_R 0.5 - 12. / + * R_TO_I ;
+       EVALUATE LFLAG icon := $True_L 0 ;
+       WHILE LFLAG DO
+         flmoon :: <<n>> 2 >>jd<< >>frac<< ; ! Get date of full moon *n*
+         EVALUATE ifrac_R := frac TIMZON + 24. * ;
+         IF ifrac_R 0. >= THEN
+           EVALUATE ifrac_R := ifrac_R 0.5 + ;
+         ELSE
+           EVALUATE ifrac_R := ifrac_R 0.5 - ;
+         ENDIF ;
+         EVALUATE ifrac := ifrac_R R_TO_I ;
+         IF ifrac 0 < THEN
+           EVALUATE jd ifrac := jd 1 - ifrac 24 + ;
+         ENDIF ;
+         IF ifrac 12 > THEN
+           EVALUATE jd ifrac := jd 1 + ifrac 12 - ;
+         ELSE
+           EVALUATE    ifrac :=        ifrac 12 + ;
+         ENDIF ;
+         IF jd jday = THEN       ! Did we hit our target day ?
+           ECHO "Full moon" im "/13/" iyyy ":"
+           ifrac "hrs after midnight (EST)." ;
+           EVALUATE LFLAG := $False_L ;
+         ELSE                    ! Didn't hit it...
+           IF jday jd - 0 >= THEN
+             EVALUATE ic := +1 ;
+           ELSE
+             EVALUATE ic := -1 ;
+           ENDIF ;
+           IF ic icon CHS = THEN
+             EVALUATE LFLAG := $False_L ;
+           ELSE
+             EVALUATE icon n := ic n ic + ;
+           ENDIF ;
+         ENDIF ;
+       ENDWHILE ;
+     ENDIF ;
+     EVALUATE im := im 1 + ;
+   ENDWHILE ;
+   EVALUATE iyyy := iyyy 1 + ;
+ ENDWHILE ;
+ QUIT " Program *badluk* XREF " .