blob: 2bdb2e5597e62a2169c970d8c79e502dcf7608ee (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
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 " .
|
