aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGlenn Morris2008-03-14 07:24:41 +0000
committerGlenn Morris2008-03-14 07:24:41 +0000
commite7148377c1a45b7b2cfbe9c9fcb553db131a8bde (patch)
tree799a54d98ce99916b5cef53a8f12924aa87bea94
parentf852191f5e7d97b7fe359116ac563d0137a8c117 (diff)
downloademacs-e7148377c1a45b7b2cfbe9c9fcb553db131a8bde.tar.gz
emacs-e7148377c1a45b7b2cfbe9c9fcb553db131a8bde.zip
Reorder so that functions are defined before use.
(displayed-month, displayed-year): Move declarations where needed. (solar-get-number): Move definition before use. Use unless. (solar-equatorial-coordinates): Simplify. (solar-sunrise-and-sunset): Use let rather than let*. (solar-longitude, solar-equinoxes-solstices): Use cadr, nth
-rw-r--r--lisp/ChangeLog7
-rw-r--r--lisp/calendar/solar.el549
2 files changed, 281 insertions, 275 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 75125030b4b..ced8820c45f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,12 @@
12008-03-14 Glenn Morris <rgm@gnu.org> 12008-03-14 Glenn Morris <rgm@gnu.org>
2 2
3 * calendar/solar.el: Reorder so that functions are defined before use.
4 (displayed-month, displayed-year): Move declarations where needed.
5 (solar-get-number): Move definition before use. Use unless.
6 (solar-equatorial-coordinates): Simplify.
7 (solar-sunrise-and-sunset): Use let rather than let*.
8 (solar-longitude, solar-equinoxes-solstices): Use cadr, nth
9
3 * startup.el (command-line-1): Rename -internal-script back to 10 * startup.el (command-line-1): Rename -internal-script back to
4 -scriptload (reverts previous change). 11 -scriptload (reverts previous change).
5 12
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index d0b02b4b111..78071bb5db8 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -54,9 +54,6 @@
54 54
55;;; Code: 55;;; Code:
56 56
57(defvar displayed-month)
58(defvar displayed-year)
59
60(if (fboundp 'atan) 57(if (fboundp 'atan)
61 (require 'lisp-float-type) 58 (require 'lisp-float-type)
62 (error "Solar calculations impossible since floating point is unavailable")) 59 (error "Solar calculations impossible since floating point is unavailable"))
@@ -206,6 +203,13 @@ Needed for polar areas, in order to know whether the day lasts 0 or 24 hours.")
206 long 203 long
207 (- long))))) 204 (- long)))))
208 205
206(defun solar-get-number (prompt)
207 "Return a number from the minibuffer, prompting with PROMPT.
208Returns nil if nothing was entered."
209 (let ((x (read-string prompt "")))
210 (unless (string-equal x "")
211 (string-to-number x))))
212
209(defun solar-setup () 213(defun solar-setup ()
210 "Prompt for `calendar-longitude', `calendar-latitude', `calendar-time-zone'." 214 "Prompt for `calendar-longitude', `calendar-latitude', `calendar-time-zone'."
211 (beep) 215 (beep)
@@ -223,13 +227,6 @@ Needed for polar areas, in order to know whether the day lasts 0 or 24 hours.")
223 "Enter difference from Coordinated Universal Time (in minutes): ") 227 "Enter difference from Coordinated Universal Time (in minutes): ")
224 ))) 228 )))
225 229
226(defun solar-get-number (prompt)
227 "Return a number from the minibuffer, prompting with PROMPT.
228Returns nil if nothing was entered."
229 (let ((x (read-string prompt "")))
230 (if (not (string-equal x ""))
231 (string-to-number x))))
232
233(defun solar-sin-degrees (x) 230(defun solar-sin-degrees (x)
234 "Return sin of X degrees." 231 "Return sin of X degrees."
235 (sin (degrees-to-radians (mod x 360.0)))) 232 (sin (degrees-to-radians (mod x 360.0))))
@@ -299,36 +296,182 @@ Both arguments are in degrees."
299 (* (solar-sin-degrees obliquity) 296 (* (solar-sin-degrees obliquity)
300 (solar-sin-degrees longitude)))) 297 (solar-sin-degrees longitude))))
301 298
302(defun solar-sunrise-and-sunset (time latitude longitude height) 299(defun solar-ecliptic-coordinates (time sunrise-flag)
303 "Sunrise, sunset and length of day. 300 "Return solar longitude, ecliptic inclination, equation of time, nutation.
304Parameters are the midday TIME and the LATITUDE, LONGITUDE of the location. 301Values are for TIME in Julian centuries of Ephemeris Time since
302January 1st, 2000, at 12 ET. Longitude and inclination are in
303degrees, equation of time in hours, and nutation in seconds of longitude.
304If SUNRISE-FLAG is non-nil, only calculate longitude and inclination."
305 (let* ((l (+ 280.46645
306 (* 36000.76983 time)
307 (* 0.0003032 time time))) ; sun mean longitude
308 (ml (+ 218.3165
309 (* 481267.8813 time))) ; moon mean longitude
310 (m (+ 357.52910
311 (* 35999.05030 time)
312 (* -0.0001559 time time)
313 (* -0.00000048 time time time))) ; sun mean anomaly
314 (i (+ 23.43929111 (* -0.013004167 time)
315 (* -0.00000016389 time time)
316 (* 0.0000005036 time time time))) ; mean inclination
317 (c (+ (* (+ 1.914600
318 (* -0.004817 time)
319 (* -0.000014 time time))
320 (solar-sin-degrees m))
321 (* (+ 0.019993 (* -0.000101 time))
322 (solar-sin-degrees (* 2 m)))
323 (* 0.000290
324 (solar-sin-degrees (* 3 m))))) ; center equation
325 (L (+ l c)) ; total longitude
326 ;; Longitude of moon's ascending node on the ecliptic.
327 (omega (+ 125.04
328 (* -1934.136 time)))
329 ;; nut = nutation in longitude, measured in seconds of angle.
330 (nut (unless sunrise-flag
331 (+ (* -17.20 (solar-sin-degrees omega))
332 (* -1.32 (solar-sin-degrees (* 2 l)))
333 (* -0.23 (solar-sin-degrees (* 2 ml)))
334 (* 0.21 (solar-sin-degrees (* 2 omega))))))
335 (ecc (unless sunrise-flag ; eccentricity of earth's orbit
336 (+ 0.016708617
337 (* -0.000042037 time)
338 (* -0.0000001236 time time))))
339 (app (+ L ; apparent longitude of sun
340 -0.00569
341 (* -0.00478
342 (solar-sin-degrees omega))))
343 (y (unless sunrise-flag
344 (* (solar-tangent-degrees (/ i 2))
345 (solar-tangent-degrees (/ i 2)))))
346 ;; Equation of time, in hours.
347 (time-eq (unless sunrise-flag
348 (/ (* 12 (+ (* y (solar-sin-degrees (* 2 l)))
349 (* -2 ecc (solar-sin-degrees m))
350 (* 4 ecc y (solar-sin-degrees m)
351 (solar-cosine-degrees (* 2 l)))
352 (* -0.5 y y (solar-sin-degrees (* 4 l)))
353 (* -1.25 ecc ecc (solar-sin-degrees (* 2 m)))))
354 3.1415926535))))
355 (list app i time-eq nut)))
356
357(defun solar-ephemeris-correction (year)
358 "Ephemeris time minus Universal Time during Gregorian YEAR.
359Result is in days. For the years 1800-1987, the maximum error is
3601.9 seconds. For the other years, the maximum error is about 30 seconds."
361 (cond ((and (<= 1988 year) (< year 2020))
362 (/ (+ year -2000 67.0) 60.0 60.0 24.0))
363 ((and (<= 1900 year) (< year 1988))
364 (let* ((theta (/ (- (calendar-astro-from-absolute
365 (calendar-absolute-from-gregorian
366 (list 7 1 year)))
367 (calendar-astro-from-absolute
368 (calendar-absolute-from-gregorian
369 '(1 1 1900))))
370 36525.0))
371 (theta2 (* theta theta))
372 (theta3 (* theta2 theta))
373 (theta4 (* theta2 theta2))
374 (theta5 (* theta3 theta2)))
375 (+ -0.00002
376 (* 0.000297 theta)
377 (* 0.025184 theta2)
378 (* -0.181133 theta3)
379 (* 0.553040 theta4)
380 (* -0.861938 theta5)
381 (* 0.677066 theta3 theta3)
382 (* -0.212591 theta4 theta3))))
383 ((and (<= 1800 year) (< year 1900))
384 (let* ((theta (/ (- (calendar-astro-from-absolute
385 (calendar-absolute-from-gregorian
386 (list 7 1 year)))
387 (calendar-astro-from-absolute
388 (calendar-absolute-from-gregorian
389 '(1 1 1900))))
390 36525.0))
391 (theta2 (* theta theta))
392 (theta3 (* theta2 theta))
393 (theta4 (* theta2 theta2))
394 (theta5 (* theta3 theta2)))
395 (+ -0.000009
396 (* 0.003844 theta)
397 (* 0.083563 theta2)
398 (* 0.865736 theta3)
399 (* 4.867575 theta4)
400 (* 15.845535 theta5)
401 (* 31.332267 theta3 theta3)
402 (* 38.291999 theta4 theta3)
403 (* 28.316289 theta4 theta4)
404 (* 11.636204 theta4 theta5)
405 (* 2.043794 theta5 theta5))))
406 ((and (<= 1620 year) (< year 1800))
407 (let ((x (/ (- year 1600) 10.0)))
408 (/ (+ (* 2.19167 x x) (* -40.675 x) 196.58333) 60.0 60.0 24.0)))
409 (t (let* ((tmp (- (calendar-astro-from-absolute
410 (calendar-absolute-from-gregorian
411 (list 1 1 year)))
412 2382148))
413 (second (- (/ (* tmp tmp) 41048480.0) 15)))
414 (/ second 60.0 60.0 24.0)))))
305 415
416(defun solar-ephemeris-time (time)
417 "Ephemeris Time at moment TIME.
306TIME is a pair with the first component being the number of Julian centuries 418TIME is a pair with the first component being the number of Julian centuries
307elapsed at 0 Universal Time, and the second component being the universal 419elapsed at 0 Universal Time, and the second component being the universal
308time. For instance, the pair corresponding to November 28, 1995 at 16 UT is 420time. For instance, the pair corresponding to November 28, 1995 at 16 UT is
309\(-0.040945 16), -0.040945 being the number of Julian centuries elapsed between 421\(-0.040945 16), -0.040945 being the number of Julian centuries elapsed between
310Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. 422Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT.
311 423
312HEIGHT is the angle the center of the sun has over the horizon for the contact 424Result is in Julian centuries of ephemeris time."
313we are trying to find. For sunrise and sunset, it is usually -0.61 degrees, 425 (let* ((t0 (car time))
314accounting for the edge of the sun being on the horizon. 426 (ut (cadr time))
427 (t1 (+ t0 (/ (/ ut 24.0) 36525)))
428 (y (+ 2000 (* 100 t1)))
429 (dt (* 86400 (solar-ephemeris-correction (floor y)))))
430 (+ t1 (/ (/ dt 86400) 36525))))
315 431
316Coordinates are included because this function is called with latitude=1 432(defun solar-equatorial-coordinates (time sunrise-flag)
317degrees to find out if polar regions have 24 hours of sun or only night." 433 "Right ascension (in hours) and declination (in degrees) of the sun at TIME.
318 (let* ((rise-time (solar-moment -1 latitude longitude time height)) 434TIME is a pair with the first component being the number of
319 (set-time (solar-moment 1 latitude longitude time height)) 435Julian centuries elapsed at 0 Universal Time, and the second
320 (day-length)) 436component being the universal time. For instance, the pair
321 (if (not (and rise-time set-time)) 437corresponding to November 28, 1995 at 16 UT is (-0.040945 16),
322 (if (or (and (> latitude 0) 438-0.040945 being the number of Julian centuries elapsed between
323 solar-northern-spring-or-summer-season) 439Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. SUNRISE-FLAG is passed
324 (and (< latitude 0) 440to `solar-ecliptic-coordinates'."
325 (not solar-northern-spring-or-summer-season))) 441 (let ((ec (solar-ecliptic-coordinates (solar-ephemeris-time time)
326 (setq day-length 24) 442 sunrise-flag)))
327 (setq day-length 0)) 443 (list (solar-right-ascension (car ec) (cadr ec))
328 (setq day-length (- set-time rise-time))) 444 (solar-declination (car ec) (cadr ec)))))
329 (list (if rise-time (+ rise-time (/ calendar-time-zone 60.0)) nil) 445
330 (if set-time (+ set-time (/ calendar-time-zone 60.0)) nil) 446(defun solar-horizontal-coordinates (time latitude longitude sunrise-flag)
331 day-length))) 447 "Azimuth and height of the sun at TIME, LATITUDE, and LONGITUDE.
448TIME is a pair with the first component being the number of
449Julian centuries elapsed at 0 Universal Time, and the second
450component being the universal time. For instance, the pair
451corresponding to November 28, 1995 at 16 UT is (-0.040945 16),
452-0.040945 being the number of Julian centuries elapsed between
453Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. SUNRISE-FLAG
454is passed to `solar-ecliptic-coordinates'. Azimuth and
455height (between -180 and 180) are both in degrees."
456 (let* ((ut (cadr time))
457 (ec (solar-equatorial-coordinates time sunrise-flag))
458 (st (+ solar-sidereal-time-greenwich-midnight
459 (* ut 1.00273790935)))
460 ;; Hour angle (in degrees).
461 (ah (- (* st 15) (* 15 (car ec)) (* -1 (calendar-longitude))))
462 (de (cadr ec))
463 (azimuth (solar-atn2 (- (* (solar-cosine-degrees ah)
464 (solar-sin-degrees latitude))
465 (* (solar-tangent-degrees de)
466 (solar-cosine-degrees latitude)))
467 (solar-sin-degrees ah)))
468 (height (solar-arcsin
469 (+ (* (solar-sin-degrees latitude) (solar-sin-degrees de))
470 (* (solar-cosine-degrees latitude)
471 (solar-cosine-degrees de)
472 (solar-cosine-degrees ah))))))
473 (if (> height 180) (setq height (- height 360)))
474 (list azimuth height)))
332 475
333(defun solar-moment (direction latitude longitude time height) 476(defun solar-moment (direction latitude longitude time height)
334 "Sunrise/sunset at location. 477 "Sunrise/sunset at location.
@@ -377,6 +520,37 @@ Uses binary search."
377 (setq possible nil)) ; the sun never sets 520 (setq possible nil)) ; the sun never sets
378 (if possible utmoment))) 521 (if possible utmoment)))
379 522
523(defun solar-sunrise-and-sunset (time latitude longitude height)
524 "Sunrise, sunset and length of day.
525Parameters are the midday TIME and the LATITUDE, LONGITUDE of the location.
526
527TIME is a pair with the first component being the number of Julian centuries
528elapsed at 0 Universal Time, and the second component being the universal
529time. For instance, the pair corresponding to November 28, 1995 at 16 UT is
530\(-0.040945 16), -0.040945 being the number of Julian centuries elapsed between
531Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT.
532
533HEIGHT is the angle the center of the sun has over the horizon for the contact
534we are trying to find. For sunrise and sunset, it is usually -0.61 degrees,
535accounting for the edge of the sun being on the horizon.
536
537Coordinates are included because this function is called with latitude=1
538degrees to find out if polar regions have 24 hours of sun or only night."
539 (let ((rise-time (solar-moment -1 latitude longitude time height))
540 (set-time (solar-moment 1 latitude longitude time height))
541 day-length)
542 (if (not (and rise-time set-time))
543 (if (or (and (> latitude 0)
544 solar-northern-spring-or-summer-season)
545 (and (< latitude 0)
546 (not solar-northern-spring-or-summer-season)))
547 (setq day-length 24)
548 (setq day-length 0))
549 (setq day-length (- set-time rise-time)))
550 (list (if rise-time (+ rise-time (/ calendar-time-zone 60.0)) nil)
551 (if set-time (+ set-time (/ calendar-time-zone 60.0)) nil)
552 day-length)))
553
380(defun solar-time-string (time time-zone) 554(defun solar-time-string (time time-zone)
381 "Printable form for decimal fraction TIME in TIME-ZONE. 555 "Printable form for decimal fraction TIME in TIME-ZONE.
382Format used is given by `calendar-time-display-form'." 556Format used is given by `calendar-time-display-form'."
@@ -388,13 +562,27 @@ Format used is given by `calendar-time-display-form'."
388 (24-hours (format "%02d" 24-hours))) 562 (24-hours (format "%02d" 24-hours)))
389 (mapconcat 'eval calendar-time-display-form ""))) 563 (mapconcat 'eval calendar-time-display-form "")))
390 564
391
392(defun solar-daylight (time) 565(defun solar-daylight (time)
393 "Printable form for TIME expressed in hours." 566 "Printable form for TIME expressed in hours."
394 (format "%d:%02d" 567 (format "%d:%02d"
395 (floor time) 568 (floor time)
396 (floor (* 60 (- time (floor time)))))) 569 (floor (* 60 (- time (floor time))))))
397 570
571(defun solar-julian-ut-centuries (date)
572 "Number of Julian centuries since 1 Jan, 2000 at noon UT for Gregorian DATE."
573 (/ (- (calendar-absolute-from-gregorian date)
574 (calendar-absolute-from-gregorian '(1 1.5 2000)))
575 36525.0))
576
577(defun solar-date-to-et (date ut)
578 "Ephemeris Time at Gregorian DATE at Universal Time UT (in hours).
579Expressed in Julian centuries of Ephemeris Time."
580 (solar-ephemeris-time (list (solar-julian-ut-centuries date) ut)))
581
582(defun solar-time-equation (date ut)
583 "Equation of time expressed in hours at Gregorian DATE at Universal time UT."
584 (nth 2 (solar-ecliptic-coordinates (solar-date-to-et date ut) nil)))
585
398(defun solar-exact-local-noon (date) 586(defun solar-exact-local-noon (date)
399 "Date and Universal Time of local noon at *local date* DATE. 587 "Date and Universal Time of local noon at *local date* DATE.
400The date may be different from the one asked for, but it will be the right 588The date may be different from the one asked for, but it will be the right
@@ -415,6 +603,22 @@ local date. The second component of date should be an integer."
415 (calendar-absolute-from-gregorian nd))) 603 (calendar-absolute-from-gregorian nd)))
416 (list nd ut))) 604 (list nd ut)))
417 605
606(defun solar-sidereal-time (t0)
607 "Sidereal time (in hours) in Greenwich at T0 Julian centuries.
608T0 must correspond to 0 hours UT."
609 (let* ((mean-sid-time (+ 6.6973746
610 (* 2400.051337 t0)
611 (* 0.0000258622 t0 t0)
612 (* -0.0000000017222 t0 t0 t0)))
613 (et (solar-ephemeris-time (list t0 0.0)))
614 (nut-i (solar-ecliptic-coordinates et nil))
615 (nut (nth 3 nut-i)) ; nutation
616 (i (cadr nut-i))) ; inclination
617 (mod (+ (mod (+ mean-sid-time
618 (/ (/ (* nut (solar-cosine-degrees i)) 15) 3600)) 24.0)
619 24.0)
620 24.0)))
621
418(defun solar-sunrise-sunset (date) 622(defun solar-sunrise-sunset (date)
419 "List of *local* times of sunrise, sunset, and daylight on Gregorian DATE. 623 "List of *local* times of sunrise, sunset, and daylight on Gregorian DATE.
420Corresponding value is nil if there is no sunrise/sunset." 624Corresponding value is nil if there is no sunrise/sunset."
@@ -467,161 +671,6 @@ Corresponding value is nil if there is no sunrise/sunset."
467 (eval calendar-location-name) 671 (eval calendar-location-name)
468 (nth 2 l)))) 672 (nth 2 l))))
469 673
470(defun solar-julian-ut-centuries (date)
471 "Number of Julian centuries since 1 Jan, 2000 at noon UT for Gregorian DATE."
472 (/ (- (calendar-absolute-from-gregorian date)
473 (calendar-absolute-from-gregorian '(1 1.5 2000)))
474 36525.0))
475
476(defun solar-ephemeris-time (time)
477 "Ephemeris Time at moment TIME.
478TIME is a pair with the first component being the number of Julian centuries
479elapsed at 0 Universal Time, and the second component being the universal
480time. For instance, the pair corresponding to November 28, 1995 at 16 UT is
481\(-0.040945 16), -0.040945 being the number of Julian centuries elapsed between
482Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT.
483
484Result is in Julian centuries of ephemeris time."
485 (let* ((t0 (car time))
486 (ut (cadr time))
487 (t1 (+ t0 (/ (/ ut 24.0) 36525)))
488 (y (+ 2000 (* 100 t1)))
489 (dt (* 86400 (solar-ephemeris-correction (floor y)))))
490 (+ t1 (/ (/ dt 86400) 36525))))
491
492(defun solar-date-next-longitude (d l)
493 "First time after day D when solar longitude is a multiple of L degrees.
494D is a Julian day number. L must be an integer divisor of 360.
495The result is for `calendar-location-name', and is in local time
496\(including any daylight saving rules) expressed in astronomical (Julian)
497day numbers. The values of `calendar-daylight-savings-starts',
498`calendar-daylight-savings-starts-time', `calendar-daylight-savings-ends',
499`calendar-daylight-savings-ends-time', `calendar-daylight-time-offset',
500and `calendar-time-zone' are used to interpret local time."
501 (let* ((long)
502 (start d)
503 (start-long (solar-longitude d))
504 (next (mod (* l (1+ (floor (/ start-long l)))) 360))
505 (end (+ d (* (/ l 360.0) 400)))
506 (end-long (solar-longitude end)))
507 (while ; bisection search for nearest minute
508 (< 0.00001 (- end start))
509 ;; start <= d < end
510 ;; start-long <= next < end-long when next != 0
511 ;; when next = 0, we look for the discontinuity (start-long is near 360
512 ;; and end-long is small (less than l).
513 (setq d (/ (+ start end) 2.0)
514 long (solar-longitude d))
515 (if (or (and (not (zerop next)) (< long next))
516 (and (zerop next) (< l long)))
517 (setq start d
518 start-long long)
519 (setq end d
520 end-long long)))
521 (/ (+ start end) 2.0)))
522
523(defun solar-horizontal-coordinates (time latitude longitude sunrise-flag)
524 "Azimuth and height of the sun at TIME, LATITUDE, and LONGITUDE.
525TIME is a pair with the first component being the number of
526Julian centuries elapsed at 0 Universal Time, and the second
527component being the universal time. For instance, the pair
528corresponding to November 28, 1995 at 16 UT is (-0.040945 16),
529-0.040945 being the number of Julian centuries elapsed between
530Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. SUNRISE-FLAG
531is passed to `solar-ecliptic-coordinates'. Azimuth and
532height (between -180 and 180) are both in degrees."
533 (let* ((ut (cadr time))
534 (ec (solar-equatorial-coordinates time sunrise-flag))
535 (st (+ solar-sidereal-time-greenwich-midnight
536 (* ut 1.00273790935)))
537 ;; Hour angle (in degrees).
538 (ah (- (* st 15) (* 15 (car ec)) (* -1 (calendar-longitude))))
539 (de (cadr ec))
540 (azimuth (solar-atn2 (- (* (solar-cosine-degrees ah)
541 (solar-sin-degrees latitude))
542 (* (solar-tangent-degrees de)
543 (solar-cosine-degrees latitude)))
544 (solar-sin-degrees ah)))
545 (height (solar-arcsin
546 (+ (* (solar-sin-degrees latitude) (solar-sin-degrees de))
547 (* (solar-cosine-degrees latitude)
548 (solar-cosine-degrees de)
549 (solar-cosine-degrees ah))))))
550 (if (> height 180) (setq height (- height 360)))
551 (list azimuth height)))
552
553(defun solar-equatorial-coordinates (time sunrise-flag)
554 "Right ascension (in hours) and declination (in degrees) of the sun at TIME.
555TIME is a pair with the first component being the number of
556Julian centuries elapsed at 0 Universal Time, and the second
557component being the universal time. For instance, the pair
558corresponding to November 28, 1995 at 16 UT is (-0.040945 16),
559-0.040945 being the number of Julian centuries elapsed between
560Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT. SUNRISE-FLAG is passed
561to `solar-ecliptic-coordinates'."
562 (let* ((tm (solar-ephemeris-time time))
563 (ec (solar-ecliptic-coordinates tm sunrise-flag)))
564 (list (solar-right-ascension (car ec) (car (cdr ec)))
565 (solar-declination (car ec) (car (cdr ec))))))
566
567(defun solar-ecliptic-coordinates (time sunrise-flag)
568 "Return solar longitude, ecliptic inclination, equation of time, nutation.
569Values are for TIME in Julian centuries of Ephemeris Time since
570January 1st, 2000, at 12 ET. Longitude and inclination are in
571degrees, equation of time in hours, and nutation in seconds of longitude.
572If SUNRISE-FLAG is non-nil, only calculate longitude and inclination."
573 (let* ((l (+ 280.46645
574 (* 36000.76983 time)
575 (* 0.0003032 time time))) ; sun mean longitude
576 (ml (+ 218.3165
577 (* 481267.8813 time))) ; moon mean longitude
578 (m (+ 357.52910
579 (* 35999.05030 time)
580 (* -0.0001559 time time)
581 (* -0.00000048 time time time))) ; sun mean anomaly
582 (i (+ 23.43929111 (* -0.013004167 time)
583 (* -0.00000016389 time time)
584 (* 0.0000005036 time time time))) ; mean inclination
585 (c (+ (* (+ 1.914600
586 (* -0.004817 time)
587 (* -0.000014 time time))
588 (solar-sin-degrees m))
589 (* (+ 0.019993 (* -0.000101 time))
590 (solar-sin-degrees (* 2 m)))
591 (* 0.000290
592 (solar-sin-degrees (* 3 m))))) ; center equation
593 (L (+ l c)) ; total longitude
594 ;; Longitude of moon's ascending node on the ecliptic.
595 (omega (+ 125.04
596 (* -1934.136 time)))
597 ;; nut = nutation in longitude, measured in seconds of angle.
598 (nut (unless sunrise-flag
599 (+ (* -17.20 (solar-sin-degrees omega))
600 (* -1.32 (solar-sin-degrees (* 2 l)))
601 (* -0.23 (solar-sin-degrees (* 2 ml)))
602 (* 0.21 (solar-sin-degrees (* 2 omega))))))
603 (ecc (unless sunrise-flag ; eccentricity of earth's orbit
604 (+ 0.016708617
605 (* -0.000042037 time)
606 (* -0.0000001236 time time))))
607 (app (+ L ; apparent longitude of sun
608 -0.00569
609 (* -0.00478
610 (solar-sin-degrees omega))))
611 (y (unless sunrise-flag
612 (* (solar-tangent-degrees (/ i 2))
613 (solar-tangent-degrees (/ i 2)))))
614 ;; Equation of time, in hours.
615 (time-eq (unless sunrise-flag
616 (/ (* 12 (+ (* y (solar-sin-degrees (* 2 l)))
617 (* -2 ecc (solar-sin-degrees m))
618 (* 4 ecc y (solar-sin-degrees m)
619 (solar-cosine-degrees (* 2 l)))
620 (* -0.5 y y (solar-sin-degrees (* 4 l)))
621 (* -1.25 ecc ecc (solar-sin-degrees (* 2 m)))))
622 3.1415926535))))
623 (list app i time-eq nut)))
624
625(defconst solar-data-list 674(defconst solar-data-list
626 '((403406 4.721964 1.621043) 675 '((403406 4.721964 1.621043)
627 (195207 5.937458 62830.348067) 676 (195207 5.937458 62830.348067)
@@ -705,8 +754,8 @@ The values of `calendar-daylight-savings-starts',
705 (mapcar (lambda (x) 754 (mapcar (lambda (x)
706 (* (car x) 755 (* (car x)
707 (sin (mod 756 (sin (mod
708 (+ (car (cdr x)) 757 (+ (cadr x)
709 (* (car (cdr (cdr x))) U)) 758 (* (nth 2 x) U))
710 (* 2 pi))))) 759 (* 2 pi)))))
711 solar-data-list))))) 760 solar-data-list)))))
712 (aberration 761 (aberration
@@ -716,89 +765,36 @@ The values of `calendar-daylight-savings-starts',
716 (nutation (* -0.0000001 (+ (* 834 (sin A1)) (* 64 (sin A2)))))) 765 (nutation (* -0.0000001 (+ (* 834 (sin A1)) (* 64 (sin A2))))))
717 (mod (radians-to-degrees (+ longitude aberration nutation)) 360.0))) 766 (mod (radians-to-degrees (+ longitude aberration nutation)) 360.0)))
718 767
719(defun solar-ephemeris-correction (year) 768(defun solar-date-next-longitude (d l)
720 "Ephemeris time minus Universal Time during Gregorian YEAR. 769 "First time after day D when solar longitude is a multiple of L degrees.
721Result is in days. For the years 1800-1987, the maximum error is 770D is a Julian day number. L must be an integer divisor of 360.
7221.9 seconds. For the other years, the maximum error is about 30 seconds." 771The result is for `calendar-location-name', and is in local time
723 (cond ((and (<= 1988 year) (< year 2020)) 772\(including any daylight saving rules) expressed in astronomical (Julian)
724 (/ (+ year -2000 67.0) 60.0 60.0 24.0)) 773day numbers. The values of `calendar-daylight-savings-starts',
725 ((and (<= 1900 year) (< year 1988)) 774`calendar-daylight-savings-starts-time', `calendar-daylight-savings-ends',
726 (let* ((theta (/ (- (calendar-astro-from-absolute 775`calendar-daylight-savings-ends-time', `calendar-daylight-time-offset',
727 (calendar-absolute-from-gregorian 776and `calendar-time-zone' are used to interpret local time."
728 (list 7 1 year))) 777 (let* ((long)
729 (calendar-astro-from-absolute 778 (start d)
730 (calendar-absolute-from-gregorian 779 (start-long (solar-longitude d))
731 '(1 1 1900)))) 780 (next (mod (* l (1+ (floor (/ start-long l)))) 360))
732 36525.0)) 781 (end (+ d (* (/ l 360.0) 400)))
733 (theta2 (* theta theta)) 782 (end-long (solar-longitude end)))
734 (theta3 (* theta2 theta)) 783 (while ; bisection search for nearest minute
735 (theta4 (* theta2 theta2)) 784 (< 0.00001 (- end start))
736 (theta5 (* theta3 theta2))) 785 ;; start <= d < end
737 (+ -0.00002 786 ;; start-long <= next < end-long when next != 0
738 (* 0.000297 theta) 787 ;; when next = 0, we look for the discontinuity (start-long is near 360
739 (* 0.025184 theta2) 788 ;; and end-long is small (less than l).
740 (* -0.181133 theta3) 789 (setq d (/ (+ start end) 2.0)
741 (* 0.553040 theta4) 790 long (solar-longitude d))
742 (* -0.861938 theta5) 791 (if (or (and (not (zerop next)) (< long next))
743 (* 0.677066 theta3 theta3) 792 (and (zerop next) (< l long)))
744 (* -0.212591 theta4 theta3)))) 793 (setq start d
745 ((and (<= 1800 year) (< year 1900)) 794 start-long long)
746 (let* ((theta (/ (- (calendar-astro-from-absolute 795 (setq end d
747 (calendar-absolute-from-gregorian 796 end-long long)))
748 (list 7 1 year))) 797 (/ (+ start end) 2.0)))
749 (calendar-astro-from-absolute
750 (calendar-absolute-from-gregorian
751 '(1 1 1900))))
752 36525.0))
753 (theta2 (* theta theta))
754 (theta3 (* theta2 theta))
755 (theta4 (* theta2 theta2))
756 (theta5 (* theta3 theta2)))
757 (+ -0.000009
758 (* 0.003844 theta)
759 (* 0.083563 theta2)
760 (* 0.865736 theta3)
761 (* 4.867575 theta4)
762 (* 15.845535 theta5)
763 (* 31.332267 theta3 theta3)
764 (* 38.291999 theta4 theta3)
765 (* 28.316289 theta4 theta4)
766 (* 11.636204 theta4 theta5)
767 (* 2.043794 theta5 theta5))))
768 ((and (<= 1620 year) (< year 1800))
769 (let ((x (/ (- year 1600) 10.0)))
770 (/ (+ (* 2.19167 x x) (* -40.675 x) 196.58333) 60.0 60.0 24.0)))
771 (t (let* ((tmp (- (calendar-astro-from-absolute
772 (calendar-absolute-from-gregorian
773 (list 1 1 year)))
774 2382148))
775 (second (- (/ (* tmp tmp) 41048480.0) 15)))
776 (/ second 60.0 60.0 24.0)))))
777
778(defun solar-sidereal-time (t0)
779 "Sidereal time (in hours) in Greenwich at T0 Julian centuries.
780T0 must correspond to 0 hours UT."
781 (let* ((mean-sid-time (+ 6.6973746
782 (* 2400.051337 t0)
783 (* 0.0000258622 t0 t0)
784 (* -0.0000000017222 t0 t0 t0)))
785 (et (solar-ephemeris-time (list t0 0.0)))
786 (nut-i (solar-ecliptic-coordinates et nil))
787 (nut (nth 3 nut-i)) ; nutation
788 (i (cadr nut-i))) ; inclination
789 (mod (+ (mod (+ mean-sid-time
790 (/ (/ (* nut (solar-cosine-degrees i)) 15) 3600)) 24.0)
791 24.0)
792 24.0)))
793
794(defun solar-time-equation (date ut)
795 "Equation of time expressed in hours at Gregorian DATE at Universal time UT."
796 (nth 2 (solar-ecliptic-coordinates (solar-date-to-et date ut) nil)))
797
798(defun solar-date-to-et (date ut)
799 "Ephemeris Time at Gregorian DATE at Universal Time UT (in hours).
800Expressed in Julian centuries of Ephemeris Time."
801 (solar-ephemeris-time (list (solar-julian-ut-centuries date) ut)))
802 798
803;;;###autoload 799;;;###autoload
804(defun sunrise-sunset (&optional arg) 800(defun sunrise-sunset (&optional arg)
@@ -1018,6 +1014,9 @@ solstice. These formulas are only to be used between 1000 BC and 3000 AD."
1018 (* -0.00823 z z z) 1014 (* -0.00823 z z z)
1019 (* 0.00032 z z z z))))))) 1015 (* 0.00032 z z z z)))))))
1020 1016
1017(defvar displayed-month) ; from generate-calendar
1018(defvar displayed-year)
1019
1021;;;###holiday-autoload 1020;;;###holiday-autoload
1022(defun solar-equinoxes-solstices () 1021(defun solar-equinoxes-solstices ()
1023 "Local date and time of equinoxes and solstices, if visible in the calendar. 1022 "Local date and time of equinoxes and solstices, if visible in the calendar.
@@ -1036,8 +1035,8 @@ Requires floating point."
1036 (calendar-time-zone (if calendar-time-zone calendar-time-zone 0)) 1035 (calendar-time-zone (if calendar-time-zone calendar-time-zone 0))
1037 (k (1- (/ m 3))) 1036 (k (1- (/ m 3)))
1038 (d0 (solar-equinoxes/solstices k y)) 1037 (d0 (solar-equinoxes/solstices k y))
1039 (d1 (list (car d0) (floor (car (cdr d0))) (car (cdr (cdr d0))))) 1038 (d1 (list (car d0) (floor (cadr d0)) (nth 2 d0)))
1040 (h0 (* 24 (- (car (cdr d0)) (floor (car (cdr d0)))))) 1039 (h0 (* 24 (- (cadr d0) (floor (cadr d0)))))
1041 (adj (dst-adjust-time d1 h0)) 1040 (adj (dst-adjust-time d1 h0))
1042 (d (list (caar adj) 1041 (d (list (caar adj)
1043 (+ (car (cdar adj)) 1042 (+ (car (cdar adj))