! "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 " .