956
|
1 ;;; solar.el --- calendar functions for solar events.
|
|
2
|
17626
|
3 ;; Copyright (C) 1992, 1993, 1995, 1997 Free Software Foundation, Inc.
|
956
|
4
|
|
5 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
|
13874
|
6 ;; Denis B. Roegel <Denis.Roegel@loria.fr>
|
2249
|
7 ;; Keywords: calendar
|
|
8 ;; Human-Keywords: sunrise, sunset, equinox, solstice, calendar, diary,
|
|
9 ;; holidays
|
956
|
10
|
|
11 ;; This file is part of GNU Emacs.
|
|
12
|
6736
|
13 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
14 ;; it under the terms of the GNU General Public License as published by
|
|
15 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
16 ;; any later version.
|
956
|
17
|
6736
|
18 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
21 ;; GNU General Public License for more details.
|
|
22
|
|
23 ;; You should have received a copy of the GNU General Public License
|
14169
|
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
26 ;; Boston, MA 02111-1307, USA.
|
956
|
27
|
|
28 ;;; Commentary:
|
|
29
|
9714
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
30 ;; This collection of functions implements the features of calendar.el,
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
31 ;; diary.el, and holiday.el that deal with times of day, sunrise/sunset, and
|
13742
|
32 ;; equinoxes/solstices.
|
956
|
33
|
|
34 ;; Based on the ``Almanac for Computers 1984,'' prepared by the Nautical
|
13045
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
35 ;; Almanac Office, United States Naval Observatory, Washington, 1984, on
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
36 ;; ``Astronomical Formulae for Calculators,'' 3rd ed., by Jean Meeus,
|
13874
|
37 ;; Willmann-Bell, Inc., 1985, on ``Astronomical Algorithms'' by Jean Meeus,
|
|
38 ;; Willmann-Bell, Inc., 1991, and on ``Planetary Programs and Tables from
|
|
39 ;; -4000 to +2800'' by Pierre Bretagnon and Jean-Louis Simon, Willmann-Bell,
|
|
40 ;; Inc., 1986.
|
13045
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
41
|
956
|
42 ;;
|
13874
|
43 ;; Accuracy:
|
|
44 ;; 1. Sunrise/sunset times will be accurate to the minute for years
|
|
45 ;; 1951--2050. For other years the times will be within +/- 2 minutes.
|
956
|
46 ;;
|
13874
|
47 ;; 2. Equinox/solstice times will be accurate to the minute for years
|
|
48 ;; 1951--2050. For other years the times will be within +/- 1 minute.
|
956
|
49
|
20462
|
50 ;; Technical details of all the calendrical calculations can be found in
|
|
51 ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
|
|
52 ;; Cambridge University Press (1997).
|
|
53
|
956
|
54 ;; Comments, corrections, and improvements should be sent to
|
|
55 ;; Edward M. Reingold Department of Computer Science
|
|
56 ;; (217) 333-6733 University of Illinois at Urbana-Champaign
|
|
57 ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
|
|
58 ;; Urbana, Illinois 61801
|
|
59
|
|
60 ;;; Code:
|
|
61
|
|
62 (if (fboundp 'atan)
|
|
63 (require 'lisp-float-type)
|
9714
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
64 (error "Solar/lunar calculations impossible since floating point is unavailable."))
|
956
|
65
|
3866
|
66 (require 'cal-dst)
|
13874
|
67 (require 'cal-julian)
|
3866
|
68
|
|
69 ;;;###autoload
|
17626
|
70 (defcustom calendar-time-display-form
|
3866
|
71 '(12-hours ":" minutes am-pm
|
|
72 (if time-zone " (") time-zone (if time-zone ")"))
|
|
73 "*The pseudo-pattern that governs the way a time of day is formatted.
|
|
74
|
|
75 A pseudo-pattern is a list of expressions that can involve the keywords
|
|
76 `12-hours', `24-hours', and `minutes', all numbers in string form,
|
|
77 and `am-pm' and `time-zone', both alphabetic strings.
|
|
78
|
|
79 For example, the form
|
|
80
|
|
81 '(24-hours \":\" minutes
|
|
82 (if time-zone \" (\") time-zone (if time-zone \")\"))
|
|
83
|
17626
|
84 would give military-style times like `21:07 (UTC)'."
|
|
85 :type 'sexp
|
|
86 :group 'calendar)
|
3866
|
87
|
|
88 ;;;###autoload
|
17626
|
89 (defcustom calendar-latitude nil
|
9714
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
90 "*Latitude of `calendar-location-name' in degrees.
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
91
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
92 The value can be either a decimal fraction (one place of accuracy is
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
93 sufficient), + north, - south, such as 40.7 for New York City, or the value
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
94 can be a vector [degrees minutes north/south] such as [40 50 north] for New
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
95 York City.
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
96
|
17626
|
97 This variable should be set in `site-start'.el."
|
|
98 :type '(choice (const nil)
|
|
99 (number :tag "Exact")
|
|
100 (vector :value [0 0 north]
|
|
101 (integer :tag "Degrees")
|
|
102 (integer :tag "Minutes")
|
|
103 (choice :tag "Position"
|
|
104 (const north)
|
|
105 (const south))))
|
|
106 :group 'calendar)
|
3866
|
107
|
|
108 ;;;###autoload
|
17626
|
109 (defcustom calendar-longitude nil
|
9714
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
110 "*Longitude of `calendar-location-name' in degrees.
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
111
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
112 The value can be either a decimal fraction (one place of accuracy is
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
113 sufficient), + east, - west, such as -73.9 for New York City, or the value
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
114 can be a vector [degrees minutes east/west] such as [73 55 west] for New
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
115 York City.
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
116
|
17626
|
117 This variable should be set in `site-start'.el."
|
|
118 :type '(choice (const nil)
|
|
119 (number :tag "Exact")
|
|
120 (vector :value [0 0 west]
|
|
121 (integer :tag "Degrees")
|
|
122 (integer :tag "Minutes")
|
|
123 (choice :tag "Position"
|
|
124 (const east)
|
|
125 (const west))))
|
|
126 :group 'calendar)
|
9714
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
127
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
128 (defsubst calendar-latitude ()
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
129 "Convert calendar-latitude to a signed decimal fraction, if needed."
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
130 (if (numberp calendar-latitude)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
131 calendar-latitude
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
132 (let ((lat (+ (aref calendar-latitude 0)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
133 (/ (aref calendar-latitude 1) 60.0))))
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
134 (if (equal (aref calendar-latitude 2) 'north)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
135 lat
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
136 (- lat)))))
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
137
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
138 (defsubst calendar-longitude ()
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
139 "Convert calendar-longitude to a signed decimal fraction, if needed."
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
140 (if (numberp calendar-longitude)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
141 calendar-longitude
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
142 (let ((long (+ (aref calendar-longitude 0)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
143 (/ (aref calendar-longitude 1) 60.0))))
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
144 (if (equal (aref calendar-longitude 2) 'east)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
145 long
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
146 (- long)))))
|
3866
|
147
|
|
148 ;;;###autoload
|
17626
|
149 (defcustom calendar-location-name
|
3866
|
150 '(let ((float-output-format "%.1f"))
|
|
151 (format "%s%s, %s%s"
|
9714
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
152 (if (numberp calendar-latitude)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
153 (abs calendar-latitude)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
154 (+ (aref calendar-latitude 0)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
155 (/ (aref calendar-latitude 1) 60.0)))
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
156 (if (numberp calendar-latitude)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
157 (if (> calendar-latitude 0) "N" "S")
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
158 (if (equal (aref calendar-latitude 2) 'north) "N" "S"))
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
159 (if (numberp calendar-longitude)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
160 (abs calendar-longitude)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
161 (+ (aref calendar-longitude 0)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
162 (/ (aref calendar-longitude 1) 60.0)))
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
163 (if (numberp calendar-longitude)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
164 (if (> calendar-longitude 0) "E" "W")
|
12312
|
165 (if (equal (aref calendar-longitude 2) 'east) "E" "W"))))
|
19898
|
166 "*Expression evaluating to name of `calendar-longitude', `calendar-latitude'.
|
9714
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
167 For example, \"New York City\". Default value is just the latitude, longitude
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
168 pair.
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
169
|
17626
|
170 This variable should be set in `site-start'.el."
|
|
171 :type 'sexp
|
|
172 :group 'calendar)
|
13874
|
173
|
17626
|
174 (defcustom solar-error 0.5
|
13874
|
175 "*Tolerance (in minutes) for sunrise/sunset calculations.
|
|
176
|
|
177 A larger value makes the calculations for sunrise/sunset faster, but less
|
|
178 accurate. The default is half a minute (30 seconds), so that sunrise/sunset
|
|
179 times will be correct to the minute.
|
|
180
|
|
181 It is useless to set the value smaller than 4*delta, where delta is the
|
|
182 accuracy in the longitude of the sun (given by the function
|
|
183 `solar-ecliptic-coordinates') in degrees since (delta/360) x (86400/60) = 4 x
|
|
184 delta. At present, delta = 0.01 degrees, so the value of the variable
|
17626
|
185 `solar-error' should be at least 0.04 minutes (about 2.5 seconds)."
|
|
186 :type 'number
|
|
187 :group 'calendar)
|
956
|
188
|
4863
|
189 (defvar solar-n-hemi-seasons
|
4766
|
190 '("Vernal Equinox" "Summer Solstice" "Autumnal Equinox" "Winter Solstice")
|
|
191 "List of season changes for the northern hemisphere.")
|
|
192
|
4863
|
193 (defvar solar-s-hemi-seasons
|
4766
|
194 '("Autumnal Equinox" "Winter Solstice" "Vernal Equinox" "Summer Solstice")
|
|
195 "List of season changes for the southern hemisphere.")
|
|
196
|
13874
|
197 (defvar solar-sidereal-time-greenwich-midnight
|
|
198 nil
|
|
199 "Sidereal time at Greenwich at midnight (universal time).")
|
|
200
|
|
201 (defvar solar-spring-or-summer-season nil
|
|
202 "T if spring or summer and nil otherwise.
|
|
203 Needed for polar areas, in order to know whether the day lasts 0 or 24 hours.")
|
|
204
|
956
|
205 (defun solar-setup ()
|
|
206 "Prompt user for latitude, longitude, and time zone."
|
|
207 (beep)
|
|
208 (if (not calendar-longitude)
|
|
209 (setq calendar-longitude
|
|
210 (solar-get-number
|
|
211 "Enter longitude (decimal fraction; + east, - west): ")))
|
|
212 (if (not calendar-latitude)
|
|
213 (setq calendar-latitude
|
|
214 (solar-get-number
|
|
215 "Enter latitude (decimal fraction; + north, - south): ")))
|
|
216 (if (not calendar-time-zone)
|
|
217 (setq calendar-time-zone
|
|
218 (solar-get-number
|
3779
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
diff
changeset
|
219 "Enter difference from Coordinated Universal Time (in minutes): "))))
|
956
|
220
|
|
221 (defun solar-get-number (prompt)
|
|
222 "Return a number from the minibuffer, prompting with PROMPT.
|
|
223 Returns nil if nothing was entered."
|
|
224 (let ((x (read-string prompt "")))
|
|
225 (if (not (string-equal x ""))
|
|
226 (string-to-int x))))
|
|
227
|
13874
|
228 ;; The condition-case stuff is needed to catch bogus arithmetic
|
|
229 ;; exceptions that occur on some machines (like Sparcs)
|
|
230 (defun solar-sin-degrees (x)
|
|
231 (condition-case nil
|
|
232 (sin (degrees-to-radians (mod x 360.0)))
|
|
233 (solar-sin-degrees x)))
|
|
234 (defun solar-cosine-degrees (x)
|
|
235 (condition-case nil
|
|
236 (cos (degrees-to-radians (mod x 360.0)))
|
|
237 (solar-cosine-degrees x)))
|
|
238 (defun solar-tangent-degrees (x)
|
|
239 (condition-case nil
|
|
240 (tan (degrees-to-radians (mod x 360.0)))
|
|
241 (solar-tangent-degrees x)))
|
|
242
|
956
|
243 (defun solar-xy-to-quadrant (x y)
|
|
244 "Determines the quadrant of the point X, Y."
|
|
245 (if (> x 0)
|
|
246 (if (> y 0) 1 4)
|
|
247 (if (> y 0) 2 3)))
|
|
248
|
|
249 (defun solar-degrees-to-quadrant (angle)
|
|
250 "Determines the quadrant of ANGLE."
|
4660
|
251 (1+ (floor (mod angle 360) 90)))
|
956
|
252
|
|
253 (defun solar-arctan (x quad)
|
|
254 "Arctangent of X in quadrant QUAD."
|
|
255 (let ((deg (radians-to-degrees (atan x))))
|
|
256 (cond ((equal quad 2) (+ deg 180))
|
|
257 ((equal quad 3) (+ deg 180))
|
|
258 ((equal quad 4) (+ deg 360))
|
|
259 (t deg))))
|
|
260
|
13874
|
261 (defun solar-atn2 (x y)
|
|
262 "Arctan of point X, Y."
|
14917
|
263 (if (= x 0)
|
|
264 (if (> y 0) 90 270)
|
|
265 (solar-arctan (/ y x) x)))
|
13874
|
266
|
956
|
267 (defun solar-arccos (x)
|
14917
|
268 "Arcos of X."
|
|
269 (let ((y (sqrt (- 1 (* x x)))))
|
|
270 (solar-atn2 x y)))
|
956
|
271
|
|
272 (defun solar-arcsin (y)
|
14917
|
273 "Arcsin of Y."
|
|
274 (let ((x (sqrt (- 1 (* y y)))))
|
|
275 (solar-atn2 x y)
|
|
276 ))
|
956
|
277
|
13874
|
278 (defsubst solar-degrees-to-hours (degrees)
|
|
279 "Convert DEGREES to hours."
|
|
280 (/ degrees 15.0))
|
956
|
281
|
9714
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
282 (defsubst solar-hours-to-days (hour)
|
13874
|
283 "Convert HOUR to decimal fraction of a day."
|
9714
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
284 (/ hour 24.0))
|
956
|
285
|
13874
|
286 (defun solar-right-ascension (longitude obliquity)
|
|
287 "Right ascension of the sun, in hours, given LONGITUDE and OBLIQUITY.
|
|
288 Both arguments are in degrees."
|
956
|
289 (solar-degrees-to-hours
|
|
290 (solar-arctan
|
13874
|
291 (* (solar-cosine-degrees obliquity) (solar-tangent-degrees longitude))
|
956
|
292 (solar-degrees-to-quadrant longitude))))
|
|
293
|
13874
|
294 (defun solar-declination (longitude obliquity)
|
|
295 "Declination of the sun, in degrees, given LONGITUDE and OBLIQUITY.
|
|
296 Both arguments are in degrees."
|
956
|
297 (solar-arcsin
|
13874
|
298 (* (solar-sin-degrees obliquity)
|
956
|
299 (solar-sin-degrees longitude))))
|
|
300
|
13874
|
301 (defun solar-sunrise-and-sunset (time latitude longitude)
|
|
302 "Sunrise, sunset and length of day.
|
|
303 Parameters are the midday TIME and the LATITUDE, LONGITUDE of the location.
|
|
304
|
|
305 TIME is a pair with the first component being the number of Julian centuries
|
|
306 elapsed at 0 Universal Time, and the second component being the universal
|
|
307 time. For instance, the pair corresponding to November 28, 1995 at 16 UT is
|
14267
da2d268f737f
Fixed doc strings and references to calendar-latitude and calendar-longitude.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
308 \(-0.040945 16), -0.040945 being the number of julian centuries elapsed between
|
13874
|
309 Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT.
|
|
310
|
|
311 Coordinates are included because this function is called with latitude=10
|
|
312 degrees to find out if polar regions have 24 hours of sun or only night."
|
|
313 (let* ((rise-time (solar-moment -1 latitude longitude time))
|
|
314 (set-time (solar-moment 1 latitude longitude time))
|
|
315 (day-length))
|
|
316 (if (not (and rise-time set-time))
|
|
317 (if (or (and (> latitude 0) solar-spring-or-summer-season)
|
|
318 (and (< latitude 0) (not solar-spring-or-summer-season)))
|
|
319 (setq day-length 24)
|
|
320 (setq day-length 0))
|
|
321 (setq day-length (- set-time rise-time)))
|
14917
|
322 (list (if rise-time (+ rise-time (/ calendar-time-zone 60.0)) nil)
|
|
323 (if set-time (+ set-time (/ calendar-time-zone 60.0)) nil)
|
|
324 day-length)))
|
13874
|
325
|
|
326 (defun solar-moment (direction latitude longitude time)
|
|
327 "Sunrise/sunset at location.
|
|
328 Sunrise if DIRECTION =-1 or sunset if =1 at LATITUDE, LONGITUDE, with midday
|
|
329 being TIME.
|
|
330
|
|
331 TIME is a pair with the first component being the number of Julian centuries
|
|
332 elapsed at 0 Universal Time, and the second component being the universal
|
|
333 time. For instance, the pair corresponding to November 28, 1995 at 16 UT is
|
14273
|
334 \(-0.040945 16), -0.040945 being the number of julian centuries elapsed between
|
13874
|
335 Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT.
|
7778
|
336
|
13874
|
337 Uses binary search."
|
|
338 (let* ((ut (car (cdr time)))
|
|
339 (possible 1) ; we assume that rise or set are possible
|
|
340 (utmin (+ ut (* direction 12.0)))
|
|
341 (utmax ut) ; the time searched is between utmin and utmax
|
|
342 ; utmin and utmax are in hours
|
|
343 (utmoment-old 0.0) ; rise or set approximation
|
|
344 (utmoment 1.0) ; rise or set approximation
|
|
345 (hut 0) ; sun height at utmoment
|
|
346 (t0 (car time))
|
|
347 (hmin (car (cdr
|
|
348 (solar-horizontal-coordinates (list t0 utmin)
|
|
349 latitude longitude t))))
|
|
350 (hmax (car (cdr
|
|
351 (solar-horizontal-coordinates (list t0 utmax)
|
|
352 latitude longitude t)))))
|
|
353 ; -0.61 degrees is the height of the middle of the sun, when it rises
|
|
354 ; or sets.
|
|
355 (if (< hmin -0.61)
|
|
356 (if (> hmax -0.61)
|
|
357 (while ;(< i 20) ; we perform a simple dichotomy
|
|
358 ; (> (abs (+ hut 0.61)) epsilon)
|
|
359 (>= (abs (- utmoment utmoment-old))
|
|
360 (/ solar-error 60))
|
|
361 (setq utmoment-old utmoment)
|
|
362 (setq utmoment (/ (+ utmin utmax) 2))
|
|
363 (setq hut (car (cdr
|
|
364 (solar-horizontal-coordinates
|
|
365 (list t0 utmoment) latitude longitude t))))
|
|
366 (if (< hut -0.61) (setq utmin utmoment))
|
|
367 (if (> hut -0.61) (setq utmax utmoment))
|
|
368 )
|
14917
|
369 (setq possible 0)) ; the sun never rises
|
13874
|
370 (setq possible 0)) ; the sun never sets
|
|
371 (if (equal possible 0) nil utmoment)))
|
956
|
372
|
7778
|
373 (defun solar-time-string (time time-zone)
|
13045
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
374 "Printable form for decimal fraction TIME in TIME-ZONE.
|
7778
|
375 Format used is given by `calendar-time-display-form'."
|
|
376 (let* ((time (round (* 60 time)))
|
3866
|
377 (24-hours (/ time 60))
|
|
378 (minutes (format "%02d" (% time 60)))
|
|
379 (12-hours (format "%d" (1+ (% (+ 24-hours 11) 12))))
|
956
|
380 (am-pm (if (>= 24-hours 12) "pm" "am"))
|
|
381 (24-hours (format "%02d" 24-hours)))
|
|
382 (mapconcat 'eval calendar-time-display-form "")))
|
|
383
|
13874
|
384
|
|
385 (defun solar-daylight (time)
|
|
386 "Printable form for time expressed in hours."
|
|
387 (format "%d:%02d"
|
|
388 (floor time)
|
|
389 (floor (* 60 (- time (floor time))))))
|
|
390
|
|
391 (defun solar-exact-local-noon (date)
|
|
392 "Date and Universal Time of local noon at *local date* date.
|
|
393
|
|
394 The date may be different from the one asked for, but it will be the right
|
|
395 local date. The second component of date should be an integer."
|
|
396 (let* ((nd date)
|
14267
da2d268f737f
Fixed doc strings and references to calendar-latitude and calendar-longitude.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
397 (ut (- 12.0 (/ (calendar-longitude) 15)))
|
13874
|
398 (te (solar-time-equation date ut)))
|
|
399 (setq ut (- ut te))
|
|
400 (if (>= ut 24)
|
|
401 (progn
|
|
402 (setq nd (list (car date) (+ 1 (car (cdr date)))
|
|
403 (car (cdr (cdr date)))))
|
|
404 (setq ut (- ut 24))))
|
|
405 (if (< ut 0)
|
|
406 (progn
|
|
407 (setq nd (list (car date) (- (car (cdr date)) 1)
|
|
408 (car (cdr (cdr date)))))
|
|
409 (setq ut (+ ut 24))))
|
|
410 (setq nd (calendar-gregorian-from-absolute
|
|
411 (calendar-absolute-from-gregorian nd)))
|
|
412 ; date standardization
|
|
413 (list nd ut)))
|
|
414
|
956
|
415 (defun solar-sunrise-sunset (date)
|
13874
|
416 "List of *local* times of sunrise, sunset, and daylight on Gregorian DATE.
|
|
417
|
|
418 Corresponding value is nil if there is no sunrise/sunset."
|
|
419 (let* (; first, get the exact moment of local noon.
|
|
420 (exact-local-noon (solar-exact-local-noon date))
|
|
421 ; get the the time from the 2000 epoch.
|
|
422 (t0 (solar-julian-ut-centuries (car exact-local-noon)))
|
|
423 ; store the sidereal time at Greenwich at midnight of UT time.
|
|
424 ; find if summer or winter slightly above the equator
|
|
425 (equator-rise-set
|
|
426 (progn (setq solar-sidereal-time-greenwich-midnight
|
|
427 (solar-sidereal-time t0))
|
|
428 (solar-sunrise-and-sunset
|
|
429 (list t0 (car (cdr exact-local-noon)))
|
|
430 10.0
|
14267
da2d268f737f
Fixed doc strings and references to calendar-latitude and calendar-longitude.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
431 (calendar-longitude))))
|
13874
|
432 ; store the spring/summer information,
|
|
433 ; compute sunrise and sunset (two first components of rise-set).
|
|
434 ; length of day is the third component (it is only the difference
|
|
435 ; between sunset and sunrise when there is a sunset and a sunrise)
|
|
436 (rise-set
|
|
437 (progn
|
|
438 (setq solar-spring-or-summer-season
|
|
439 (if (> (car (cdr (cdr equator-rise-set))) 12) 1 0))
|
|
440 (solar-sunrise-and-sunset
|
|
441 (list t0 (car (cdr exact-local-noon)))
|
14267
da2d268f737f
Fixed doc strings and references to calendar-latitude and calendar-longitude.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
442 (calendar-latitude)
|
da2d268f737f
Fixed doc strings and references to calendar-latitude and calendar-longitude.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
443 (calendar-longitude))))
|
13874
|
444 (rise (car rise-set))
|
|
445 (adj-rise (if rise (dst-adjust-time date rise) nil))
|
|
446 (set (car (cdr rise-set)))
|
|
447 (adj-set (if set (dst-adjust-time date set) nil))
|
|
448 (length (car (cdr (cdr rise-set)))) )
|
|
449 (list
|
|
450 (and rise (calendar-date-equal date (car adj-rise)) (cdr adj-rise))
|
|
451 (and set (calendar-date-equal date (car adj-set)) (cdr adj-set))
|
|
452 (solar-daylight length))))
|
|
453
|
|
454 (defun solar-sunrise-sunset-string (date)
|
|
455 "String of *local* times of sunrise, sunset, and daylight on Gregorian DATE."
|
|
456 (let ((l (solar-sunrise-sunset date)))
|
|
457 (format
|
|
458 "%s, %s at %s (%s hours daylight)"
|
|
459 (if (car l)
|
|
460 (concat "Sunrise " (apply 'solar-time-string (car l)))
|
|
461 "No sunrise")
|
|
462 (if (car (cdr l))
|
|
463 (concat "sunset " (apply 'solar-time-string (car (cdr l))))
|
|
464 "no sunset")
|
|
465 (eval calendar-location-name)
|
|
466 (car (cdr (cdr l))))))
|
|
467
|
|
468 (defun solar-julian-ut-centuries (date)
|
|
469 "Number of Julian centuries elapsed since 1 Jan, 2000 at noon U.T. for Gregorian DATE."
|
|
470 (/ (- (calendar-absolute-from-gregorian date)
|
|
471 (calendar-absolute-from-gregorian '(1 1.5 2000)))
|
|
472 36525.0))
|
|
473
|
|
474 (defun solar-ephemeris-time(time)
|
|
475 "Ephemeris Time at moment TIME.
|
|
476
|
|
477 TIME is a pair with the first component being the number of Julian centuries
|
|
478 elapsed at 0 Universal Time, and the second component being the universal
|
|
479 time. For instance, the pair corresponding to November 28, 1995 at 16 UT is
|
14273
|
480 \(-0.040945 16), -0.040945 being the number of julian centuries elapsed between
|
13874
|
481 Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT.
|
|
482
|
|
483 Result is in julian centuries of ephemeris time."
|
|
484 (let* ((t0 (car time))
|
|
485 (ut (car (cdr time)))
|
|
486 (t1 (+ t0 (/ (/ ut 24.0) 36525)))
|
|
487 (y (+ 2000 (* 100 t1)))
|
|
488 (dt (* 86400 (solar-ephemeris-correction (floor y)))))
|
|
489 (+ t1 (/ (/ dt 86400) 36525))))
|
956
|
490
|
13045
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
491 (defun solar-date-next-longitude (d l)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
492 "First moment on or after Julian day number D when sun's longitude is a
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
493 multiple of L degrees at calendar-location-name with that location's
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
494 local time (including any daylight savings rules).
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
495
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
496 L must be an integer divisor of 360.
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
497
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
498 Result is in local time expressed astronomical (Julian) day numbers.
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
499
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
500 The values of calendar-daylight-savings-starts,
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
501 calendar-daylight-savings-starts-time, calendar-daylight-savings-ends,
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
502 calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
503 calendar-time-zone are used to interpret local time."
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
504 (let* ((long)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
505 (start d)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
506 (start-long (solar-longitude d))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
507 (next (mod (* l (1+ (floor (/ start-long l)))) 360))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
508 (end (+ d (* (/ l 360.0) 400)))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
509 (end-long (solar-longitude end)))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
510 (while ;; bisection search for nearest minute
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
511 (< 0.00001 (- end start))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
512 ;; start <= d < end
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
513 ;; start-long <= next < end-long when next != 0
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
514 ;; when next = 0, we look for the discontinuity (start-long is near 360
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
515 ;; and end-long is small (less than l).
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
516 (setq d (/ (+ start end) 2.0))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
517 (setq long (solar-longitude d))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
518 (if (or (and (/= next 0) (< long next))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
519 (and (= next 0) (< l long)))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
520 (progn
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
521 (setq start d)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
522 (setq start-long long))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
523 (setq end d)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
524 (setq end-long long)))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
525 (/ (+ start end) 2.0)))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
526
|
13874
|
527 (defun solar-horizontal-coordinates
|
|
528 (time latitude longitude for-sunrise-sunset)
|
|
529 "Azimuth and height of the sun at TIME, LATITUDE, and LONGITUDE.
|
|
530
|
|
531 TIME is a pair with the first component being the number of Julian centuries
|
|
532 elapsed at 0 Universal Time, and the second component being the universal
|
|
533 time. For instance, the pair corresponding to November 28, 1995 at 16 UT is
|
14273
|
534 \(-0.040945 16), -0.040945 being the number of julian centuries elapsed between
|
13874
|
535 Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT.
|
|
536
|
|
537 The azimuth is given in degrees as well as the height (between -180 and 180)."
|
|
538 (let* ((ut (car (cdr time)))
|
|
539 (ec (solar-equatorial-coordinates time for-sunrise-sunset))
|
|
540 (st (+ solar-sidereal-time-greenwich-midnight
|
|
541 (* ut 1.00273790935)))
|
14267
da2d268f737f
Fixed doc strings and references to calendar-latitude and calendar-longitude.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
542 (ah (- (* st 15) (* 15 (car ec)) (* -1 (calendar-longitude))))
|
13874
|
543 ; hour angle (in degrees)
|
|
544 (de (car (cdr ec)))
|
14917
|
545 (azimuth (solar-atn2 (- (* (solar-cosine-degrees ah)
|
13874
|
546 (solar-sin-degrees latitude))
|
|
547 (* (solar-tangent-degrees de)
|
14917
|
548 (solar-cosine-degrees latitude)))
|
|
549 (solar-sin-degrees ah)))
|
13874
|
550 (height (solar-arcsin
|
|
551 (+ (* (solar-sin-degrees latitude) (solar-sin-degrees de))
|
|
552 (* (solar-cosine-degrees latitude)
|
|
553 (solar-cosine-degrees de)
|
|
554 (solar-cosine-degrees ah))))))
|
|
555 (if (> height 180) (setq height (- height 360)))
|
|
556 (list azimuth height)))
|
|
557
|
|
558 (defun solar-equatorial-coordinates (time for-sunrise-sunset)
|
|
559 "Right ascension (in hours) and declination (in degrees) of the sun at TIME.
|
|
560
|
|
561 TIME is a pair with the first component being the number of Julian centuries
|
|
562 elapsed at 0 Universal Time, and the second component being the universal
|
|
563 time. For instance, the pair corresponding to November 28, 1995 at 16 UT is
|
14273
|
564 \(-0.040945 16), -0.040945 being the number of julian centuries elapsed between
|
13874
|
565 Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT."
|
|
566 (let* ((tm (solar-ephemeris-time time))
|
|
567 (ec (solar-ecliptic-coordinates tm for-sunrise-sunset)))
|
|
568 (list (solar-right-ascension (car ec) (car (cdr ec)))
|
|
569 (solar-declination (car ec) (car (cdr ec))))))
|
|
570
|
|
571 (defun solar-ecliptic-coordinates (time for-sunrise-sunset)
|
|
572 "Apparent longitude of the sun, ecliptic inclination, (both in degrees)
|
|
573 equation of time (in hours) and nutation in longitude (in seconds)
|
|
574 at moment `time', expressed in julian centuries of Ephemeris Time
|
|
575 since January 1st, 2000, at 12 ET."
|
|
576 (let* ((l (+ 280.46645
|
|
577 (* 36000.76983 time)
|
|
578 (* 0.0003032 time time))) ; sun mean longitude
|
|
579 (ml (+ 218.3165
|
|
580 (* 481267.8813 time))) ; moon mean longitude
|
|
581 (m (+ 357.52910
|
|
582 (* 35999.05030 time)
|
|
583 (* -0.0001559 time time)
|
|
584 (* -0.00000048 time time time))) ; sun mean anomaly
|
|
585 (i (+ 23.43929111 (* -0.013004167 time)
|
|
586 (* -0.00000016389 time time)
|
|
587 (* 0.0000005036 time time time))); mean inclination
|
|
588 (c (+ (* (+ 1.914600
|
|
589 (* -0.004817 time)
|
|
590 (* -0.000014 time time))
|
|
591 (solar-sin-degrees m))
|
|
592 (* (+ 0.019993 (* -0.000101 time))
|
|
593 (solar-sin-degrees (* 2 m)))
|
|
594 (* 0.000290
|
|
595 (solar-sin-degrees (* 3 m))))) ; center equation
|
|
596 (L (+ l c)) ; total longitude
|
|
597 (omega (+ 125.04
|
|
598 (* -1934.136 time))) ; longitude of moon's ascending node
|
|
599 ; on the ecliptic
|
|
600 (nut (if (not for-sunrise-sunset)
|
|
601 (+ (* -17.20 (solar-sin-degrees omega))
|
|
602 (* -1.32 (solar-sin-degrees (* 2 l)))
|
|
603 (* -0.23 (solar-sin-degrees (* 2 ml)))
|
|
604 (* 0.21 (solar-sin-degrees (* 2 omega))))
|
|
605 nil))
|
|
606 ; nut = nutation in longitude, measured in seconds of angle.
|
|
607 (ecc (if (not for-sunrise-sunset)
|
|
608 (+ 0.016708617
|
|
609 (* -0.000042037 time)
|
|
610 (* -0.0000001236 time time)) ; eccentricity of earth's orbit
|
|
611 nil))
|
|
612 (app (+ L
|
|
613 -0.00569
|
|
614 (* -0.00478
|
|
615 (solar-sin-degrees omega)))) ; apparent longitude of sun
|
|
616 (y (if (not for-sunrise-sunset)
|
|
617 (* (solar-tangent-degrees (/ i 2))
|
|
618 (solar-tangent-degrees (/ i 2)))
|
|
619 nil))
|
|
620 (time-eq (if (not for-sunrise-sunset)
|
|
621 (/ (* 12 (+ (* y (solar-sin-degrees (* 2 l)))
|
|
622 (* -2 ecc (solar-sin-degrees m))
|
|
623 (* 4 ecc y (solar-sin-degrees m)
|
|
624 (solar-cosine-degrees (* 2 l)))
|
|
625 (* -0.5 y y (solar-sin-degrees (* 4 l)))
|
|
626 (* -1.25 ecc ecc (solar-sin-degrees (* 2 m)))))
|
|
627 3.1415926535)
|
|
628 nil)))
|
|
629 ; equation of time, in hours
|
|
630 (list app i time-eq nut)))
|
|
631
|
13045
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
632 (defun solar-longitude (d)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
633 "Longitude of sun on astronomical (Julian) day number D.
|
13874
|
634 Accurary is about 0.0006 degree (about 365.25*24*60*0.0006/360 = 1 minutes).
|
13045
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
635
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
636 The values of calendar-daylight-savings-starts,
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
637 calendar-daylight-savings-starts-time, calendar-daylight-savings-ends,
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
638 calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
639 calendar-time-zone are used to interpret local time."
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
640 (let* ((a-d (calendar-absolute-from-astro d))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
641 ;; get Universal Time
|
13874
|
642 (date (calendar-astro-from-absolute
|
|
643 (- a-d
|
|
644 (if (dst-in-effect a-d)
|
|
645 (/ calendar-daylight-time-offset 24.0 60.0) 0)
|
|
646 (/ calendar-time-zone 60.0 24.0))))
|
13045
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
647 ;; get Ephemeris Time
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
648 (date (+ date (solar-ephemeris-correction
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
649 (extract-calendar-year
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
650 (calendar-gregorian-from-absolute
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
651 (floor
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
652 (calendar-absolute-from-astro
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
653 date)))))))
|
13874
|
654 (U (/ (- date 2451545) 3652500))
|
|
655 (longitude
|
|
656 (+ 4.9353929
|
|
657 (* 62833.1961680 U)
|
|
658 (* 0.0000001
|
|
659 (apply '+
|
|
660 (mapcar '(lambda (x)
|
|
661 (* (car x)
|
|
662 (sin (mod
|
|
663 (+ (car (cdr x))
|
|
664 (* (car (cdr (cdr x))) U))
|
|
665 (* 2 pi)))))
|
|
666 solar-data-list)))))
|
|
667 (aberration
|
|
668 (* 0.0000001 (- (* 17 (cos (+ 3.10 (* 62830.14 U)))) 973)))
|
|
669 (A1 (mod (+ 2.18 (* U (+ -3375.70 (* 0.36 U)))) (* 2 pi)))
|
|
670 (A2 (mod (+ 3.51 (* U (+ 125666.39 (* 0.10 U)))) (* 2 pi)))
|
|
671 (nutation (* -0.0000001 (+ (* 834 (sin A1)) (* 64 (sin A2))))))
|
|
672 (mod (radians-to-degrees (+ longitude aberration nutation)) 360.0)))
|
|
673
|
|
674 (defconst solar-data-list
|
|
675 '((403406 4.721964 1.621043)
|
|
676 (195207 5.937458 62830.348067)
|
|
677 (119433 1.115589 62830.821524)
|
|
678 (112392 5.781616 62829.634302)
|
|
679 (3891 5.5474 125660.5691)
|
|
680 (2819 1.5120 125660.984)
|
|
681 (1721 4.1897 62832.4766)
|
|
682 (0 1.163 0.813)
|
|
683 (660 5.415 125659.31)
|
|
684 (350 4.315 57533.85)
|
|
685 (334 4.553 -33.931)
|
|
686 (314 5.198 777137.715)
|
|
687 (268 5.989 78604.191)
|
|
688 (242 2.911 5.412)
|
|
689 (234 1.423 39302.098)
|
|
690 (158 0.061 -34.861)
|
|
691 (132 2.317 115067.698)
|
|
692 (129 3.193 15774.337)
|
|
693 (114 2.828 5296.670)
|
|
694 (99 0.52 58849.27)
|
|
695 (93 4.65 5296.11)
|
|
696 (86 4.35 -3980.70)
|
|
697 (78 2.75 52237.69)
|
|
698 (72 4.50 55076.47)
|
|
699 (68 3.23 261.08)
|
|
700 (64 1.22 15773.85)
|
|
701 (46 0.14 188491.03)
|
|
702 (38 3.44 -7756.55)
|
|
703 (37 4.37 264.89)
|
|
704 (32 1.14 117906.27)
|
|
705 (29 2.84 55075.75)
|
|
706 (28 5.96 -7961.39)
|
|
707 (27 5.09 188489.81)
|
|
708 (27 1.72 2132.19)
|
|
709 (25 2.56 109771.03)
|
|
710 (24 1.92 54868.56)
|
|
711 (21 0.09 25443.93)
|
|
712 (21 5.98 -55731.43)
|
|
713 (20 4.03 60697.74)
|
|
714 (18 4.47 2132.79)
|
|
715 (17 0.79 109771.63)
|
|
716 (14 4.24 -7752.82)
|
|
717 (13 2.01 188491.91)
|
|
718 (13 2.65 207.81)
|
|
719 (13 4.98 29424.63)
|
|
720 (12 0.93 -7.99)
|
|
721 (10 2.21 46941.14)
|
|
722 (10 3.59 -68.29)
|
|
723 (10 1.50 21463.25)
|
|
724 (10 2.55 157208.40)))
|
956
|
725
|
|
726 (defun solar-ephemeris-correction (year)
|
13874
|
727 "Ephemeris time minus Universal Time during Gregorian year.
|
|
728 Result is in days.
|
|
729
|
|
730 For the years 1800-1987, the maximum error is 1.9 seconds.
|
13045
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
731 For the other years, the maximum error is about 30 seconds."
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
732 (cond ((and (<= 1988 year) (< year 2020))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
733 (/ (+ year -2000 67.0) 60.0 60.0 24.0))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
734 ((and (<= 1900 year) (< year 1988))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
735 (let* ((theta (/ (- (calendar-astro-from-absolute
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
736 (calendar-absolute-from-gregorian
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
737 (list 7 1 year)))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
738 (calendar-astro-from-absolute
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
739 (calendar-absolute-from-gregorian
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
740 '(1 1 1900))))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
741 36525.0))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
742 (theta2 (* theta theta))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
743 (theta3 (* theta2 theta))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
744 (theta4 (* theta2 theta2))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
745 (theta5 (* theta3 theta2)))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
746 (+ -0.00002
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
747 (* 0.000297 theta)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
748 (* 0.025184 theta2)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
749 (* -0.181133 theta3)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
750 (* 0.553040 theta4)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
751 (* -0.861938 theta5)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
752 (* 0.677066 theta3 theta3)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
753 (* -0.212591 theta4 theta3))))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
754 ((and (<= 1800 year) (< year 1900))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
755 (let* ((theta (/ (- (calendar-astro-from-absolute
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
756 (calendar-absolute-from-gregorian
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
757 (list 7 1 year)))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
758 (calendar-astro-from-absolute
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
759 (calendar-absolute-from-gregorian
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
760 '(1 1 1900))))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
761 36525.0))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
762 (theta2 (* theta theta))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
763 (theta3 (* theta2 theta))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
764 (theta4 (* theta2 theta2))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
765 (theta5 (* theta3 theta2)))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
766 (+ -0.000009
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
767 (* 0.003844 theta)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
768 (* 0.083563 theta2)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
769 (* 0.865736 theta3)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
770 (* 4.867575 theta4)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
771 (* 15.845535 theta5)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
772 (* 31.332267 theta3 theta3)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
773 (* 38.291999 theta4 theta3)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
774 (* 28.316289 theta4 theta4)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
775 (* 11.636204 theta4 theta5)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
776 (* 2.043794 theta5 theta5))))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
777 ((and (<= 1620 year) (< year 1800))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
778 (let ((x (/ (- year 1600) 10.0)))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
779 (/ (+ (* 2.19167 x x) (* -40.675 x) 196.58333) 60.0 60.0 24.0)))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
780 (t (let* ((tmp (- (calendar-astro-from-absolute
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
781 (calendar-absolute-from-gregorian
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
782 (list 1 1 year)))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
783 2382148))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
784 (second (- (/ (* tmp tmp) 41048480.0) 15)))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
785 (/ second 60.0 60.0 24.0)))))
|
956
|
786
|
13874
|
787 (defun solar-sidereal-time (t0)
|
|
788 "Sidereal time (in hours) in Greenwich.
|
|
789
|
|
790 At T0=Julian centuries of universal time.
|
|
791 T0 must correspond to 0 hours UT."
|
|
792 (let* ((mean-sid-time (+ 6.6973746
|
|
793 (* 2400.051337 t0)
|
|
794 (* 0.0000258622 t0 t0)
|
|
795 (* -0.0000000017222 t0 t0 t0)))
|
|
796 (et (solar-ephemeris-time (list t0 0.0)))
|
|
797 (nut-i (solar-ecliptic-coordinates et nil))
|
|
798 (nut (car (cdr (cdr (cdr nut-i))))) ; nutation
|
|
799 (i (car (cdr nut-i)))) ; inclination
|
|
800 (mod (+ (mod (+ mean-sid-time
|
|
801 (/ (/ (* nut (solar-cosine-degrees i)) 15) 3600)) 24.0)
|
|
802 24.0)
|
|
803 24.0)))
|
|
804
|
|
805 (defun solar-time-equation (date ut)
|
|
806 "Equation of time expressed in hours at Gregorian DATE at Universal time UT."
|
|
807 (let* ((et (solar-date-to-et date ut))
|
|
808 (ec (solar-ecliptic-coordinates et nil)))
|
|
809 (car (cdr (cdr ec)))))
|
|
810
|
|
811 (defun solar-date-to-et (date ut)
|
|
812 "Ephemeris Time at Gregorian DATE at Universal Time UT (in hours).
|
|
813 Expressed in julian centuries of Ephemeris Time."
|
|
814 (let ((t0 (solar-julian-ut-centuries date)))
|
|
815 (solar-ephemeris-time (list t0 ut))))
|
|
816
|
956
|
817 ;;;###autoload
|
|
818 (defun sunrise-sunset (&optional arg)
|
13874
|
819 "Local time of sunrise and sunset for today. Accurate to a few seconds.
|
7255
|
820 If called with an optional prefix argument, prompt for date.
|
956
|
821
|
7255
|
822 If called with an optional double prefix argument, prompt for longitude,
|
|
823 latitude, time zone, and date, and always use standard time.
|
956
|
824
|
|
825 This function is suitable for execution in a .emacs file."
|
|
826 (interactive "p")
|
5835
1c685c3bd5a9
(calendar-sunrise-sunset): Use new error arg to calendar-cursor-to-date.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
827 (or arg (setq arg 1))
|
998
|
828 (if (and (< arg 16)
|
|
829 (not (and calendar-latitude calendar-longitude calendar-time-zone)))
|
|
830 (solar-setup))
|
956
|
831 (let* ((calendar-longitude
|
998
|
832 (if (< arg 16) calendar-longitude
|
956
|
833 (solar-get-number
|
|
834 "Enter longitude (decimal fraction; + east, - west): ")))
|
|
835 (calendar-latitude
|
998
|
836 (if (< arg 16) calendar-latitude
|
956
|
837 (solar-get-number
|
|
838 "Enter latitude (decimal fraction; + north, - south): ")))
|
|
839 (calendar-time-zone
|
998
|
840 (if (< arg 16) calendar-time-zone
|
956
|
841 (solar-get-number
|
3779
e9961fa24193
*solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change
Jim Blandy <jimb@redhat.com>
diff
changeset
|
842 "Enter difference from Coordinated Universal Time (in minutes): ")))
|
956
|
843 (calendar-location-name
|
998
|
844 (if (< arg 16) calendar-location-name
|
|
845 (let ((float-output-format "%.1f"))
|
|
846 (format "%s%s, %s%s"
|
9714
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
847 (if (numberp calendar-latitude)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
848 (abs calendar-latitude)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
849 (+ (aref calendar-latitude 0)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
850 (/ (aref calendar-latitude 1) 60.0)))
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
851 (if (numberp calendar-latitude)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
852 (if (> calendar-latitude 0) "N" "S")
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
853 (if (equal (aref calendar-latitude 2) 'north) "N" "S"))
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
854 (if (numberp calendar-longitude)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
855 (abs calendar-longitude)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
856 (+ (aref calendar-longitude 0)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
857 (/ (aref calendar-longitude 1) 60.0)))
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
858 (if (numberp calendar-longitude)
|
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
859 (if (> calendar-longitude 0) "E" "W")
|
12312
|
860 (if (equal (aref calendar-longitude 2) 'east)
|
9714
c14b023ca6fe
Allow vector form of latitude/longitude. Fix documentation.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
861 "E" "W"))))))
|
956
|
862 (calendar-standard-time-zone-name
|
998
|
863 (if (< arg 16) calendar-standard-time-zone-name
|
3866
|
864 (cond ((= calendar-time-zone 0) "UTC")
|
998
|
865 ((< calendar-time-zone 0)
|
3866
|
866 (format "UTC%dmin" calendar-time-zone))
|
|
867 (t (format "UTC+%dmin" calendar-time-zone)))))
|
7255
|
868 (calendar-daylight-savings-starts
|
|
869 (if (< arg 16) calendar-daylight-savings-starts))
|
|
870 (calendar-daylight-savings-ends
|
|
871 (if (< arg 16) calendar-daylight-savings-ends))
|
998
|
872 (date (if (< arg 4) (calendar-current-date) (calendar-read-date)))
|
956
|
873 (date-string (calendar-date-string date t))
|
13874
|
874 (time-string (solar-sunrise-sunset-string date))
|
956
|
875 (msg (format "%s: %s" date-string time-string))
|
|
876 (one-window (one-window-p t)))
|
4651
|
877 (if (<= (length msg) (frame-width))
|
14331
|
878 (message "%s" msg)
|
956
|
879 (with-output-to-temp-buffer "*temp*"
|
|
880 (princ (concat date-string "\n" time-string)))
|
14331
|
881 (message "%s"
|
|
882 (substitute-command-keys
|
956
|
883 (if one-window
|
|
884 (if pop-up-windows
|
|
885 "Type \\[delete-other-windows] to remove temp window."
|
|
886 "Type \\[switch-to-buffer] RET to remove temp window.")
|
|
887 "Type \\[switch-to-buffer-other-window] RET to restore old contents of temp window."))))))
|
|
888
|
|
889 (defun calendar-sunrise-sunset ()
|
|
890 "Local time of sunrise and sunset for date under cursor.
|
13874
|
891 Accurate to a few seconds."
|
956
|
892 (interactive)
|
|
893 (if (not (and calendar-latitude calendar-longitude calendar-time-zone))
|
|
894 (solar-setup))
|
5835
1c685c3bd5a9
(calendar-sunrise-sunset): Use new error arg to calendar-cursor-to-date.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
895 (let ((date (calendar-cursor-to-date t)))
|
5698
|
896 (message "%s: %s"
|
|
897 (calendar-date-string date t t)
|
13874
|
898 (solar-sunrise-sunset-string date))))
|
956
|
899
|
|
900 (defun diary-sunrise-sunset ()
|
|
901 "Local time of sunrise and sunset as a diary entry.
|
13874
|
902 Accurate to a few seconds."
|
956
|
903 (if (not (and calendar-latitude calendar-longitude calendar-time-zone))
|
|
904 (solar-setup))
|
13874
|
905 (solar-sunrise-sunset-string date))
|
956
|
906
|
|
907 (defun diary-sabbath-candles ()
|
|
908 "Local time of candle lighting diary entry--applies if date is a Friday.
|
|
909 No diary entry if there is no sunset on that date."
|
|
910 (if (not (and calendar-latitude calendar-longitude calendar-time-zone))
|
|
911 (solar-setup))
|
|
912 (if (= (% (calendar-absolute-from-gregorian date) 7) 5);; Friday
|
13874
|
913 (let* ((sunset (car (cdr (solar-sunrise-sunset date))))
|
15095
|
914 (light (if sunset
|
|
915 (cons (- (car sunset) (/ 18.0 60.0)) (cdr sunset)))))
|
|
916 (if sunset
|
7778
|
917 (format "%s Sabbath candle lighting"
|
15095
|
918 (apply 'solar-time-string light))))))
|
956
|
919
|
13874
|
920 (defun solar-equinoxes/solstices (k year)
|
|
921 "Date of equinox/solstice K for YEAR.
|
|
922 K=0, spring equinox; K=1, summer solstice; K=2, fall equinox;
|
|
923 K=3, winter solstice.
|
|
924 RESULT is a gregorian local date.
|
|
925
|
|
926 Accurate to less than a minute between 1951 and 2050."
|
|
927 (let* ((JDE0 (solar-mean-equinoxes/solstices k year))
|
|
928 (T (/ (- JDE0 2451545.0) 36525))
|
|
929 (W (- (* 35999.373 T) 2.47))
|
|
930 (Delta-lambda (+ 1 (* 0.0334 (solar-cosine-degrees W))
|
|
931 (* 0.0007 (solar-cosine-degrees (* 2 W)))))
|
|
932 (S (apply '+ (mapcar '(lambda(x)
|
|
933 (* (car x) (solar-cosine-degrees
|
|
934 (+ (* (car (cdr (cdr x))) T)
|
|
935 (car (cdr x))))))
|
|
936 solar-seasons-data)))
|
|
937 (JDE (+ JDE0 (/ (* 0.00001 S) Delta-lambda)))
|
|
938 (correction (+ 102.3 (* 123.5 T) (* 32.5 T T)))
|
|
939 ; ephemeris time correction
|
|
940 (JD (- JDE (/ correction 86400)))
|
|
941 (date (calendar-gregorian-from-absolute (floor (- JD 1721424.5))))
|
|
942 (time (- (- JD 0.5) (floor (- JD 0.5))))
|
|
943 )
|
|
944 (list (car date) (+ (car (cdr date)) time
|
|
945 (/ (/ calendar-time-zone 60.0) 24.0))
|
|
946 (car (cdr (cdr date))))))
|
|
947
|
|
948 ; from Meeus, 1991, page 166
|
|
949 (defun solar-mean-equinoxes/solstices (k year)
|
|
950 "Julian day of mean equinox/solstice K for YEAR.
|
|
951 K=0, spring equinox; K=1, summer solstice; K=2, fall equinox; K=3, winter
|
|
952 solstice. These formulas are only to be used between 1000 BC and 3000 AD."
|
|
953 (let ((y (/ year 1000.0))
|
|
954 (z (/ (- year 2000) 1000.0)))
|
|
955 (if (< year 1000) ; actually between -1000 and 1000
|
|
956 (cond ((equal k 0) (+ 1721139.29189
|
|
957 (* 365242.13740 y)
|
|
958 (* 0.06134 y y)
|
|
959 (* 0.00111 y y y)
|
|
960 (* -0.00071 y y y y)))
|
|
961 ((equal k 1) (+ 1721233.25401
|
|
962 (* 365241.72562 y)
|
|
963 (* -0.05323 y y)
|
|
964 (* 0.00907 y y y)
|
|
965 (* 0.00025 y y y y)))
|
|
966 ((equal k 2) (+ 1721325.70455
|
|
967 (* 365242.49558 y)
|
|
968 (* -0.11677 y y)
|
|
969 (* -0.00297 y y y)
|
|
970 (* 0.00074 y y y y)))
|
|
971 ((equal k 3) (+ 1721414.39987
|
|
972 (* 365242.88257 y)
|
|
973 (* -0.00769 y y)
|
|
974 (* -0.00933 y y y)
|
|
975 (* -0.00006 y y y y))))
|
|
976 ; actually between 1000 and 3000
|
|
977 (cond ((equal k 0) (+ 2451623.80984
|
|
978 (* 365242.37404 z)
|
|
979 (* 0.05169 z z)
|
|
980 (* -0.00411 z z z)
|
|
981 (* -0.00057 z z z z)))
|
|
982 ((equal k 1) (+ 2451716.56767
|
|
983 (* 365241.62603 z)
|
|
984 (* 0.00325 z z)
|
|
985 (* 0.00888 z z z)
|
|
986 (* -0.00030 z z z z)))
|
|
987 ((equal k 2) (+ 2451810.21715
|
|
988 (* 365242.01767 z)
|
|
989 (* -0.11575 z z)
|
|
990 (* 0.00337 z z z)
|
|
991 (* 0.00078 z z z z)))
|
|
992 ((equal k 3) (+ 2451900.05952
|
|
993 (* 365242.74049 z)
|
|
994 (* -0.06223 z z)
|
|
995 (* -0.00823 z z z)
|
|
996 (* 0.00032 z z z z)))))))
|
|
997
|
|
998 ; from Meeus, 1991, page 167
|
|
999 (defconst solar-seasons-data
|
|
1000 '((485 324.96 1934.136)
|
|
1001 (203 337.23 32964.467)
|
|
1002 (199 342.08 20.186)
|
|
1003 (182 27.85 445267.112)
|
|
1004 (156 73.14 45036.886)
|
|
1005 (136 171.52 22518.443)
|
|
1006 (77 222.54 65928.934)
|
|
1007 (74 296.72 3034.906)
|
|
1008 (70 243.58 9037.513)
|
|
1009 (58 119.81 33718.147)
|
|
1010 (52 297.17 150.678)
|
|
1011 (50 21.02 2281.226)
|
|
1012 (45 247.54 29929.562)
|
|
1013 (44 325.15 31555.956)
|
|
1014 (29 60.93 4443.417)
|
|
1015 (18 155.12 67555.328)
|
|
1016 (17 288.79 4562.452)
|
|
1017 (16 198.04 62894.029)
|
|
1018 (14 199.76 31436.921)
|
|
1019 (12 95.39 14577.848)
|
|
1020 (12 287.11 31931.756)
|
|
1021 (12 320.81 34777.259)
|
|
1022 (9 227.73 1222.114)
|
|
1023 (8 15.45 16859.074)))
|
|
1024
|
5010
|
1025 ;;;###autoload
|
3866
|
1026 (defun solar-equinoxes-solstices ()
|
13874
|
1027 "*local* date and time of equinoxes and solstices, if visible in the calendar window.
|
956
|
1028 Requires floating point."
|
3866
|
1029 (let ((m displayed-month)
|
|
1030 (y displayed-year))
|
956
|
1031 (increment-calendar-month m y (cond ((= 1 (% m 3)) -1)
|
|
1032 ((= 2 (% m 3)) 1)
|
|
1033 (t 0)))
|
|
1034 (let* ((calendar-standard-time-zone-name
|
3866
|
1035 (if calendar-time-zone calendar-standard-time-zone-name "UTC"))
|
956
|
1036 (calendar-daylight-savings-starts
|
|
1037 (if calendar-time-zone calendar-daylight-savings-starts))
|
|
1038 (calendar-daylight-savings-ends
|
|
1039 (if calendar-time-zone calendar-daylight-savings-ends))
|
|
1040 (calendar-time-zone (if calendar-time-zone calendar-time-zone 0))
|
|
1041 (k (1- (/ m 3)))
|
13874
|
1042 (d0 (solar-equinoxes/solstices k y))
|
|
1043 (d1 (list (car d0) (floor (car (cdr d0))) (car (cdr (cdr d0)))))
|
|
1044 (h0 (* 24 (- (car (cdr d0)) (floor (car (cdr d0))))))
|
|
1045 (adj (dst-adjust-time d1 h0))
|
|
1046 (d (list (car d1) (+ (car (cdr d1))
|
|
1047 (/ (car (cdr adj)) 24.0))
|
|
1048 (car (cdr (cdr d1)))))
|
|
1049 ; The following is nearly as accurate, but not quite:
|
|
1050 ;(d0 (solar-date-next-longitude
|
|
1051 ; (calendar-astro-from-absolute
|
|
1052 ; (calendar-absolute-from-gregorian
|
|
1053 ; (list (+ 3 (* k 3)) 15 y)))
|
|
1054 ; 90))
|
|
1055 ;(abs-day (calendar-absolute-from-astro d)))
|
|
1056 (abs-day (calendar-absolute-from-gregorian d)))
|
13045
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
1057 (list
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
1058 (list (calendar-gregorian-from-absolute (floor abs-day))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
1059 (format "%s %s"
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
1060 (nth k (if (and calendar-latitude
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
1061 (< (calendar-latitude) 0))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
1062 solar-s-hemi-seasons
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
1063 solar-n-hemi-seasons))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
1064 (solar-time-string
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
1065 (* 24 (- abs-day (floor abs-day)))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
1066 (if (dst-in-effect abs-day)
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
1067 calendar-daylight-time-zone-name
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
1068 calendar-standard-time-zone-name))))))))
|
2779e3cf6cfa
Added code to support Chinese calendar. Minor fixes as well.
Edward M. Reingold <reingold@emr.cs.iit.edu>
diff
changeset
|
1069
|
956
|
1070
|
|
1071 (provide 'solar)
|
|
1072
|
|
1073 ;;; solar.el ends here
|