Commit a363d65e authored by Liam M. Healy's avatar Liam M. Healy
Browse files

Reorganize UT1 conversion

UT1 is now in a separate file, date-time/ut1.lisp, which is not loaded
until physical-dimension, and thus the connected system datime-pqd, is
loaded. If/when Drakma is loaded then a request to convert to or from
UT1 will trigger a fetch of the earth orientation data from USNO. If
not available, the user is warned and asked to continue assuming
UT1=UTC.

This was spurred by failure to load date-time because USNO was not
available, even when no UT1 was needed.
parent 8aaf74da
;; Physical dimension system definition
;; Liam Healy
;; Time-stamp: <2014-01-14 21:10:05EST date-time.asd>
;; Time-stamp: <2015-01-03 12:11:36EST date-time.asd>
;; Copyright 2014 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -49,11 +49,12 @@
((:file "time-interval")
(:file "relative-time")
(:file "linear-timepoint")
(:file "dtmath")))))
(:file "dtmath")
(:file "ut1")))))
(asdf:defsystem-connection #:remote-phys-dim-data
:serial t
:requires (#:date-time #:drakma)
:requires (#:datime-pqd #:drakma)
:components
((:module date-time
:components
......
;; Convert time scales
;; Liam Healy Sat Feb 4 2006 - 18:00
;; Time-stamp: <2014-01-13 23:22:15EST convert-timescale.lisp>
;; Time-stamp: <2015-01-03 11:25:55EST convert-timescale.lisp>
;; Copyright 2011, 2013, 2014 Liam M. Healy
;; Copyright 2011, 2013, 2014, 2015 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -22,8 +22,6 @@
(in-package :antik)
(export '*real-ut1-utc*)
;;;****************************************************************************
;;; Conversion between TAI and UTC scales
;;;****************************************************************************
......@@ -185,84 +183,10 @@
:scale :gps))
;;;****************************************************************************
;;; UT1
;;; UT1 slug
;;;****************************************************************************
(defparameter *ut1-utc-table* nil
"Hash table of differences UT1-UTC by J2000 day number.
Use (read-op-file) to load.")
(defparameter *ut1-utc-first-estimated* nil
"First estimated UT1-UTC value in *ut1-utc-table*.
This serves as a marker for the age of the eop.dat file.")
(defparameter *eop-data-fetch* nil)
(defun read-eop-file ()
"Read the earth orientation parameters from USNO."
(unless *eop-data-fetch*
#+quicklisp
(progn
(cerror "Load drakma" "To fetch earth orientation data, drakma system needs to be loaded.")
(ql:quickload "drakma"))
#-quicklisp
(error "To fetch earth orientation data, drakma system needs to be loaded."))
(warn "Downloading earth orientation data; please wait.")
(with-input-from-string
(stream (funcall *eop-data-fetch*))
(loop for line cl:= (read-line stream nil nil)
with table cl:= (make-hash-table :test #'eql :size 2000)
and estimated and date
while line
do
(setf
date
(make-timepoint
:timeparse
(list 0 0 0
;; see ftp://maia.usno.navy.mil/ser7/readme.finals
;; for column description
(read-from-string line nil nil :start 4 :end 6)
(read-from-string line nil nil :start 2 :end 4)
(convert-two-digit-year
(read-from-string line nil nil :start 0 :end 2)))
:scale :utc
:day-only t)
(gethash (cl:+ 1/2 (datime-j2000day date)) table)
;; see ftp://maia.usno.navy.mil/ser7/readme.finals
;; for column description
(read-from-string line nil nil :start 58 :end 68))
(if (and (not estimated) (equal (subseq line 79 86) " "))
(setf estimated date))
finally (setf *ut1-utc-table* table
*ut1-utc-first-estimated* estimated))
*ut1-utc-table*))
(defparameter *real-ut1-utc* t "If NIL, UT1 will be taken the same as UTC.")
(defun convert-utc-ut1 (timespec &optional to-ut1)
"Convert UTC time scale to or from UT1 by adding/subtracting
the appropriate fractional second."
(unless *real-ut1-utc* (return-from convert-utc-ut1 timespec))
(flet ((no-data ()
(cerror "Take UT1 and UTC as the same from now on."
"Unable to find UT1-UTC table, or to find ~a in it."
timespec)
(setf *real-ut1-utc* nil)
(return-from convert-utc-ut1 timespec)))
(unless (or *ut1-utc-table* (read-eop-file)) ; Read EOP file if unread
(no-data))
;; Remove staleness check [[id:bc965ced-8e10-405f-becd-08d60f19a520][Split out system]]
;; Do the addition/subtraction
(add-uniform-time
timespec
(antik:* (if to-ut1 +1 -1)
(or (gethash (cl:+ 1/2 (datime-j2000day timespec)) *ut1-utc-table*)
(no-data))))))
;;; Round trip doesn't quite always come out even
;;; (convert-utc-ut1 (convert-utc-ut1 #D2005-01-01T00:00:00 t))
;;; #d2004-12-31T23:59:59.999556064605710
;;; because it is using different days in lookup table.
(defvar *UTC-to-UT1* nil)
;;;****************************************************************************
;;; Convert time scales
......@@ -284,7 +208,9 @@
(case scale
(:tai (convert-tai-to-utc timepoint))
(:utc timepoint)
(:ut1 (convert-utc-ut1 timepoint nil))
(:ut1 (if *UTC-to-UT1*
(funcall *UTC-to-UT1* timepoint nil)
(error "Load physical-dimension to use UT1")))
(:gps (convert-gps-to-utc timepoint))
;; Local timezones can be a name appearing in *timezone-offsets*,
;; or a numerical hour offset from UTC.
......@@ -298,7 +224,9 @@
'hour))))
(:ut1
(ecase scale
(:utc (convert-utc-ut1 timepoint t))
(:utc (if *UTC-to-UT1*
(funcall *UTC-to-UT1* timepoint t)
(error "Load physical-dimension to use UT1")))
(:ut1 timepoint)))
(:gps
(ecase scale
......
;; Thunk to retrieve earth orientation parameters from the web
;; Liam Healy 2013-11-24 12:51:55EST eop.lisp
;; Time-stamp: <2013-11-24 12:57:42EST eop.lisp>
;; Time-stamp: <2015-01-03 12:29:26EST eop.lisp>
;; Copyright 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -20,4 +20,6 @@
(in-package :antik)
(setf *eop-data-fetch* (drakma:http-request "http://maia.usno.navy.mil/ser7/finals.all"))
(setf *eop-data-fetch*
(lambda ()
(drakma:http-request "http://maia.usno.navy.mil/ser7/finals.all" :connection-timeout 10)))
;; Read timepoint specifications.
;; Liam Healy, Sat Feb 4 2006 - 12:17
;; Time-stamp: <2014-11-27 16:44:26EST read-time.lisp>
;; Time-stamp: <2015-01-03 11:17:30EST read-time.lisp>
;; Copyright 2011, 2014 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -227,7 +227,7 @@
"Timezones and number of hours from UTC, used to input timepoints.")
(defparameter *timescales*
(append '("utc" "tai" "gps" "ut1") (mapcar #'first *timezone-offsets*))
(append '("utc" "tai" "gps") (mapcar #'first *timezone-offsets*))
"All known time scales.")
(defun read-timescale (string)
......
;; UT1 timescale
;; Liam Healy 2015-01-03 11:13:34EST ut1.lisp
;; Time-stamp: <2015-01-03 12:42:37EST ut1.lisp>
;; Copyright 2011, 2013, 2014, 2015 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Only user definition is parameter *real-ut1-utc*
;;; Ref. [[id:ff2e9f1e-c9d2-4f3f-8435-59ea8eb42c1b][Astronomical time systems]]
(in-package :antik)
(export '*real-ut1-utc*)
(defparameter *real-ut1-utc* t "If NIL, user wants UT1 to be the same as UTC.")
(push "ut1" *timescales*)
(defparameter *ut1-utc-table* nil
"Hash table of differences UT1-UTC by J2000 day number.
Use (read-op-file) to load.")
(defparameter *ut1-utc-first-estimated* nil
"First estimated UT1-UTC value in *ut1-utc-table*.
This serves as a marker for the age of the eop.dat file.")
(defparameter *eop-data-fetch* nil
"Bound to a thunk when drakma is loaded.")
(defun read-eop-file ()
"Read the earth orientation parameters from USNO."
(unless *eop-data-fetch*
#+quicklisp
(progn
(cerror "Load drakma" "To fetch earth orientation data, drakma system needs to be loaded.")
(ql:quickload "drakma"))
#-quicklisp
(error "To fetch earth orientation data, drakma system needs to be loaded."))
(let ((eop-data (funcall *eop-data-fetch*)))
(unless (and (> (length eop-data) 10000)
(equal (subseq eop-data 0 2) "73"))
;; Drakma doesn't signal errors for HTTP failure, just puts the
;; error or whatever is returned. So we just measure the length
;; and assume that if it's too short or if the first two
;; characters aren't "73", it's not the actual data.
(warn "Failed to successfully download and read earth orientation data.")
(return-from read-eop-file *ut1-utc-table*))
(with-input-from-string
(stream eop-data)
(loop for line cl:= (read-line stream nil nil)
with table cl:= (make-hash-table :test #'eql :size 2000)
and estimated and date
while line
do
(setf
date
(make-timepoint
:timeparse
(list 0 0 0
;; see ftp://maia.usno.navy.mil/ser7/readme.finals
;; for column description
(read-from-string line nil nil :start 4 :end 6)
(read-from-string line nil nil :start 2 :end 4)
(convert-two-digit-year
(read-from-string line nil nil :start 0 :end 2)))
:scale :utc
:day-only t)
(gethash (cl:+ 1/2 (datime-j2000day date)) table)
;; see ftp://maia.usno.navy.mil/ser7/readme.finals
;; for column description
(read-from-string line nil nil :start 58 :end 68))
(if (and (not estimated) (equal (subseq line 79 86) " "))
(setf estimated date))
finally (setf *ut1-utc-table* table
*ut1-utc-first-estimated* estimated))
*ut1-utc-table*)))
(defun convert-utc-ut1 (timespec &optional to-ut1)
"Convert UTC time scale to or from UT1 by adding/subtracting
the appropriate fractional second."
(unless *real-ut1-utc* (return-from convert-utc-ut1 timespec))
(flet ((no-data ()
(cerror "Take UT1 and UTC as the same from now on."
"Unable to find UT1-UTC table, or to find ~a in it."
timespec)
(setf *real-ut1-utc* nil)
(return-from convert-utc-ut1 timespec)))
(unless (or *ut1-utc-table* (read-eop-file)) ; Read EOP file if unread
(no-data))
;; Remove staleness check [[id:bc965ced-8e10-405f-becd-08d60f19a520][Split out system]]
;; Do the addition/subtraction
(add-uniform-time
timespec
(antik:* (if to-ut1 +1 -1)
(or (gethash (cl:+ 1/2 (datime-j2000day timespec)) *ut1-utc-table*)
(no-data))))))
;;; Round trip doesn't quite always come out even
;;; (convert-utc-ut1 (convert-utc-ut1 #D2005-01-01T00:00:00 t))
;;; #d2004-12-31T23:59:59.999556064605710
;;; because it is using different days in lookup table.
(setf *UTC-to-UT1* #'convert-utc-ut1)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment