/
astro32.bas
293 lines (284 loc) · 11.3 KB
/
astro32.bas
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
Attribute VB_Name = "Astronomy_Funcs"
'---------------------------------------------------------------------
'
' ===========
' ASTRO32.BAS
' ===========
'
' Interface declarations for the Astronomy Library. Drop this into
' any VB project to get access to the astronomical support functions
' in astro32.dll. For the latest copy of astro32.dll, contact the
' author at the address below.
'
' Routines in astronomy DLL have been taken from various open source
' and freeware applications as well as original code by the author.
' Astro32.dll and this VB module are freely usable in any software
' project. The author assumes no responsibilities for bugs, etc.
'
' Written: 18-Jul-96 Robert B. Denny <rdenny@dc3.com>
'
' Edits:
'
' When Who What
' --------- --- --------------------------------------------------
' 18-Jul-96 rbd Initial edit (yes, 1996!)
' 19-Jul-98 rbd 1.2 of astro32.dll, add deltat()
' 20-Jul-98 rbd Change comments on now_lst, change interface to take
' longitude - West
' 10-Aug-98 rbd tz_name now returns 0/1 indicaing whether DST is in effect
' -----------------------------------------------------------------------------
Option Explicit
' You know what this is!
Public Const PI = 3.14159265358979
' Ratio of from synodic (solar) to sidereal (stellar) rate
Public Const SIDRATE = 0.9972695677
' Seconds per day
Public Const SPD = 86400#
'
' Modified Julian Date (MJD) calculations. The epoch for MJD is
'
Public Const MJD0 = 2415020# ' MJD Julian epoch (JD = MJD + MJD0)
Public Const J2000 = 36525# ' MJD for 2000 (2451545.0 - MJD0)
'
' Date formatting preferences for fmt_mjd() and scn_date()
'
Public Const DATE_YMD = 0
Public Const DATE_MDY = 1
Public Const DATE_DMY = 2
'
' Timezone name preferences for tz_name()
'
Public Const DATE_UTCTZ = 3
Public Const DATE_LOCALTZ = 4
'
' =================
' LIBRARY FUNCTIONS
' =================
'
' NOTES:
'
' (1) For whatever reason, the authors of the original C functions chose
' to pass back and forth via parameters only for most functions.
'
' (2) The descriptive comments below were lifted straight out of the C
' functions. Some variables are listed with the C dereferening '*'.
' Note that these are passed ByRef in the declarations, then forget
' about the '*'.
'
' (3) Modified Julian Dates (number of days elapsed since 1900 jan 0.5,)
' are used for most times. Several functions are provided for converting
' between mjd and other time systems (C runtime, VB, Win32).
'
'
' given latitude (n+, radians), lat, altitude (up+, radians), alt, and
' azimuth (angle around to the east from north+, radians),
' return hour angle (radians), ha, and declination (radians), dec.
'
Declare Sub aa_hadec Lib "astro32" (ByVal lat As Double, ByVal Alt As Double, ByVal Az As Double, ByRef ha As Double, ByRef Dec As Double)
'
' given a date in months, mn, days, dy, years, yr,
' return the modified Julian date (number of days elapsed since 1900 jan 0.5),
' *mjd.
'
Declare Sub cal_mjd Lib "astro32" (ByVal mn As Long, ByVal dy As Double, ByVal yr As Long, ByRef mjd As Double)
'
' given the difference in two RA's, in rads, return their difference,
' accounting for wrap at 2*PI. caller need *not* first force it into the
' range 0..2*PI.
'
Declare Function delra Lib "astro32" (ByVal dRA As Double) As Double
'
' given the modified Julian date, mjd, find delta-T (TT-UTC)
'
Declare Function delta_t Lib "astro32" Alias "deltat" (ByVal mjd As Double) As Double
'
' Format a date string into buf, given a modified julian date and the
' selected format (m/d/y, etc.). Typically mm/dd.ddd/yyyy (note the
' fractional days).
'
Declare Sub fmt_mjd Lib "astro32" (ByVal buf As String, ByVal mjd As Double, ByVal pref As Long)
'
' format the Double (e.g., mjd, lst) in sexagesimal format into buf[].
' w is the number of spaces for the whole part.
' fracbase is the number of pieces a whole is to broken into; valid options:
' 360000: <w>:mm:ss.ss
' 36000: <w>:mm:ss.s
' 3600: <w>:mm:ss
' 600: <w>:mm.m
' 60: <w>:mm
'
Declare Sub fmt_sexa Lib "astro32" (ByVal buf As String, ByVal val As Double, ByVal w As Long, ByVal fracbase As Long)
'
' given a modified julian date, mjd, and a greenwich mean siderial time, gst,
' return universally coordinated time, *utc.
'
Declare Sub gst_utc Lib "astro32" (ByVal mjd As Double, ByVal gst As Double, ByRef utc As Double)
'
' given latitude (n+, radians), lat, hour angle (radians), ha, and declination
' (radians), dec, return altitude (up+, radians), alt, and azimuth (angle
' round to the east from north+, radians),
'
Declare Sub hadec_aa Lib "astro32" (ByVal lat As Double, ByVal ha As Double, ByVal Dec As Double, ByRef Alt As Double, ByRef Az As Double)
'
' Convert "MM/DD/YY" to VB Date
'
Declare Function mdy_vb Lib "astro32" (ByVal mdy As String) As Date
'
' return the Modified Julian Date of the epoch 2000
'
Declare Function mjd_2000 Lib "astro32" () As Double
'
' given the modified Julian date, mjd, return the calendar date in months, *mn,
' days, *dy, and years, *yr.
'
Declare Sub mjd_cal Lib "astro32" (ByVal mjd As Double, ByRef mn As Long, ByRef dy As Double, ByRef yr As Long)
'
' given an mjd, truncate it to the beginning of the whole day
'
Declare Function mjd_day Lib "astro32" (ByVal jd As Double) As Double
'
' given an mjd, set *dow to 0..6 according to which day of the week it falls
' on (0=sunday). return 0 if ok else -1 if can't figure it out.
'
Declare Function mjd_dow Lib "astro32" (ByVal mjd As Double, ByRef dow As Long) As Long
'
' given a mjd, return the the number of days in the month.
'
Declare Sub mjd_dpm Lib "astro32" (ByVal mjd As Double, ByRef ndays As Long)
'
' given an mjd, return the number of hours past midnight of the
' whole day
'
Declare Function mjd_hr Lib "astro32" (ByVal jd As Double) As Double
'
' Return the Visual Basic Date given a Modified Julian Date
'
Declare Function mjd_vb Lib "astro32" (ByVal mjd As Double) As Date
'
' given a mjd, return the year as a double.
'
Declare Sub mjd_year Lib "astro32" (ByVal mjd As Double, ByRef yr As Double)
'
' Return the current Local Apparent Sidereal Time (LST) from the clock and longitude (rad, - west)
'
Declare Function now_lst Lib "astro32" (ByVal lng As Double) As Double
'
' Return the current Modified Julian Date derived from the system clock
'
Declare Function now_mjd Lib "astro32" () As Double
'
' given the modified JD, mjd, correct, IN PLACE, the right ascension *ra
' and declination *dec (both in radians) for nutation.
'
Declare Sub nut_eq Lib "astro32" (ByVal mjd As Double, ByRef RA As Double, ByRef Dec As Double)
'
' given the modified JD, mjd, find the nutation in obliquity, *deps, and
' the nutation in longitude, *dpsi, each in radians.
'
Declare Sub nut Lib "astro32" Alias "nutation" (ByVal mjd As Double, ByRef deps As Double, ByRef dpsi As Double)
'
' given the modified Julian date, mjd, find the mean obliquity of the
' ecliptic, *eps, in radians.
'
Declare Sub obliq Lib "astro32" Alias "obliquity" (ByVal mjd As Double, ByRef eps As Double)
'
' insure 0 <= *v < r. Used to range angles and times
'
Declare Sub range Lib "astro32" (ByRef v As Double, ByVal r As Double)
'
' correct the true altitude, ta, for refraction to the apparent altitude, aa,
' each in radians, given the local atmospheric pressure, pr, in mbars, and
' the temperature, tr, in degrees C.
'
Declare Sub refract Lib "astro32" (ByVal pr As Double, ByVal tr As Double, ByVal ta As Double, ByRef aa As Double)
'
' crack a floating date string, bp, of the form X/Y/Z determined by the
' DATE_DATE_FORMAT preference into its components. allow the day to be a
' floating point number. A lone component is always a year if it contains
' a decimal point or pref is MDY or DMY and it is not a reasonable month
' or day value, respectively. Leave any unspecified component unchanged.
' ( actually, the slashes may be anything but digits or a decimal point)
' 'pref' indicates the format of the date (DATE_xxx).
'
Declare Function scn_date Lib "astro32" (ByVal dtstr As String, ByRef m As Long, ByRef d As Double, ByRef Y As Long, ByVal pref As Long)
'
' scan a sexagesimal string and update a double. the string, bp, is of the form
' H:M:S. a negative value may be indicated by a '-' char before any
' component. All components may be integral or real. In addition to ':' the
' separator may also be '/' or ';' or ',' or '-'.
' any components not specified in bp[] are copied from old's in 'o'.
' eg: ::10 only changes S
' 10 only changes H
' 10:0 changes H and M
'
Declare Function scn_sexa Lib "astro32" (ByVal o As Double, ByVal sexa As String) As Double
'
' round a time in days, *t, to the nearest second, IN PLACE.
'
Declare Sub rnd_second Lib "astro32" (ByRef t As Double)
'
' Fill buffer with the name of the current timezone, given a preference
' flag, pref, (DATE_UTCTZ = always "UTC", DATE_LOCALTZ = e.g., "PDT")
' Returns 0/1 indicating whether DST is currently in effect.
'
Declare Function tz_name Lib "astro32" (ByVal buf As String, ByVal pref As Long) As Long
'
' correct the apparent altitude, aa, for refraction to the true altitude, ta,
' each in radians, given the local atmospheric pressure, pr, in mbars, and
' the temperature, tr, in degrees C.
'
Declare Sub unrefract Lib "astro32" (ByVal pr As Double, ByVal tr As Double, ByVal aa As Double, ByRef ta As Double)
'
' given a modified julian DATE, mjd, and a universally coordinated time, utc,
' return greenwich mean siderial time, *gst.
' NOTE: mjd must be at the beginning of the day!
'
Declare Sub utc_gst Lib "astro32" (ByVal mjd As Double, ByVal utc As Double, ByRef gst As Double)
'
' Return the current UTC offset (+ = West) in seconds
'
Declare Function utc_offs Lib "astro32" () As Long
'
' Return a Modified Julian Date given a Visual Basic Date
'
Declare Function vb_mjd Lib "astro32" (ByVal d As Date) As Double
'
' given a decimal year, return mjd
'
Declare Sub year_mjd Lib "astro32" (ByVal Y As Double, ByRef mjd As Double)
'---------------------------------------------------------------------
' Degrees to Radians
'---------------------------------------------------------------------
Public Function degrad(d As Double) As Double
degrad = (d * PI) / 180#
End Function
'---------------------------------------------------------------------
' Radians to Degrees
'---------------------------------------------------------------------
Public Function raddeg(r As Double) As Double
raddeg = (r * 180#) / PI
End Function
'---------------------------------------------------------------------
' Hours to Degrees
'---------------------------------------------------------------------
Public Function hrdeg(h As Double)
hrdeg = h * 15#
End Function
'---------------------------------------------------------------------
' Degrees to Hours
'---------------------------------------------------------------------
Public Function deghr(d As Double) As Double
deghr = d / 15#
End Function
'---------------------------------------------------------------------
' Hours to Radians
'---------------------------------------------------------------------
Public Function hrrad(h As Double) As Double
hrrad = degrad(hrdeg(h))
End Function
'---------------------------------------------------------------------
' Radians to Hours
'---------------------------------------------------------------------
Public Function radhr(r As Double) As Double
radhr = deghr(raddeg(r))
End Function