Commit 82605b18 authored by Liam Healy's avatar Liam Healy

Fix time conversion

When conversion to UT1 was attempted but *real-ut1-utc* was NIL, the
result was a timepoint that had the original dtspec value but whose
scale was set to :ut1. This has been fixed by returning two values from
convert-utc-ut1, the second value being a success indicator, which is
used by convert-time-scale to to determine how to set the scale on the
timepoint.
parent 03507b1b
;; Convert time scales
;; Liam Healy Sat Feb 4 2006 - 18:00
;; Time-stamp: <2015-01-08 14:57:51EST convert-timescale.lisp>
;; Time-stamp: <2015-12-24 16:02:34EST convert-timescale.lisp>
;; Copyright 2011, 2013, 2014, 2015 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -197,7 +197,7 @@
(defun convert-time-scale (timepoint new-scale)
"Convert time from one scale to another."
(check-type timepoint timepoint)
(let ((scale (scale timepoint)))
(let ((scale (scale timepoint)) (success t))
(make-timepoint-noconvert
:dtspec
(ecase new-scale
......@@ -211,7 +211,10 @@
(:tai (convert-tai-to-utc timepoint))
(:utc timepoint)
(:ut1 (if *UTC-to-UT1*
(funcall *UTC-to-UT1* timepoint nil)
(multiple-value-bind
(ts is-ut1) (funcall *UTC-to-UT1* timepoint nil)
(setf success is-ut1)
ts)
(error "Load physical-dimension to use UT1")))
(:gps (convert-gps-to-utc timepoint))
;; Local timezones can be a name appearing in *timezone-offsets*,
......@@ -222,19 +225,22 @@
(make-pq
(or (rest (assoc scale *timezone-offsets*)) ; scale can be a named time zone
(when (numberp scale) scale) ; or an hour offset
(error "Time scale ~a not known" scale)))
'hour))))
(error "Time scale ~a not known" scale))
'hour)))))
(:ut1
(ecase scale
(:utc (if *UTC-to-UT1*
(funcall *UTC-to-UT1* timepoint t)
(multiple-value-bind
(ts is-ut1) (funcall *UTC-to-UT1* timepoint t)
(setf success is-ut1)
ts)
(error "Load physical-dimension to use UT1")))
(:ut1 timepoint)))
(:gps
(ecase scale
(:gps timepoint)
(:utc (convert-utc-to-gps timepoint)))))
:scale new-scale
:scale (if success new-scale scale)
:day-only (day-only timepoint))))
;;; (convert-time-scale (make-timepoint-noconvert :iso8601 "1999-01-01T00:00:30" :scale :tai) :utc)
......
;; A point in time (specification with timescale)
;; Liam Healy Fri Oct 12 2001 - 11:53
;; Time-stamp: <2013-03-24 18:50:25EDT timepoint.lisp>
;; Time-stamp: <2015-12-24 16:17:29EST timepoint.lisp>
;; Copyright 2011 Liam M. Healy
;; Copyright 2011, 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
......@@ -66,8 +66,7 @@
(defun make-timepoint-noconvert
(&key dtspec timeparse scale (day-only nil day-only-specified))
"Make an object representing a point in time. Either dtspec,
or timeparse should be specified, and scale should be specified."
"Make an object representing a point in time. Either dtspec, or timeparse should be specified, and scale should be specified. Note that if dtspec is specified, the contents are changed in the original object."
(assert scale (scale) "Scale must be specified.")
(assert (or dtspec timeparse) (dtspec timeparse)
"One of dtspec or timeparse must be specified.")
......
;; UT1 timescale
;; Liam Healy 2015-01-03 11:13:34EST ut1.lisp
;; Time-stamp: <2015-04-23 17:06:59EDT ut1.lisp>
;; Time-stamp: <2015-12-24 15:55:13EST ut1.lisp>
;; Copyright 2011, 2013, 2014, 2015 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -88,24 +88,25 @@
*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))
"Convert UTC time scale to or from UT1 by adding/subtracting the appropriate fractional second. Returns two values: the timespec, and whether conversion was successful."
(unless *real-ut1-utc* (return-from convert-utc-ut1 (values timespec nil)))
(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)))
(return-from convert-utc-ut1 (values timespec nil))))
(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))))))
(values
(add-uniform-time
timespec
(antik:* (if to-ut1 +1 -1)
(or (gethash (cl:+ 1/2 (datime-j2000day timespec)) *ut1-utc-table*)
(no-data))))
t)))
;;; 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
......
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