Blame view

src/idl_extern/CMTotal_for_Dustemwrap/jplephmake.pro 8.47 KB
517b8f98   Annie Hughes   first commit
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
;+
; NAME:
;   JPLEPHMAKE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Make a new ephemeris suitable for interpolation by JPLEPHINTERP
;
; MAJOR TOPICS:
;   Planetary Orbits, Interpolation
;
; CALLING SEQUENCE:
;   JPLEPHREAD, INFO, RAW, OBJ, T, CX, CY, CZ, $
;               [ POSUNITS=, AUTHOR=, DATE=, OBJECTNAME=, ]
;               [ KEYWORDS=, KEYVALUES=, /RESET ]
;
; DESCRIPTION:
;
;   JPLEPHMAKE is a utility routine which forms an ephemeris table
;   suitable for interpolation with JPLEPHINTERP.  This is a way for
;   users to make or augment an ephemeris of solar system bodies not
;   already present in the JPL planetary ephemeris.  This routine only
;   creates new ephemerides in memory.  No facility is provided to
;   write to disk.
;
;   The user must have already estimated the Chebyshev polynomial
;   coefficients for the body of interest.  One way to do this is with
;   CHEBGRID from the Markwardt library.  
;
;   The two options are either to create a new ephemeris or to augment
;   an existing one.  Augmentation merely means that new columns are
;   added to an existing ephemeris table.  The JPL ephemeris itself
;   can be augmented.
;
;   Even when creating a new ephemeris from scratch, passing an
;   existing INFO structure based on another epehemeris is strongly
;   recommended, because the structure usually contains planetary
;   masses, physical constants, etc. which are relevant.
;
;
;
; PARAMETERS: 
;
;
;   INFO - upon input, an existing INFO structure based on a known
;          ephemeris.  Upon output, a modified INFO structure.
;
;          If INFO is undefined upon input, or the RESET keyword is
;          set, then the returned INFO is set to a generic header.
;
;   RAW - upon input, an existing set of Chebyshev coefficients.  Upon
;         output, the new or augmented set of coefficients.
;
;         If RAW is undefined upon input, or if the RESET keyword is
;         set, then the returned RAW variable is initialized to a new
;         set of keywords.
;
;   OBJ - scalar string, name of the object.
;
;   T - array of times, in Julian Days (TDB), which refer to the
;       *start* epoch of each granule.  [ In the terminology of the
;       JPL ephemeris and CHEBGRID, a "granule" is a single
;       subinterval over which a Chebyshev polynomial is fitted. ] If
;       an existing ephemeris is to be augmented, then T must overlap
;       exactly.
;
;   CX, CY, CZ - arrays of Chebyshev polynomial coefficients.
;
;
;
; KEYWORD PARAMETERS:
;
;   POSUNITS - a scalar string, the units of position as fitted by CX,
;              CY, and CZ.  Allowed values:
;                 'KM' - kilometers  (default)
;                 'CM' - centimeters
;                 'AU' - astronomical units
;                 'LT-S' - light seconds
;
;   NSUBINTERVALS - Number of granules per time sample.
;                   Default: 1
;
;   RESET - if set, then a new ephemeris table is created.  Any
;           Chebyshev coefficients in RAW are overwritten.
;
;   AUTHOR - a scalar string, an identifier giving the author of the
;            new ephemeris.
;            Default: ''
;
;   DATE - a scalar string, the creation date of the ephemeris.
;          Default: SYSTIME(0)
;
;   KEYWORDS - an optional string array, giving any header keywords to
;              be added to the ephemeris (in conjunction with
;              KEYVALUES).
;              Default: (none)
;
;   KEYVALUES - an optional double array, giving any header values for
;               the keywords specified by KEYWORDS.
;
;               Default: (none)
;
;
; EXAMPLE:
;
;
; REFERENCES:
;
;   JPL Export Ephmeris FTP Site
;      ftp://navigator.jpl.nasa.gov/pub/ephem/export/
;      (ephemeris files are available here, however, they must be
;      converted to FITS format using the "bin2eph" utility found in
;      AXBARY)
;
;
; SEE ALSO
;   JPLEPHREAD, JPLEPHINTERP, JPLEPHTEST
;   
; MODIFICATION HISTORY:
;   Written and Documented, CM, Mar 2002
;   Corrected way that ephemerides are merged, also
;     way that AUTHOR field is filled, 29 May 2002, CM
;
;  $Id: jplephmake.pro,v 1.4 2002/05/29 20:07:41 craigm Exp $
;
;-
; Copyright (C) 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy and distribute unmodified copies for
; non-commercial purposes, and to modify and use for personal or
; internal use, is granted.  All other rights are reserved.
;-

pro jplephmake, info, raw, obj, t, cx, cy, cz, reset=reset, $
                posunits=posunits, author=author, date=date, $
                keywords=newkeywords, keyvalues=newkeyvalues, $
                nsubintervals=ns0

  if n_elements(info) GT 0 then begin
      c = info.c
      au = info.au
      keywords = info.keywords
      keyvalues = info.keyvalues
  endif

  if n_elements(author) EQ 0 then author = ''
  if n_elements(date) EQ 0 then date = systime()

  fresh = n_elements(info) EQ 0 OR keyword_set(reset)

  if fresh then begin
      nrows = n_elements(t)-1
      tstart = min(t) & tstop = max(t)
      timedel = t(1)-t(0)
      format= 'JPLEPHMAKE'
      denum = 0L
      if n_elements(c) EQ 0 then $
        c = 299792458d                ;; Speed of light in km/s
      if n_elements(au) EQ 0 then $
        au = 499.00478380613566287138 ;; AU in lt-sec
      jdlimits = [tstart, tstop]
      jdrows = nrows
  endif else begin
      nrows = info.nrows
      tstart = info.tstart & tstop = info.tstop
      timedel = info.timedel
      format = info.format
      denum = info.denum
      jdlimits = info.jdlimits
      jdrows = info.jdrows
      
      objname = info.objname
      ptr = info.ptr
      ncoeff = info.ncoeff
      nsub = info.nsub
      if author EQ '' then author = info.author
  endelse

  ;; Figure the number of subintervals.  If it's specified exactly,
  ;; well okay.  If this is an augmented ephemeris, then it may be
  ;; possible to assign the number of subintervals.
  if n_elements(ns0) EQ 0 then begin
      if fresh then begin
          ns = 1L
      endif else begin
          ns = round(timedel/(t(1)-t(0)))
      endelse
  endif else begin
      ns = round(ns0(0))
  endelse

  sz = size(cx)
  nc = sz(1)
  nr = sz(2) / ns

  xraw = transpose([[[cx]],[[cy]],[[cz]]], [0,2,1])
  xraw = reform(xraw,ns*nc*3L,nr, /overwrite) 

  c_km  = c/1000d
  au_km = au*c_km
  if n_elements(posunits) GT 0 then begin
      case strupcase(strtrim(posunits(0),2)) of
          'KM':   km = 1 ;; Dummy statement
          'CM':   xraw = xraw / 1d5   ;; Convert from CM to KM
          'AU':   xraw = xraw * au_km ;; Convert from AU to KM
          'LT-S': xraw = xraw * c_km  ;; Convert from LT-S to KM
          ELSE: message, 'ERROR: Unrecognized position units'
      endcase
  endif

  if fresh then begin
      objname = [strupcase(strtrim(obj(0),2))]
      ptr = [1L]
      ncoeff = [nc]
      nsub = [ns]

      raw = temporary(xraw)
  endif else begin

      if abs((t(1)-t(0))*ns - timedel) GT 1d-6 then begin
          message, 'ERROR: time sampling does not match'
      endif
      
      if abs(jdlimits(0) - min(t)) GT 1d-6 $
        OR abs(jdlimits(1) - max(t)) GT 1d-6 then begin
          message, 'ERROR: start and stop times do not match'
      endif

      if jdrows NE nr then begin
          message, 'ERROR: number of rows does not match'
      endif

      iprev = n_elements(ncoeff)-1
      objname = [objname, strupcase(strtrim(obj(0),2))]
      ptr = [ptr, max(ptr)+ncoeff(iprev)*nsub(iprev)*3L]
      ncoeff = [ncoeff, nc]
      nsub = [nsub, ns]
      
      szr = size(raw)
      newraw = make_array(szr(1)+nc*3, nr)
      newraw(0,0) = raw
      newraw(szr(1),0) = xraw
      raw = temporary(newraw)
  endelse

  if n_elements(newkeywords) EQ 0 then begin
      newkeywords = ['']
      newkeyvalues = ['']
  endif 
  if n_elements(keywords) EQ 0 then begin
      keywords = newkeywords
      keyvalues = newkeyvalues
  endif else if newkeywords(0) NE '' then begin
      keywords = [newkeywords, keywords]
      keyvalues = [newkeyvalues, keyvalues]
  endif

  auth = author
  info = {filename: '', edited: 1L, $
          creation_date: date, author: auth, $
          nrows: nrows, tstart: tstart, tstop: tstop, $
          timedel: timedel, format: format, denum: denum, $
          c: c, au: au, jdlimits: jdlimits, jdrows: jdrows, $
          objname: objname, ptr: ptr, ncoeff: ncoeff, $
          nsub: nsub, keywords: keywords, keyvalues: keyvalues}

  return
end