Code: Select all
Declare SUB FLMOON (N!, NPH!, JD&, FRAC!)
Declare SUB CALDAT (JULIAN&, MM!, ID!, IYYY!)
Declare FUNCTION JULDAY& (IM!, ID!, IY!)
'PROGRAM D1R1
'Driver for routine FLMOON
CLS
TZONE = 5!
Dim PHASE$(4), TIMSTR$(2)
For i = 1 To 4
Read PHASE$(i)
Next i
Data "new moon", "first quarter", "full moon", "last quarter"
For i = 1 To 2
Read TIMSTR$(i)
Next i
Data " AM", " PM"
Print "Date of the next few phases of the moon"
Print "Enter today's date (e.g. 1,31,1982)"
INPUT IM, ID, IY
Print
TIMZON = -TZONE / 24!
'Approximate number of full moons since January 1900
N = Int(12.37 * (IY - 1900 + (IM - 0.5) / 12!))
NPH = 2
J1& = JULDAY&(IM, ID, IY)
Call FLMOON(N, NPH, J2&, FRAC)
N = Int(N + (J1& - J2&) / 28!)
Print " Date", " Time(EST)", " Phase"
For i = 1 To 20
Call FLMOON(N, NPH, J2&, FRAC)
IFRAC = CInt(24! * (FRAC + TIMZON))
If IFRAC < 0 Then
J2& = J2& - 1
IFRAC = IFRAC + 24
End If
If IFRAC >= 12 Then
J2& = J2& + 1
IFRAC = IFRAC - 12
Else
IFRAC = IFRAC + 12
End If
If IFRAC > 12 Then
IFRAC = IFRAC - 12
ISTR = 2
Else
ISTR = 1
End If
Call CALDAT(J2&, IM, ID, IY)
Print USING; "##"; IM;
Print USING; "###"; ID;
Print USING; "#####"; IY;
Print USING; "#########"; IFRAC;
Print TIMSTR$(ISTR); " "; PHASE$(NPH + 1)
If NPH = 3 Then
NPH = 0
N = N + 1
Else
NPH = NPH + 1
End If
Next i
End
Sub FLMOON(N, NPH, JD&, FRAC)
RAD = 0.017453293
C = N + NPH / 4!
T = C / 1236.85
T2 = T ^ 2
AQ = 359.2242 + 29.105356 * C
am = 306.0253 + 385.816918 * C + 0.01073 * T2
JD& = 2415020 + 28 * N + 7 * NPH
XTRA = 0.75933 + 1.53058868 * C + (0.0001178 - 0.000000155 * T) * T2
If NPH = 0 Or NPH = 2 Then
XTRA = XTRA + (0.1734 - 0.000393 * T) * Sin(RAD * AQ) - 0.4068 * Sin(RAD
* am)
ElseIf NPH = 1 Or NPH = 3 Then
XTRA = XTRA + (0.1721 - 0.0004 * T) * Sin(RAD * AQ) - 0.628 * Sin(RAD *
am)
Else
Print "NPH is unknown."
Exit Sub
End If
If XTRA >= 0! Then
i = Int(XTRA)
Else
i = Int(XTRA - 1!)
End If
JD& = JD& + i
FRAC = XTRA - i
End Sub
Function JULDAY&(MM, ID, IYYY)
IGREG& = 588829
If IYYY = 0 Then Print "There is no Year Zero.": Exit Function
If IYYY < 0 Then IYYY = IYYY + 1
If MM > 2 Then
JY = IYYY
JM = MM + 1
Else
JY = IYYY - 1
JM = MM + 13
End If
JD& = Int(365.25 * JY) + Int(30.6001 * JM) + ID + 1720995
If ID + 31 * (MM + 12 * IYYY) >= IGREG& Then
JA = Int(0.01 * JY)
JD& = JD& + 2 - JA + Int(0.25 * JA)
End If
JULDAY& = JD&
End Function
Sub CALDAT(JULIAN&, MM, ID, IYYY)
IGREG& = 2299161
If JULIAN& >= IGREG& Then
JALPHA& = Int(((JULIAN& - 1867216) - 0.25) / 36524.25)
JA& = JULIAN& + 1 + JALPHA& - Int(0.25 * JALPHA&)
Else
JA& = JULIAN&
End If
JB& = JA& + 1524
JC& = Int(6680! + ((JB& - 2439870) - 122.1) / 365.25)
JD& = 365 * JC& + Int(0.25 * JC&)
JE& = Int((JB& - JD&) / 30.6001)
ID = JB& - JD& - Int(30.6001 * JE&)
MM = JE& - 1
If MM > 12 Then MM = MM - 12
IYYY = JC& - 4715
If MM > 2 Then IYYY = IYYY - 1
If IYYY <= 0 Then IYYY = IYYY - 1
End Sub Code: Select all
ImportC ""
floor.d (value.d)
ceil.d (value.d)
EndImport
Declare.d julianday(day,month,year,hour,minute,second)
Procedure.d julianday(day,month,year,hour,minute,second)
Protected a.d, b.d, taf.d, mo.d, jar.d,time.d, jul_tag.d
taf = day
mo = month
jar = year
If mo < 3
mo = mo + 12
jar = jar - 1
EndIf
a = 0
b = 0
If jar < 0 ;year B.C. If historical, in astronomical counting jar+1 schould be skipt
jar + 1
EndIf
If jar + mo / 100 + taf / 10000 >= 1582.1015
a = IntQ(jar / 100)
b = 2 - a + IntQ(a / 4)
EndIf
time= hour / 24 + minute / 1440 + second /86400 ;convert time 0-24 in range 0.00-1.00
jul_tag = IntQ(365.25 * (jar+ 4716 )) + IntQ(30.6001 * (mo + 1 )) + b -1524.5 + taf + time
ProcedureReturn jul_tag
EndProcedure
Procedure flmoon (n, nph, Array r(1))
RAD.f = #PI/180.0
c.f = n + nph / 4
t.f = c / 1236.85
t2.f = Pow(t,2)
aq.f = 359.2242 + 29.105356 * c
am.f = 306.0253 + 385.816918 * c + 0.010730 * t2
xtra = 0.75933 + 1.53058868 * c + ((0.0001178) - (1.55e-7) * t) * t2
If nph = 0 Or nph = 2
xtra = xtra + (0.1734 - 0.000393 * t) * Sin(RAD * aq) - 0.4068 * Sin(RAD * am)
ElseIf nph = 1 Or nph = 3
xtra = xtra + (0.1721 - 0.0004 * t) * Sin(RAD * aq) - 0.628 * Sin(RAD * am)
Else
Debug "nph is unknown"
End
EndIf
If xtra>=0
xtrai = floor(xtra)
Else
xtrai = ceil(xtra - 1)
EndIf
mt = 2415020 + 28 * n + 7 * nph
mt = jd + xtrai
frac = xtra - xtrai
jd = julianday(1,1,2015,0,0,0)
r(0)=mt
r(1)=frac
Debug Mod((jd-mt +30),30)
Debug frac
EndProcedure
Dim a(1)
year=2015
month=01
nph.i=2 ;0=new moon, 1=first quarter, 2=full, 3=last quarter
n.i = floor(12.37 * (year -1900 + ((month - 0.5)/12.0)))
For nph = 0 To 3
Debug "NPH: " + Str(nph)
flmoon(n, nph, a())
Next
I dont know what some of the things are in the old basic code like the ! etc..
Any one know what I am doing wrong why I can get the other moon phases?
The dates for JAN 2015 should be:
Full Moon: 5th
New Moon: 20th
First Quarter: 27th
Last Quarter: 13th
Thanks
