@swisseph/node 1.0.1 → 1.0.3

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
@@ -0,0 +1,4634 @@
1
+ /* SWISSEPH
2
+
3
+ SWISSEPH modules that may be useful for other applications
4
+ e.g. chopt.c, venus.c, swetest.c
5
+
6
+ Authors: Dieter Koch and Alois Treindl, Astrodienst Zurich
7
+
8
+ coordinate transformations
9
+ obliquity of ecliptic
10
+ nutation
11
+ precession
12
+ delta t
13
+ sidereal time
14
+ setting or getting of tidal acceleration of moon
15
+ chebyshew interpolation
16
+ ephemeris file name generation
17
+ cyclic redundancy checksum CRC
18
+ modulo and normalization functions
19
+
20
+ **************************************************************/
21
+ /* Copyright (C) 1997 - 2021 Astrodienst AG, Switzerland. All rights reserved.
22
+
23
+ License conditions
24
+ ------------------
25
+
26
+ This file is part of Swiss Ephemeris.
27
+
28
+ Swiss Ephemeris is distributed with NO WARRANTY OF ANY KIND. No author
29
+ or distributor accepts any responsibility for the consequences of using it,
30
+ or for whether it serves any particular purpose or works at all, unless he
31
+ or she says so in writing.
32
+
33
+ Swiss Ephemeris is made available by its authors under a dual licensing
34
+ system. The software developer, who uses any part of Swiss Ephemeris
35
+ in his or her software, must choose between one of the two license models,
36
+ which are
37
+ a) GNU Affero General Public License (AGPL)
38
+ b) Swiss Ephemeris Professional License
39
+
40
+ The choice must be made before the software developer distributes software
41
+ containing parts of Swiss Ephemeris to others, and before any public
42
+ service using the developed software is activated.
43
+
44
+ If the developer choses the AGPL software license, he or she must fulfill
45
+ the conditions of that license, which includes the obligation to place his
46
+ or her whole software project under the AGPL or a compatible license.
47
+ See https://www.gnu.org/licenses/agpl-3.0.html
48
+
49
+ If the developer choses the Swiss Ephemeris Professional license,
50
+ he must follow the instructions as found in http://www.astro.com/swisseph/
51
+ and purchase the Swiss Ephemeris Professional Edition from Astrodienst
52
+ and sign the corresponding license contract.
53
+
54
+ The License grants you the right to use, copy, modify and redistribute
55
+ Swiss Ephemeris, but only under certain conditions described in the License.
56
+ Among other things, the License requires that the copyright notices and
57
+ this notice be preserved on all copies.
58
+
59
+ Authors of the Swiss Ephemeris: Dieter Koch and Alois Treindl
60
+
61
+ The authors of Swiss Ephemeris have no control or influence over any of
62
+ the derived works, i.e. over software or services created by other
63
+ programmers which use Swiss Ephemeris functions.
64
+
65
+ The names of the authors or of the copyright holder (Astrodienst) must not
66
+ be used for promoting any software, product or service which uses or contains
67
+ the Swiss Ephemeris. This copyright notice is the ONLY place where the
68
+ names of the authors can legally appear, except in cases where they have
69
+ given special permission in writing.
70
+
71
+ The trademarks 'Swiss Ephemeris' and 'Swiss Ephemeris inside' may be used
72
+ for promoting such software, products or services.
73
+ */
74
+
75
+ #include <string.h>
76
+ #include <ctype.h>
77
+ #include "swephexp.h"
78
+ #include "sweph.h"
79
+ #include "swephlib.h"
80
+ #if MSDOS
81
+ # include <process.h>
82
+ # define strdup _strdup
83
+ #endif
84
+
85
+ #ifdef TRACE
86
+ void swi_open_trace(char *serr);
87
+ TLS FILE *swi_fp_trace_c = NULL;
88
+ TLS FILE *swi_fp_trace_out = NULL;
89
+ TLS int32 swi_trace_count = 0;
90
+ #endif
91
+
92
+ static void init_crc32(void);
93
+ static int init_dt(void);
94
+ static double adjust_for_tidacc(double ans, double Y, double tid_acc, double tid_acc0, AS_BOOL adjust_after_1955);
95
+ static double deltat_espenak_meeus_1620(double tjd, double tid_acc);
96
+ static double deltat_stephenson_etc_2016(double tjd, double tid_acc);
97
+ static double deltat_longterm_morrison_stephenson(double tjd);
98
+ static double deltat_stephenson_morrison_2004_1600(double tjd, double tid_acc);
99
+ static double deltat_stephenson_morrison_1997_1600(double tjd, double tid_acc);
100
+ static double deltat_aa(double tjd, double tid_acc);
101
+
102
+ #define SEFLG_EPHMASK (SEFLG_JPLEPH|SEFLG_SWIEPH|SEFLG_MOSEPH)
103
+
104
+ /* Reduce x modulo 360 degrees
105
+ */
106
+ double CALL_CONV swe_degnorm(double x)
107
+ {
108
+ double y;
109
+ y = fmod(x, 360.0);
110
+ if (fabs(y) < 1e-13) y = 0; /* Alois fix 11-dec-1999 */
111
+ if( y < 0.0 ) y += 360.0;
112
+ return(y);
113
+ }
114
+
115
+ /* Reduce x modulo TWOPI degrees
116
+ */
117
+ double CALL_CONV swe_radnorm(double x)
118
+ {
119
+ double y;
120
+ y = fmod(x, TWOPI);
121
+ if (fabs(y) < 1e-13) y = 0; /* Alois fix 11-dec-1999 */
122
+ if( y < 0.0 ) y += TWOPI;
123
+ return(y);
124
+ }
125
+
126
+ double CALL_CONV swe_deg_midp(double x1, double x0)
127
+ {
128
+ double d, y;
129
+ d = swe_difdeg2n(x1, x0); /* arc from x0 to x1 */
130
+ y = swe_degnorm(x0 + d / 2);
131
+ return(y);
132
+ }
133
+
134
+ double CALL_CONV swe_rad_midp(double x1, double x0)
135
+ {
136
+ return DEGTORAD * swe_deg_midp(x1 * RADTODEG, x0 * RADTODEG);
137
+ }
138
+
139
+ /* Reduce x modulo 2*PI
140
+ */
141
+ double swi_mod2PI(double x)
142
+ {
143
+ double y;
144
+ y = fmod(x, TWOPI);
145
+ if( y < 0.0 ) y += TWOPI;
146
+ return(y);
147
+ }
148
+
149
+
150
+ double swi_angnorm(double x)
151
+ {
152
+ if (x < 0.0 )
153
+ return x + TWOPI;
154
+ else if (x >= TWOPI)
155
+ return x - TWOPI;
156
+ else
157
+ return x;
158
+ }
159
+
160
+ void swi_cross_prod(double *a, double *b, double *x)
161
+ {
162
+ x[0] = a[1]*b[2] - a[2]*b[1];
163
+ x[1] = a[2]*b[0] - a[0]*b[2];
164
+ x[2] = a[0]*b[1] - a[1]*b[0];
165
+ }
166
+
167
+ /* Evaluates a given chebyshev series coef[0..ncf-1]
168
+ * with ncf terms at x in [-1,1]. Communications of the ACM, algorithm 446,
169
+ * April 1973 (vol. 16 no.4) by Dr. Roger Broucke.
170
+ */
171
+ double swi_echeb(double x, double *coef, int ncf)
172
+ {
173
+ int j;
174
+ double x2, br, brp2, brpp;
175
+ x2 = x * 2.;
176
+ br = 0.;
177
+ brp2 = 0.; /* dummy assign to silence gcc warning */
178
+ brpp = 0.;
179
+ for (j = ncf - 1; j >= 0; j--) {
180
+ brp2 = brpp;
181
+ brpp = br;
182
+ br = x2 * brpp - brp2 + coef[j];
183
+ }
184
+ return (br - brp2) * .5;
185
+ }
186
+
187
+ /*
188
+ * evaluates derivative of chebyshev series, see echeb
189
+ */
190
+ double swi_edcheb(double x, double *coef, int ncf)
191
+ {
192
+ double bjpl, xjpl;
193
+ int j;
194
+ double x2, bf, bj, dj, xj, bjp2, xjp2;
195
+ x2 = x * 2.;
196
+ bf = 0.; /* dummy assign to silence gcc warning */
197
+ bj = 0.; /* dummy assign to silence gcc warning */
198
+ xjp2 = 0.;
199
+ xjpl = 0.;
200
+ bjp2 = 0.;
201
+ bjpl = 0.;
202
+ for (j = ncf - 1; j >= 1; j--) {
203
+ dj = (double) (j + j);
204
+ xj = coef[j] * dj + xjp2;
205
+ bj = x2 * bjpl - bjp2 + xj;
206
+ bf = bjp2;
207
+ bjp2 = bjpl;
208
+ bjpl = bj;
209
+ xjp2 = xjpl;
210
+ xjpl = xj;
211
+ }
212
+ return (bj - bf) * .5;
213
+ }
214
+
215
+ /*
216
+ * conversion between ecliptical and equatorial polar coordinates.
217
+ * for users of SWISSEPH, not used by our routines.
218
+ * for ecl. to equ. eps must be negative.
219
+ * for equ. to ecl. eps must be positive.
220
+ * xpo, xpn are arrays of 3 doubles containing position.
221
+ * attention: input must be in degrees!
222
+ */
223
+ void CALL_CONV swe_cotrans(double *xpo, double *xpn, double eps)
224
+ {
225
+ int i;
226
+ double x[6], e = eps * DEGTORAD;
227
+ for(i = 0; i <= 1; i++)
228
+ x[i] = xpo[i];
229
+ x[0] *= DEGTORAD;
230
+ x[1] *= DEGTORAD;
231
+ x[2] = 1;
232
+ for(i = 3; i <= 5; i++)
233
+ x[i] = 0;
234
+ swi_polcart(x, x);
235
+ swi_coortrf(x, x, e);
236
+ swi_cartpol(x, x);
237
+ xpn[0] = x[0] * RADTODEG;
238
+ xpn[1] = x[1] * RADTODEG;
239
+ xpn[2] = xpo[2];
240
+ }
241
+
242
+ /*
243
+ * conversion between ecliptical and equatorial polar coordinates
244
+ * with speed.
245
+ * for users of SWISSEPH, not used by our routines.
246
+ * for ecl. to equ. eps must be negative.
247
+ * for equ. to ecl. eps must be positive.
248
+ * xpo, xpn are arrays of 6 doubles containing position and speed.
249
+ * attention: input must be in degrees!
250
+ */
251
+ void CALL_CONV swe_cotrans_sp(double *xpo, double *xpn, double eps)
252
+ {
253
+ int i;
254
+ double x[6], e = eps * DEGTORAD;
255
+ for (i = 0; i <= 5; i++)
256
+ x[i] = xpo[i];
257
+ x[0] *= DEGTORAD;
258
+ x[1] *= DEGTORAD;
259
+ x[2] = 1; /* avoids problems with polcart(), if x[2] = 0 */
260
+ x[3] *= DEGTORAD;
261
+ x[4] *= DEGTORAD;
262
+ swi_polcart_sp(x, x);
263
+ swi_coortrf(x, x, e);
264
+ swi_coortrf(x+3, x+3, e);
265
+ swi_cartpol_sp(x, xpn);
266
+ xpn[0] *= RADTODEG;
267
+ xpn[1] *= RADTODEG;
268
+ xpn[2] = xpo[2];
269
+ xpn[3] *= RADTODEG;
270
+ xpn[4] *= RADTODEG;
271
+ xpn[5] = xpo[5];
272
+ }
273
+
274
+ /*
275
+ * conversion between ecliptical and equatorial cartesian coordinates
276
+ * for ecl. to equ. eps must be negative
277
+ * for equ. to ecl. eps must be positive
278
+ */
279
+ void swi_coortrf(double *xpo, double *xpn, double eps)
280
+ {
281
+ double sineps, coseps;
282
+ double x[3];
283
+ sineps = sin(eps);
284
+ coseps = cos(eps);
285
+ x[0] = xpo[0];
286
+ x[1] = xpo[1] * coseps + xpo[2] * sineps;
287
+ x[2] = -xpo[1] * sineps + xpo[2] * coseps;
288
+ xpn[0] = x[0];
289
+ xpn[1] = x[1];
290
+ xpn[2] = x[2];
291
+ }
292
+
293
+ /*
294
+ * conversion between ecliptical and equatorial cartesian coordinates
295
+ * sineps sin(eps)
296
+ * coseps cos(eps)
297
+ * for ecl. to equ. sineps must be -sin(eps)
298
+ */
299
+ void swi_coortrf2(double *xpo, double *xpn, double sineps, double coseps)
300
+ {
301
+ double x[3];
302
+ x[0] = xpo[0];
303
+ x[1] = xpo[1] * coseps + xpo[2] * sineps;
304
+ x[2] = -xpo[1] * sineps + xpo[2] * coseps;
305
+ xpn[0] = x[0];
306
+ xpn[1] = x[1];
307
+ xpn[2] = x[2];
308
+ }
309
+
310
+ /* conversion of cartesian (x[3]) to polar coordinates (l[3]).
311
+ * x = l is allowed.
312
+ * if |x| = 0, then lon, lat and rad := 0.
313
+ */
314
+ void swi_cartpol(double *x, double *l)
315
+ {
316
+ double rxy;
317
+ double ll[3];
318
+ if (x[0] == 0 && x[1] == 0 && x[2] == 0) {
319
+ l[0] = l[1] = l[2] = 0;
320
+ return;
321
+ }
322
+ rxy = x[0]*x[0] + x[1]*x[1];
323
+ ll[2] = sqrt(rxy + x[2]*x[2]);
324
+ rxy = sqrt(rxy);
325
+ ll[0] = atan2(x[1], x[0]);
326
+ if (ll[0] < 0.0) ll[0] += TWOPI;
327
+ if (rxy == 0) {
328
+ if (x[2] >= 0)
329
+ ll[1] = PI / 2;
330
+ else
331
+ ll[1] = -(PI / 2);
332
+ } else {
333
+ ll[1] = atan(x[2] / rxy);
334
+ }
335
+ l[0] = ll[0];
336
+ l[1] = ll[1];
337
+ l[2] = ll[2];
338
+ }
339
+
340
+ /* conversion from polar (l[3]) to cartesian coordinates (x[3]).
341
+ * x = l is allowed.
342
+ */
343
+ void swi_polcart(double *l, double *x)
344
+ {
345
+ double xx[3];
346
+ double cosl1;
347
+ cosl1 = cos(l[1]);
348
+ xx[0] = l[2] * cosl1 * cos(l[0]);
349
+ xx[1] = l[2] * cosl1 * sin(l[0]);
350
+ xx[2] = l[2] * sin(l[1]);
351
+ x[0] = xx[0];
352
+ x[1] = xx[1];
353
+ x[2] = xx[2];
354
+ }
355
+
356
+ /* conversion of position and speed.
357
+ * from cartesian (x[6]) to polar coordinates (l[6]).
358
+ * x = l is allowed.
359
+ * if position is 0, function returns direction of
360
+ * motion.
361
+ */
362
+ void swi_cartpol_sp(double *x, double *l)
363
+ {
364
+ int i;
365
+ double xx[6], ll[6];
366
+ double rxy, coslon, sinlon, coslat, sinlat;
367
+ /* zero position */
368
+ if (x[0] == 0 && x[1] == 0 && x[2] == 0) {
369
+ ll[0] = ll[1] = ll[3] = ll[4] = 0;
370
+ ll[5] = sqrt(square_sum((x+3)));
371
+ swi_cartpol(x+3, ll);
372
+ ll[2] = 0;
373
+ for (i = 0; i <= 5; i++)
374
+ l[i] = ll[i];
375
+ return;
376
+ }
377
+ /* zero speed */
378
+ if (x[3] == 0 && x[4] == 0 && x[5] == 0) {
379
+ l[3] = l[4] = l[5] = 0;
380
+ swi_cartpol(x, l);
381
+ return;
382
+ }
383
+ /* position */
384
+ rxy = x[0]*x[0] + x[1]*x[1];
385
+ ll[2] = sqrt(rxy + x[2]*x[2]);
386
+ rxy = sqrt(rxy);
387
+ ll[0] = atan2(x[1], x[0]);
388
+ if (ll[0] < 0.0) ll[0] += TWOPI;
389
+ ll[1] = atan(x[2] / rxy);
390
+ /* speed:
391
+ * 1. rotate coordinate system by longitude of position about z-axis,
392
+ * so that new x-axis = position radius projected onto x-y-plane.
393
+ * in the new coordinate system
394
+ * vy'/r = dlong/dt, where r = sqrt(x^2 +y^2).
395
+ * 2. rotate coordinate system by latitude about new y-axis.
396
+ * vz"/r = dlat/dt, where r = position radius.
397
+ * vx" = dr/dt
398
+ */
399
+ coslon = x[0] / rxy; /* cos(l[0]); */
400
+ sinlon = x[1] / rxy; /* sin(l[0]); */
401
+ coslat = rxy / ll[2]; /* cos(l[1]); */
402
+ sinlat = x[2] / ll[2]; /* sin(ll[1]); */
403
+ xx[3] = x[3] * coslon + x[4] * sinlon;
404
+ xx[4] = -x[3] * sinlon + x[4] * coslon;
405
+ l[3] = xx[4] / rxy; /* speed in longitude */
406
+ xx[4] = -sinlat * xx[3] + coslat * x[5];
407
+ xx[5] = coslat * xx[3] + sinlat * x[5];
408
+ l[4] = xx[4] / ll[2]; /* speed in latitude */
409
+ l[5] = xx[5]; /* speed in radius */
410
+ l[0] = ll[0]; /* return position */
411
+ l[1] = ll[1];
412
+ l[2] = ll[2];
413
+ }
414
+
415
+ /* conversion of position and speed
416
+ * from polar (l[6]) to cartesian coordinates (x[6])
417
+ * x = l is allowed
418
+ * explanation s. swi_cartpol_sp()
419
+ */
420
+ void swi_polcart_sp(double *l, double *x)
421
+ {
422
+ double sinlon, coslon, sinlat, coslat;
423
+ double xx[6], rxy, rxyz;
424
+ /* zero speed */
425
+ if (l[3] == 0 && l[4] == 0 && l[5] == 0) {
426
+ x[3] = x[4] = x[5] = 0;
427
+ swi_polcart(l, x);
428
+ return;
429
+ }
430
+ /* position */
431
+ coslon = cos(l[0]);
432
+ sinlon = sin(l[0]);
433
+ coslat = cos(l[1]);
434
+ sinlat = sin(l[1]);
435
+ xx[0] = l[2] * coslat * coslon;
436
+ xx[1] = l[2] * coslat * sinlon;
437
+ xx[2] = l[2] * sinlat;
438
+ /* speed; explanation s. swi_cartpol_sp(), same method the other way round*/
439
+ rxyz = l[2];
440
+ rxy = sqrt(xx[0] * xx[0] + xx[1] * xx[1]);
441
+ xx[5] = l[5];
442
+ xx[4] = l[4] * rxyz;
443
+ x[5] = sinlat * xx[5] + coslat * xx[4]; /* speed z */
444
+ xx[3] = coslat * xx[5] - sinlat * xx[4];
445
+ xx[4] = l[3] * rxy;
446
+ x[3] = coslon * xx[3] - sinlon * xx[4]; /* speed x */
447
+ x[4] = sinlon * xx[3] + coslon * xx[4]; /* speed y */
448
+ x[0] = xx[0]; /* return position */
449
+ x[1] = xx[1];
450
+ x[2] = xx[2];
451
+ }
452
+
453
+ double swi_dot_prod_unit(double *x, double *y)
454
+ {
455
+ double dop = x[0]*y[0]+x[1]*y[1]+x[2]*y[2];
456
+ double e1 = sqrt(x[0]*x[0]+x[1]*x[1]+x[2]*x[2]);
457
+ double e2 = sqrt(y[0]*y[0]+y[1]*y[1]+y[2]*y[2]);
458
+ dop /= e1;
459
+ dop /= e2;
460
+ if (dop > 1)
461
+ dop = 1;
462
+ if (dop < -1)
463
+ dop = -1;
464
+ return dop;
465
+ }
466
+
467
+ /* functions for precession and ecliptic obliquity according to Vondrák et alii, 2011 */
468
+ #define AS2R (DEGTORAD / 3600.0)
469
+ #define D2PI TWOPI
470
+ #define EPS0 (84381.406 * AS2R)
471
+ #define NPOL_PEPS 4
472
+ #define NPER_PEPS 10
473
+ #define NPOL_PECL 4
474
+ #define NPER_PECL 8
475
+ #define NPOL_PEQU 4
476
+ #define NPER_PEQU 14
477
+
478
+ /* for pre_peps(): */
479
+ /* polynomials */
480
+ static const double pepol[NPOL_PEPS][2] = {
481
+ {+8134.017132, +84028.206305},
482
+ {+5043.0520035, +0.3624445},
483
+ {-0.00710733, -0.00004039},
484
+ {+0.000000271, -0.000000110}
485
+ };
486
+
487
+ /* periodics */
488
+ static const double peper[5][NPER_PEPS] = {
489
+ {+409.90, +396.15, +537.22, +402.90, +417.15, +288.92, +4043.00, +306.00, +277.00, +203.00},
490
+ {-6908.287473, -3198.706291, +1453.674527, -857.748557, +1173.231614, -156.981465, +371.836550, -216.619040, +193.691479, +11.891524},
491
+ {+753.872780, -247.805823, +379.471484, -53.880558, -90.109153, -353.600190, -63.115353, -28.248187, +17.703387, +38.911307},
492
+ {-2845.175469, +449.844989, -1255.915323, +886.736783, +418.887514, +997.912441, -240.979710, +76.541307, -36.788069, -170.964086},
493
+ {-1704.720302, -862.308358, +447.832178, -889.571909, +190.402846, -56.564991, -296.222622, -75.859952, +67.473503, +3.014055}
494
+ };
495
+
496
+ /* for pre_pecl(): */
497
+ /* polynomials */
498
+ static const double pqpol[NPOL_PECL][2] = {
499
+ {+5851.607687, -1600.886300},
500
+ {-0.1189000, +1.1689818},
501
+ {-0.00028913, -0.00000020},
502
+ {+0.000000101, -0.000000437}
503
+ };
504
+
505
+ /* periodics */
506
+ static const double pqper[5][NPER_PECL] = {
507
+ {708.15, 2309, 1620, 492.2, 1183, 622, 882, 547},
508
+ {-5486.751211, -17.127623, -617.517403, 413.44294, 78.614193, -180.732815, -87.676083, 46.140315},
509
+ // original publication A&A 534, A22 (2011):
510
+ //{-684.66156, 2446.28388, 399.671049, -356.652376, -186.387003, -316.80007, 198.296071, 101.135679},
511
+ // typo fixed according to A&A 541, C1 (2012)
512
+ {-684.66156, 2446.28388, 399.671049, -356.652376, -186.387003, -316.80007, 198.296701, 101.135679},
513
+ {667.66673, -2354.886252, -428.152441, 376.202861, 184.778874, 335.321713, -185.138669, -120.97283},
514
+ {-5523.863691, -549.74745, -310.998056, 421.535876, -36.776172, -145.278396, -34.74445, 22.885731}
515
+ };
516
+
517
+ /* for pre_pequ(): */
518
+ /* polynomials */
519
+ static const double xypol[NPOL_PEQU][2] = {
520
+ {+5453.282155, -73750.930350},
521
+ {+0.4252841, -0.7675452},
522
+ {-0.00037173, -0.00018725},
523
+ {-0.000000152, +0.000000231}
524
+ };
525
+
526
+ /* periodics */
527
+ static const double xyper[5][NPER_PEQU] = {
528
+ {256.75, 708.15, 274.2, 241.45, 2309, 492.2, 396.1, 288.9, 231.1, 1610, 620, 157.87, 220.3, 1200},
529
+ {-819.940624, -8444.676815, 2600.009459, 2755.17563, -167.659835, 871.855056, 44.769698, -512.313065, -819.415595, -538.071099, -189.793622, -402.922932, 179.516345, -9.814756},
530
+ {75004.344875, 624.033993, 1251.136893, -1102.212834, -2660.66498, 699.291817, 153.16722, -950.865637, 499.754645, -145.18821, 558.116553, -23.923029, -165.405086, 9.344131},
531
+ {81491.287984, 787.163481, 1251.296102, -1257.950837, -2966.79973, 639.744522, 131.600209, -445.040117, 584.522874, -89.756563, 524.42963, -13.549067, -210.157124, -44.919798},
532
+ {1558.515853, 7774.939698, -2219.534038, -2523.969396, 247.850422, -846.485643, -1393.124055, 368.526116, 749.045012, 444.704518, 235.934465, 374.049623, -171.33018, -22.899655}
533
+ };
534
+
535
+ void swi_ldp_peps(double tjd, double *dpre, double *deps)
536
+ {
537
+ int i;
538
+ int npol = NPOL_PEPS;
539
+ int nper = NPER_PEPS;
540
+ double t, p, q, w, a, s, c;
541
+ t = (tjd - J2000) / 36525.0;
542
+ p = 0;
543
+ q = 0;
544
+ /* periodic terms */
545
+ for (i = 0; i < nper; i++) {
546
+ w = D2PI * t;
547
+ a = w / peper[0][i];
548
+ s = sin(a);
549
+ c = cos(a);
550
+ p += c * peper[1][i] + s * peper[3][i];
551
+ q += c * peper[2][i] + s * peper[4][i];
552
+ }
553
+ /* polynomial terms */
554
+ w = 1;
555
+ for (i = 0; i < npol; i++) {
556
+ p += pepol[i][0] * w;
557
+ q += pepol[i][1] * w;
558
+ w *= t;
559
+ }
560
+ /* both to radians */
561
+ p *= AS2R;
562
+ q *= AS2R;
563
+ /* return */
564
+ if (dpre != NULL)
565
+ *dpre = p;
566
+ if (deps != NULL)
567
+ *deps = q;
568
+ //fprintf(stderr, "%.17f\n", *deps / DEGTORAD);
569
+ }
570
+
571
+ /*
572
+ * Long term high precision precession,
573
+ * according to Vondrak/Capitaine/Wallace, "New precession expressions, valid
574
+ * for long time intervals", in A&A 534, A22(2011).
575
+ */
576
+ /* precession of the ecliptic */
577
+ static void pre_pecl(double tjd, double *vec)
578
+ {
579
+ int i;
580
+ int npol = NPOL_PECL;
581
+ int nper = NPER_PECL;
582
+ double t, p, q, w, a, s, c, z;
583
+ t = (tjd - J2000) / 36525.0;
584
+ p = 0;
585
+ q = 0;
586
+ /* periodic terms */
587
+ for (i = 0; i < nper; i++) {
588
+ w = D2PI * t;
589
+ a = w / pqper[0][i];
590
+ s = sin(a);
591
+ c = cos(a);
592
+ p += c * pqper[1][i] + s * pqper[3][i];
593
+ q += c * pqper[2][i] + s * pqper[4][i];
594
+ }
595
+ /* polynomial terms */
596
+ w = 1;
597
+ for (i = 0; i < npol; i++) {
598
+ p += pqpol[i][0] * w;
599
+ q += pqpol[i][1] * w;
600
+ w *= t;
601
+ }
602
+ /* both to radians */
603
+ p *= AS2R;
604
+ q *= AS2R;
605
+ /* ecliptic pole vector */
606
+ z = 1 - p * p - q * q;
607
+ if (z < 0)
608
+ z = 0;
609
+ else
610
+ z = sqrt(z);
611
+ s = sin(EPS0);
612
+ c = cos(EPS0);
613
+ vec[0] = p;
614
+ vec[1] = - q * c - z * s;
615
+ vec[2] = - q * s + z * c;
616
+ }
617
+
618
+ /* precession of the equator */
619
+ static void pre_pequ(double tjd, double *veq)
620
+ {
621
+ int i;
622
+ int npol = NPOL_PEQU;
623
+ int nper = NPER_PEQU;
624
+ double t, x, y, w, a, s, c;
625
+ t = (tjd - J2000) / 36525.0;
626
+ x = 0;
627
+ y = 0;
628
+ for (i = 0; i < nper; i++) {
629
+ w = D2PI * t;
630
+ a = w / xyper[0][i];
631
+ s = sin(a);
632
+ c = cos(a);
633
+ x += c * xyper[1][i] + s * xyper[3][i];
634
+ y += c * xyper[2][i] + s * xyper[4][i];
635
+ }
636
+ /* polynomial terms */
637
+ w = 1;
638
+ for (i = 0; i < npol; i++) {
639
+ x += xypol[i][0] * w;
640
+ y += xypol[i][1] * w;
641
+ w *= t;
642
+ }
643
+ x *= AS2R;
644
+ y *= AS2R;
645
+ /* equator pole vector */
646
+ veq[0] = x;
647
+ veq[1] = y;
648
+ w = x * x + y * y;
649
+ if (w < 1)
650
+ veq[2] = sqrt(1 - w);
651
+ else
652
+ veq[2] = 0;
653
+ }
654
+
655
+ #if 0
656
+ static void swi_cross_prod(double *a, double *b, double *x)
657
+ {
658
+ x[0] = a[1] * b[2] - a[2] * b[1];
659
+ x[1] = a[2] * b[0] - a[0] * b[2];
660
+ x[2] = a[0] * b[1] - a[1] * b[0];
661
+ }
662
+ #endif
663
+
664
+ /* precession matrix */
665
+ static void pre_pmat(double tjd, double *rp)
666
+ {
667
+ double peqr[3], pecl[3], v[3], w, eqx[3];
668
+ //tjd = 1219339.078000;
669
+ /*equator pole */
670
+ pre_pequ(tjd, peqr);
671
+ /* ecliptic pole */
672
+ pre_pecl(tjd, pecl);
673
+ // fprintf(stderr, "%.17f %.17f %.17f\n", peqr[0], peqr[1], peqr[2]);
674
+ // fprintf(stderr, "%.17f %.17f %.17f\n", pecl[0], pecl[1], pecl[2]);
675
+ /* equinox */
676
+ swi_cross_prod(peqr, pecl, v);
677
+ w = sqrt(v[0] * v[0] + v[1] * v[1] + v[2] * v[2]);
678
+ eqx[0] = v[0] / w;
679
+ eqx[1] = v[1] / w;
680
+ eqx[2] = v[2] / w;
681
+ swi_cross_prod(peqr, eqx, v);
682
+ rp[0] = eqx[0];
683
+ rp[1] = eqx[1];
684
+ rp[2] = eqx[2];
685
+ rp[3] = v[0];
686
+ rp[4] = v[1];
687
+ rp[5] = v[2];
688
+ rp[6] = peqr[0];
689
+ rp[7] = peqr[1];
690
+ rp[8] = peqr[2];
691
+ // int i;
692
+ // for (i = 0; i < 3; i++) {
693
+ // fprintf(stderr, "(%.17f %.17f %.17f)\n", rp[i*3], rp[i*3+1],rp[i*3+2]);
694
+ // } /**/
695
+ }
696
+
697
+ /* precession according to Owen 1990:
698
+ * Owen, William M., Jr., (JPL) "A Theory of the Earth's Precession
699
+ * Relative to the Invariable Plane of the Solar System", Ph.D.
700
+ * Dissertation, University of Florida, 1990.
701
+ * Implemented for time range -18000 to 14000.
702
+ */
703
+ /*
704
+ * p. 177: central time Tc = -160, covering time span -200 <= T <= -120
705
+ * i.e. -14000 +- 40 centuries
706
+ * p. 178: central time Tc = -80, covering time span -120 <= T <= -40
707
+ * i.e. -6000 +- 40 centuries
708
+ * p. 179: central time Tc = 0, covering time span -40 <= T <= +40
709
+ * i.e. 2000 +- 40 centuries
710
+ * p. 180: central time Tc = 80, covering time span 40 <= T <= 120
711
+ * i.e. 10000 +- 40 centuries
712
+ * p. 181: central time Tc = 160, covering time span 120 <= T <= 200
713
+ * i.e. 10000 +- 40 centuries
714
+ */
715
+ static const double owen_eps0_coef[5][10] = {
716
+ {23.699391439256386, 5.2330816033981775e-1, -5.6259493384864815e-2, -8.2033318431602032e-3, 6.6774163554156385e-4, 2.4931584012812606e-5, -3.1313623302407878e-6, 2.0343814827951515e-7, 2.9182026615852936e-8, -4.1118760893281951e-9,},
717
+ {24.124759551704588, -1.2094875596566286e-1, -8.3914869653015218e-2, 3.5357075322387405e-3, 6.4557467824807032e-4, -2.5092064378707704e-5, -1.7631607274450848e-6, 1.3363622791424094e-7, 1.5577817511054047e-8, -2.4613907093017122e-9,},
718
+ {23.439103144206208, -4.9386077073143590e-1, -2.3965445283267805e-4, 8.6637485629656489e-3, -5.2828151901367600e-5, -4.3951004595359217e-5, -1.1058785949914705e-6, 6.2431490022621172e-8, 3.4725376218710764e-8, 1.3658853127005757e-9,},
719
+ {22.724671295125046, -1.6041813558650337e-1, 7.0646783888132504e-2, 1.4967806745062837e-3, -6.6857270989190734e-4, 5.7578378071604775e-6, 3.3738508454638728e-6, -2.2917813537654764e-7, -2.1019907929218137e-8, 4.3139832091694682e-9,},
720
+ {22.914636050333696, 3.2123508304962416e-1, 3.6633220173792710e-2, -5.9228324767696043e-3, -1.882379107379328e-4, 3.2274552870236244e-5, 4.9052463646336507e-7, -5.9064298731578425e-8, -2.0485712675098837e-8, -6.2163304813908160e-10,},
721
+ };
722
+
723
+ static const double owen_psia_coef[5][10] = {
724
+ {-218.57864954903122, 51.752257487741612, 1.3304715765661958e-1, 9.2048123521890745e-2, -6.0877528127241278e-3, -7.0013893644531700e-5, -4.9217728385458495e-5, -1.8578234189053723e-6, 7.4396426162029877e-7, -5.9157528981843864e-9,},
725
+ {-111.94350527506128, 55.175558131675861, 4.7366115762797613e-1, -4.7701750975398538e-2, -9.2445765329325809e-3, 7.0962838707454917e-4, 1.5140455277814658e-4, -7.7813159018954928e-7, -2.4729402281953378e-6, -1.0898887008726418e-7,},
726
+ {-2.041452011529441e-1, 55.969995858494106, -1.9295093699770936e-1, -5.6819574830421158e-3, 1.1073687302518981e-2, -9.0868489896815619e-5, -1.1999773777895820e-4, 9.9748697306154409e-6, 5.7911493603430550e-7, -2.3647526839778175e-7,},
727
+ {111.61366860604471, 56.404525305162447, 4.4403302410703782e-1, 7.1490030578883907e-2, -4.9184559079790816e-3, -1.3912698949042046e-3, -6.8490613661884005e-5, 1.2394328562905297e-6, 1.7719847841480384e-6, 2.4889095220628068e-7,},
728
+ {228.40683531269390, 60.056143904919826, 2.9583200718478960e-2, -1.5710838319490748e-1, -7.0017356811600801e-3, 3.3009615142224537e-3, 2.0318123852537664e-4, -6.5840216067828310e-5, -5.9077673352976155e-6, 1.3983942185303064e-6,},
729
+ };
730
+
731
+ static const double owen_oma_coef[5][10] = {
732
+ {25.541291140949806, 2.377889511272162e-1, -3.7337334723142133e-1, 2.4579295485161534e-2, 4.3840999514263623e-3, -3.1126873333599556e-4, -9.8443045771748915e-6, -7.9403103080496923e-7, 1.0840116743893556e-9, 9.2865105216887919e-9,},
733
+ {24.429357654237926, -9.5205745947740161e-1, 8.6738296270534816e-2, 3.0061543426062955e-2, -4.1532480523019988e-3, -3.7920928393860939e-4, 3.5117012399609737e-5, 4.6811877283079217e-6, -8.1836046585546861e-8, -6.1803706664211173e-8,},
734
+ {23.450465062489337, -9.7259278279739817e-2, 1.1082286925130981e-2, -3.1469883339372219e-2, -1.0041906996819648e-4, 5.6455168475133958e-4, -8.4403910211030209e-6, -3.8269157371098435e-6, 3.1422585261198437e-7, 9.3481729116773404e-9,},
735
+ {22.581778052947806, -8.7069701538602037e-1, -9.8140710050197307e-2, 2.6025931340678079e-2, 4.8165322168786755e-3, -1.906558772193363e-4, -4.6838759635421777e-5, -1.6608525315998471e-6, -3.2347811293516124e-8, 2.8104728109642000e-9,},
736
+ {21.518861835737142, 2.0494789509441385e-1, 3.5193604846503161e-1, 1.5305977982348925e-2, -7.5015367726336455e-3, -4.0322553186065610e-4, 1.0655320434844041e-4, 7.1792339586935752e-6, -1.603874697543020e-6, -1.613563462813512e-7,},
737
+ };
738
+
739
+ static const double owen_chia_coef[5][10] = {
740
+ {8.2378850337329404e-1, -3.7443109739678667, 4.0143936898854026e-1, 8.1822830214590811e-2, -8.5978790792656293e-3, -2.8350488448426132e-5, -4.2474671728156727e-5, -1.6214840884656678e-6, 7.8560442001953050e-7, -1.032016641696707e-8,},
741
+ {-2.1726062070318606, 7.8470515033132925e-1, 4.4044931004195718e-1, -8.0671247169971653e-2, -8.9672662444325007e-3, 9.2248978383109719e-4, 1.5143472266372874e-4, -1.6387009056475679e-6, -2.4405558979328144e-6, -1.0148113464009015e-7,},
742
+ {-4.8518673570735556e-1, 1.0016737299946743e-1, -4.7074888613099918e-1, -5.8604054305076092e-3, 1.4300208240553435e-2, -6.7127991650300028e-5, -1.3703764889645475e-4, 9.0505213684444634e-6, 6.0368690647808607e-7, -2.2135404747652171e-7,},
743
+ {-2.0950740076326087, -9.4447359463206877e-1, 4.0940512860493755e-1, 1.0261699700263508e-1, -5.3133241571955160e-3, -1.6634631550720911e-3, -5.9477519536647907e-5, 2.9651387319208926e-6, 1.6434499452070584e-6, 2.3720647656961084e-7,},
744
+ {6.3315163285678715e-1, 3.5241082918420464, 2.1223076605364606e-1, -1.5648122502767368e-1, -9.1964075390801980e-3, 3.3896161239812411e-3, 2.1485178626085787e-4, -6.6261759864793735e-5, -5.9257969712852667e-6, 1.3918759086160525e-6,},
745
+ };
746
+
747
+ static void get_owen_t0_icof(double tjd, double *t0, int *icof)
748
+ {
749
+ int i, j = 0;
750
+ double t0s[5] = {-3392455.5, -470455.5, 2451544.5, 5373544.5, 8295544.5, };
751
+ *t0 = t0s[0];
752
+ for (i = 1; i < 5; i++) {
753
+ if (tjd < (t0s[i-1] + t0s[i]) / 2) {
754
+ ;
755
+ } else {
756
+ *t0 = t0s[i];
757
+ j++;
758
+ }
759
+ }
760
+ *icof = j;
761
+ }
762
+
763
+ /* precession matrix Owen 1990 */
764
+ static void owen_pre_matrix(double tjd, double *rp, int iflag)
765
+ {
766
+ int i, icof = 0;
767
+ double eps0 = 0, chia = 0, psia = 0, oma = 0;
768
+ double coseps0, sineps0, coschia, sinchia, cospsia, sinpsia, cosoma, sinoma;
769
+ double k[10], tau[10];
770
+ double t0;
771
+ get_owen_t0_icof(tjd, &t0, &icof);
772
+ // fprintf(stderr, "%d, %.17f\n", icof, t0);
773
+ tau[0] = 0;
774
+ tau[1] = (tjd - t0) / 36525.0 / 40.0;
775
+ for (i = 2; i <= 9; i++) {
776
+ tau[i] = tau[1] * tau[i-1];
777
+ }
778
+ k[0] = 1;
779
+ k[1] = tau[1];
780
+ k[2] = 2 * tau[2] - 1;
781
+ k[3] = 4 * tau[3] - 3 * tau[1];
782
+ k[4] = 8 * tau[4] - 8 * tau[2] + 1;
783
+ k[5] = 16 * tau[5] - 20 * tau[3] + 5 * tau[1];
784
+ k[6] = 32 * tau[6] - 48 * tau[4] + 18 * tau[2] - 1;
785
+ k[7] = 64 * tau[7] - 112 * tau[5] + 56 * tau[3] - 7 * tau[1];
786
+ k[8] = 128 * tau[8] - 256 * tau[6] + 160 * tau[4] - 32 * tau[2] + 1;
787
+ k[9] = 256 * tau[9] - 576 * tau[7] + 432 * tau[5] - 120 * tau[3] + 9 * tau[1];
788
+ for (i = 0; i < 10; i++) {
789
+ //eps += (k[i] * owen_eps0_coef[icof][i]);
790
+ psia += (k[i] * owen_psia_coef[icof][i]);
791
+ oma += (k[i] * owen_oma_coef[icof][i]);
792
+ chia += (k[i] * owen_chia_coef[icof][i]);
793
+ }
794
+ if (iflag & (SEFLG_JPLHOR | SEFLG_JPLHOR_APPROX)) {
795
+ /*
796
+ * In comparison with JPL Horizons we have an almost constant offset
797
+ * almost constant offset in ecl. longitude of about -0.000019 deg.
798
+ * We fix this as follows: */
799
+ psia += -0.000018560;
800
+ }
801
+ eps0 = 84381.448 / 3600.0;
802
+ //fprintf(stderr, "e=%.17f, ps=%.17f, om=%.17f, ch=%.17f\n", eps0, psia, oma, chia);
803
+ eps0 *= DEGTORAD;
804
+ psia *= DEGTORAD;
805
+ chia *= DEGTORAD;
806
+ oma *= DEGTORAD;
807
+ coseps0 = cos(eps0);
808
+ sineps0 = sin(eps0);
809
+ coschia = cos(chia);
810
+ sinchia = sin(chia);
811
+ cospsia = cos(psia);
812
+ sinpsia = sin(psia);
813
+ cosoma = cos(oma);
814
+ sinoma = sin(oma);
815
+ rp[0] = coschia * cospsia + sinchia * cosoma * sinpsia;
816
+ rp[1] = (-coschia * sinpsia + sinchia * cosoma * cospsia) * coseps0 + sinchia * sinoma * sineps0;
817
+ rp[2] = (-coschia * sinpsia + sinchia * cosoma * cospsia) * sineps0 - sinchia * sinoma * coseps0;
818
+ rp[3] = -sinchia * cospsia + coschia * cosoma * sinpsia;
819
+ rp[4] = (sinchia * sinpsia + coschia * cosoma * cospsia) * coseps0 + coschia * sinoma * sineps0;
820
+ rp[5] = (sinchia * sinpsia + coschia * cosoma * cospsia) * sineps0 - coschia * sinoma * coseps0;
821
+ rp[6] = sinoma * sinpsia;
822
+ rp[7] = sinoma * cospsia * coseps0 - cosoma * sineps0;
823
+ rp[8] = sinoma * cospsia * sineps0 + cosoma * coseps0;
824
+ /*for (i = 0; i < 3; i++) {
825
+ fprintf(stderr, "(%.17f %.17f %.17f)\n", rp[i*3], rp[i*3+1],rp[i*3+2]);
826
+ } */
827
+ }
828
+ static void epsiln_owen_1986(double tjd, double *eps)
829
+ {
830
+ int i, icof = 0;
831
+ double k[10], tau[10];
832
+ double t0;
833
+ get_owen_t0_icof(tjd, &t0, &icof);
834
+ *eps = 0;
835
+ tau[0] = 0;
836
+ tau[1] = (tjd - t0) / 36525.0 / 40.0;
837
+ for (i = 2; i <= 9; i++) {
838
+ tau[i] = tau[1] * tau[i-1];
839
+ }
840
+ k[0] = 1;
841
+ k[1] = tau[1];
842
+ k[2] = 2 * tau[2] - 1;
843
+ k[3] = 4 * tau[3] - 3 * tau[1];
844
+ k[4] = 8 * tau[4] - 8 * tau[2] + 1;
845
+ k[5] = 16 * tau[5] - 20 * tau[3] + 5 * tau[1];
846
+ k[6] = 32 * tau[6] - 48 * tau[4] + 18 * tau[2] - 1;
847
+ k[7] = 64 * tau[7] - 112 * tau[5] + 56 * tau[3] - 7 * tau[1];
848
+ k[8] = 128 * tau[8] - 256 * tau[6] + 160 * tau[4] - 32 * tau[2] + 1;
849
+ k[9] = 256 * tau[9] - 576 * tau[7] + 432 * tau[5] - 120 * tau[3] + 9 * tau[1];
850
+ for (i = 0; i < 10; i++) {
851
+ *eps += (k[i] * owen_eps0_coef[icof][i]);
852
+ }
853
+ //fprintf(stderr, "eps=%.17f\n", *eps);
854
+ }
855
+
856
+ /* Obliquity of the ecliptic at Julian date J
857
+ *
858
+ * IAU Coefficients are from:
859
+ * J. H. Lieske, T. Lederle, W. Fricke, and B. Morando,
860
+ * "Expressions for the Precession Quantities Based upon the IAU
861
+ * (1976) System of Astronomical Constants," Astronomy and Astrophysics
862
+ * 58, 1-16 (1977).
863
+ *
864
+ * Before or after 200 years from J2000, the formula used is from:
865
+ * J. Laskar, "Secular terms of classical planetary theories
866
+ * using the results of general theory," Astronomy and Astrophysics
867
+ * 157, 59070 (1986).
868
+ *
869
+ * Bretagnon, P. et al.: 2003, "Expressions for Precession Consistent with
870
+ * the IAU 2000A Model". A&A 400,785
871
+ *B03 84381.4088 -46.836051*t -1667*10-7*t2 +199911*10-8*t3 -523*10-9*t4 -248*10-10*t5 -3*10-11*t6
872
+ *C03 84381.406 -46.836769*t -1831*10-7*t2 +20034*10-7*t3 -576*10-9*t4 -434*10-10*t5
873
+ *
874
+ * See precess and page B18 of the Astronomical Almanac.
875
+ */
876
+ #define OFFSET_EPS_JPLHORIZONS (35.95)
877
+ #define DCOR_EPS_JPL_TJD0 2437846.5
878
+ #define NDCOR_EPS_JPL 51
879
+ double dcor_eps_jpl[] = {
880
+ 36.726, 36.627, 36.595, 36.578, 36.640, 36.659, 36.731, 36.765,
881
+ 36.662, 36.555, 36.335, 36.321, 36.354, 36.227, 36.289, 36.348, 36.257, 36.163,
882
+ 35.979, 35.896, 35.842, 35.825, 35.912, 35.950, 36.093, 36.191, 36.009, 35.943,
883
+ 35.875, 35.771, 35.788, 35.753, 35.822, 35.866, 35.771, 35.732, 35.543, 35.498,
884
+ 35.449, 35.409, 35.497, 35.556, 35.672, 35.760, 35.596, 35.565, 35.510, 35.394,
885
+ 35.385, 35.375, 35.415,
886
+ };
887
+ double swi_epsiln(double J, int32 iflag)
888
+ {
889
+ double T, eps;
890
+ double tofs, dofs, t0, t1;
891
+ int prec_model = swed.astro_models[SE_MODEL_PREC_LONGTERM];
892
+ int prec_model_short = swed.astro_models[SE_MODEL_PREC_SHORTTERM];
893
+ int jplhora_model = swed.astro_models[SE_MODEL_JPLHORA_MODE];
894
+ AS_BOOL is_jplhor = FALSE;
895
+ if (prec_model == 0) prec_model = SEMOD_PREC_DEFAULT;
896
+ if (prec_model_short == 0) prec_model_short = SEMOD_PREC_DEFAULT_SHORT;
897
+ if (jplhora_model == 0) jplhora_model = SEMOD_JPLHORA_DEFAULT;
898
+ if (iflag & SEFLG_JPLHOR)
899
+ is_jplhor = TRUE;
900
+ if ((iflag & SEFLG_JPLHOR_APPROX)
901
+ && jplhora_model == SEMOD_JPLHORA_3
902
+ && J <= HORIZONS_TJD0_DPSI_DEPS_IAU1980)
903
+ is_jplhor = TRUE;
904
+ T = (J - 2451545.0)/36525.0;
905
+ if (is_jplhor) {
906
+ if (J > 2378131.5 && J < 2525323.5) { // between 1.1.1799 and 1.1.2202
907
+ eps = (((1.813e-3*T-5.9e-4)*T-46.8150)*T+84381.448)*DEGTORAD/3600;
908
+ } else {
909
+ epsiln_owen_1986(J, &eps);
910
+ eps *= DEGTORAD;
911
+ }
912
+ } else if ((iflag & SEFLG_JPLHOR_APPROX) && jplhora_model == SEMOD_JPLHORA_2) {
913
+ eps = (((1.813e-3*T-5.9e-4)*T-46.8150)*T+84381.448)*DEGTORAD/3600;
914
+ } else if (prec_model_short == SEMOD_PREC_IAU_1976 && fabs(T) <= PREC_IAU_1976_CTIES ) {
915
+ eps = (((1.813e-3*T-5.9e-4)*T-46.8150)*T+84381.448)*DEGTORAD/3600;
916
+ } else if (prec_model == SEMOD_PREC_IAU_1976) {
917
+ eps = (((1.813e-3*T-5.9e-4)*T-46.8150)*T+84381.448)*DEGTORAD/3600;
918
+ } else if (prec_model_short == SEMOD_PREC_IAU_2000 && fabs(T) <= PREC_IAU_2000_CTIES ) {
919
+ eps = (((1.813e-3*T-5.9e-4)*T-46.84024)*T+84381.406)*DEGTORAD/3600;
920
+ } else if (prec_model == SEMOD_PREC_IAU_2000) {
921
+ eps = (((1.813e-3*T-5.9e-4)*T-46.84024)*T+84381.406)*DEGTORAD/3600;
922
+ } else if (prec_model_short == SEMOD_PREC_IAU_2006 && fabs(T) <= PREC_IAU_2006_CTIES) {
923
+ eps = (((((-4.34e-8 * T -5.76e-7) * T +2.0034e-3) * T -1.831e-4) * T -46.836769) * T + 84381.406) * DEGTORAD / 3600.0;
924
+ } else if (prec_model == SEMOD_PREC_NEWCOMB) {
925
+ double Tn = (J - 2396758.0)/36525.0;
926
+ eps = (0.0017 * Tn * Tn * Tn - 0.0085 * Tn * Tn - 46.837 * Tn + 84451.68) * DEGTORAD / 3600.0;
927
+ } else if (prec_model == SEMOD_PREC_IAU_2006) {
928
+ eps = (((((-4.34e-8 * T -5.76e-7) * T +2.0034e-3) * T -1.831e-4) * T -46.836769) * T + 84381.406) * DEGTORAD / 3600.0;
929
+ } else if (prec_model == SEMOD_PREC_BRETAGNON_2003) {
930
+ eps = ((((((-3e-11 * T - 2.48e-8) * T -5.23e-7) * T +1.99911e-3) * T -1.667e-4) * T -46.836051) * T + 84381.40880) * DEGTORAD / 3600.0;/* */
931
+ } else if (prec_model == SEMOD_PREC_SIMON_1994) {
932
+ eps = (((((2.5e-8 * T -5.1e-7) * T +1.9989e-3) * T -1.52e-4) * T -46.80927) * T + 84381.412) * DEGTORAD / 3600.0;/* */
933
+ } else if (prec_model == SEMOD_PREC_WILLIAMS_1994) {
934
+ eps = ((((-1.0e-6 * T +2.0e-3) * T -1.74e-4) * T -46.833960) * T + 84381.409) * DEGTORAD / 3600.0;/* */
935
+ } else if (prec_model == SEMOD_PREC_LASKAR_1986 || prec_model == SEMOD_PREC_WILL_EPS_LASK) {
936
+ T /= 10.0;
937
+ eps = ((((((((( 2.45e-10*T + 5.79e-9)*T + 2.787e-7)*T
938
+ + 7.12e-7)*T - 3.905e-5)*T - 2.4967e-3)*T
939
+ - 5.138e-3)*T + 1.99925)*T - 0.0155)*T - 468.093)*T
940
+ + 84381.448;
941
+ eps *= DEGTORAD/3600.0;
942
+ } else if (prec_model == SEMOD_PREC_OWEN_1990) {
943
+ epsiln_owen_1986(J, &eps);
944
+ eps *= DEGTORAD;
945
+ //fprintf(stderr, "epso=%.17f\n", eps);
946
+ } else { /* SEMOD_PREC_VONDRAK_2011 */
947
+ swi_ldp_peps(J, NULL, &eps);
948
+ if ((iflag & SEFLG_JPLHOR_APPROX) && jplhora_model != SEMOD_JPLHORA_2) {
949
+ tofs = (J - DCOR_EPS_JPL_TJD0) / 365.25;
950
+ dofs = OFFSET_EPS_JPLHORIZONS;
951
+ if (tofs < 0) {
952
+ tofs = 0;
953
+ dofs = dcor_eps_jpl[0];
954
+ } else if (tofs >= NDCOR_EPS_JPL - 1) {
955
+ tofs = NDCOR_EPS_JPL;
956
+ dofs = dcor_eps_jpl[NDCOR_EPS_JPL - 1];
957
+ } else {
958
+ t0 = (int) tofs;
959
+ t1 = t0 + 1;
960
+ dofs = dcor_eps_jpl[(int)t0];
961
+ dofs = (tofs - t0) * (dcor_eps_jpl[(int)t0] - dcor_eps_jpl[(int)t1]) + dcor_eps_jpl[(int)t0];
962
+ }
963
+ dofs /= (1000.0 * 3600.0);
964
+ eps += dofs * DEGTORAD;
965
+ }
966
+ //fprintf(stderr, "epsv=%.17f\n", eps);
967
+ }
968
+ return(eps);
969
+ }
970
+
971
+ /* Precession of the equinox and ecliptic
972
+ * from epoch Julian date J to or from J2000.0
973
+ *
974
+ * Original program by Steve Moshier.
975
+ * Changes in program structure and implementation of IAU 2003 (P03) and
976
+ * Vondrak 2011 by Dieter Koch.
977
+ *
978
+ * SEMOD_PREC_VONDRAK_2011
979
+ * J. Vondrák, N. Capitaine, and P. Wallace, "New precession expressions,
980
+ * valid for long time intervals", A&A 534, A22 (2011)
981
+ *
982
+ * SEMOD_PREC_IAU_2006
983
+ * N. Capitaine, P.T. Wallace, and J. Chapront, "Expressions for IAU 2000
984
+ * precession quantities", 2003, A&A 412, 567-586 (2003).
985
+ * This is a "short" term model, that can be combined with other models
986
+ *
987
+ * SEMOD_PREC_WILLIAMS_1994
988
+ * James G. Williams, "Contributions to the Earth's obliquity rate,
989
+ * precession, and nutation," Astron. J. 108, 711-724 (1994).
990
+ *
991
+ * SEMOD_PREC_SIMON_1994
992
+ * J. L. Simon, P. Bretagnon, J. Chapront, M. Chapront-Touze', G. Francou,
993
+ * and J. Laskar, "Numerical Expressions for precession formulae and
994
+ * mean elements for the Moon and the planets," Astronomy and Astrophysics
995
+ * 282, 663-683 (1994).
996
+ *
997
+ * SEMOD_PREC_IAU_1976
998
+ * IAU Coefficients are from:
999
+ * J. H. Lieske, T. Lederle, W. Fricke, and B. Morando,
1000
+ * "Expressions for the Precession Quantities Based upon the IAU
1001
+ * (1976) System of Astronomical Constants," Astronomy and
1002
+ * Astrophysics 58, 1-16 (1977).
1003
+ * This is a "short" term model, that can be combined with other models
1004
+ *
1005
+ * SEMOD_PREC_LASKAR_1986
1006
+ * Newer formulas that cover a much longer time span are from:
1007
+ * J. Laskar, "Secular terms of classical planetary theories
1008
+ * using the results of general theory," Astronomy and Astrophysics
1009
+ * 157, 59070 (1986).
1010
+ *
1011
+ * See also:
1012
+ * P. Bretagnon and G. Francou, "Planetary theories in rectangular
1013
+ * and spherical variables. VSOP87 solutions," Astronomy and
1014
+ * Astrophysics 202, 309-315 (1988).
1015
+ *
1016
+ * Bretagnon and Francou's expansions for the node and inclination
1017
+ * of the ecliptic were derived from Laskar's data but were truncated
1018
+ * after the term in T**6. I have recomputed these expansions from
1019
+ * Laskar's data, retaining powers up to T**10 in the result.
1020
+ *
1021
+ */
1022
+
1023
+ static int precess_1(double *R, double J, int direction, int prec_method)
1024
+ {
1025
+ double T, Z = 0, z = 0, TH = 0;
1026
+ int i;
1027
+ double x[3];
1028
+ double sinth, costh, sinZ, cosZ, sinz, cosz, A, B;
1029
+ if( J == J2000 )
1030
+ return(0);
1031
+ T = (J - J2000)/36525.0;
1032
+ if (prec_method == SEMOD_PREC_IAU_1976) {
1033
+ Z = (( 0.017998*T + 0.30188)*T + 2306.2181)*T*DEGTORAD/3600;
1034
+ z = (( 0.018203*T + 1.09468)*T + 2306.2181)*T*DEGTORAD/3600;
1035
+ TH = ((-0.041833*T - 0.42665)*T + 2004.3109)*T*DEGTORAD/3600;
1036
+ /*
1037
+ * precession relative to ecliptic of start epoch is:
1038
+ * pn = (5029.0966 + 2.22226*T-0.000042*T*T) * t + (1.11161-0.000127*T) * t * t - 0.000113*t*t*t;
1039
+ * with: t = (tstart - tdate) / 36525.0
1040
+ * T = (tstart - J2000) / 36525.0
1041
+ */
1042
+ } else if (prec_method == SEMOD_PREC_IAU_2000) {
1043
+ /* AA 2006 B28:*/
1044
+ Z = (((((- 0.0000002*T - 0.0000327)*T + 0.0179663)*T + 0.3019015)*T + 2306.0809506)*T + 2.5976176)*DEGTORAD/3600;
1045
+ z = (((((- 0.0000003*T - 0.000047)*T + 0.0182237)*T + 1.0947790)*T + 2306.0803226)*T - 2.5976176)*DEGTORAD/3600;
1046
+ TH = ((((-0.0000001*T - 0.0000601)*T - 0.0418251)*T - 0.4269353)*T + 2004.1917476)*T*DEGTORAD/3600;
1047
+ } else if (prec_method == SEMOD_PREC_IAU_2006) {
1048
+ T = (J - J2000)/36525.0;
1049
+ Z = (((((- 0.0000003173*T - 0.000005971)*T + 0.01801828)*T + 0.2988499)*T + 2306.083227)*T + 2.650545)*DEGTORAD/3600;
1050
+ z = (((((- 0.0000002904*T - 0.000028596)*T + 0.01826837)*T + 1.0927348)*T + 2306.077181)*T - 2.650545)*DEGTORAD/3600;
1051
+ TH = ((((-0.00000011274*T - 0.000007089)*T - 0.04182264)*T - 0.4294934)*T + 2004.191903)*T*DEGTORAD/3600;
1052
+ } else if (prec_method == SEMOD_PREC_BRETAGNON_2003) {
1053
+ Z = ((((((-0.00000000013*T - 0.0000003040)*T - 0.000005708)*T + 0.01801752)*T + 0.3023262)*T + 2306.080472)*T + 2.72767)*DEGTORAD/3600;
1054
+ z = ((((((-0.00000000005*T - 0.0000002486)*T - 0.000028276)*T + 0.01826676)*T + 1.0956768)*T + 2306.076070)*T - 2.72767)*DEGTORAD/3600;
1055
+ TH = ((((((0.000000000009*T + 0.00000000036)*T -0.0000001127)*T - 0.000007291)*T - 0.04182364)*T - 0.4266980)*T + 2004.190936)*T*DEGTORAD/3600;
1056
+ #if 0
1057
+ } else if (prec_method == SEMOD_PREC_NEWCOMB) {
1058
+ double t1 = (J2000 - 2415020.3135) / 36524.2199;
1059
+ double T = (J - J2000) / 36524.2199;
1060
+ double T2 = T * T; double T3 = T2 * T;
1061
+ Z = (2304.250 + 1.396 * t1) * T + 0.302 * T2 + 0.0179 * T3;
1062
+ z = (2304.250 + 1.396 * t1) * T + 1.093 * T2 + 0.0192 * T3;
1063
+ TH =(2004.682 - 0.853 * t1) * T - 0.426 * T2 - 0.0416 * T3;
1064
+ Z *= (DEGTORAD/3600.0);
1065
+ z *= (DEGTORAD/3600.0);
1066
+ TH *= (DEGTORAD/3600.0);
1067
+ #endif
1068
+ #if 0
1069
+ // from Newcomb, "Compendium" (1906), pp. 245f., relative to 1850
1070
+ /* } else if (prec_method == SEMOD_PREC_NEWCOMB) {
1071
+ double cties = 36524.2198782; // trop. centuries
1072
+ double T = (J - B1850) / cties;
1073
+ double T2 = T * T; double T3 = T2 * T;
1074
+ double Z1 = 2303.56;
1075
+ Z = 2303.56 * T + 0.3023 * T2 + 0.018 * T3;
1076
+ z = 2303.55 * T + 1.094 * T2 + 0.018 * T3;
1077
+ TH = 2005.11 * T - 0.43 * T2 - 0.041 * T3;
1078
+ Z *= (DEGTORAD/3600.0);
1079
+ z *= (DEGTORAD/3600.0);
1080
+ TH *= (DEGTORAD/3600.0);
1081
+ */
1082
+ #endif
1083
+ #if 0
1084
+ // Newcomb from Expl. supp. 61 pg. 38
1085
+ // "Andoyar (Woolard and Clemence) expressions":
1086
+ } else if (prec_method == SEMOD_PREC_NEWCOMB) {
1087
+ double mills = 365242.198782; // trop. millennia
1088
+ double t1 = (J2000 - B1850) / mills;
1089
+ double t2 = (J - B1850) / mills;
1090
+ double T = t2 - t1;
1091
+ double T2 = T * T; double T3 = T2 * T;
1092
+ double Z1 = 23035.545 + 139.720 * t1 + 0.060 * t1 * t1;
1093
+ Z = Z1 * T + (30.240 - 0.270 * t1) * T2 + 17.995 * T3;
1094
+ z = Z1 * T + (109.480 - 0.390 * t1) * T2 + 18.325 * T3;
1095
+ TH = (20051.12 - 85.29 * t1 - 0.37 * t1 * t1) * T + (-42.65 - 0.37 * t1) * T2 - 41.80 * T3;
1096
+ Z *= (DEGTORAD/3600.0);
1097
+ z *= (DEGTORAD/3600.0);
1098
+ TH *= (DEGTORAD/3600.0);
1099
+ #endif
1100
+ #if 1
1101
+ // Newcomb according to Kinoshita 1975, very close to ExplSuppl/Andoyer;
1102
+ // one additional digit.
1103
+ } else if (prec_method == SEMOD_PREC_NEWCOMB) {
1104
+ double mills = 365242.198782; // trop. millennia
1105
+ double t1 = (J2000 - B1850) / mills;
1106
+ double t2 = (J - B1850) / mills;
1107
+ double T = t2 - t1;
1108
+ double T2 = T * T; double T3 = T2 * T;
1109
+ double Z1 = 23035.5548 + 139.720 * t1 + 0.069 * t1 * t1;
1110
+ Z = Z1 * T + (30.242 - 0.269 * t1) * T2 + 17.996 * T3;
1111
+ z = Z1 * T + (109.478 - 0.387 * t1) * T2 + 18.324 * T3;
1112
+ TH = (20051.125 - 85.294 * t1 - 0.365 * t1 * t1) * T + (-42.647 - 0.365 * t1) * T2 - 41.802 * T3;
1113
+ Z *= (DEGTORAD/3600.0);
1114
+ z *= (DEGTORAD/3600.0);
1115
+ TH *= (DEGTORAD/3600.0);
1116
+ #endif
1117
+ #if 0
1118
+ // from Lieske, "Expressions for the Precession Quantities..." (1967), p. 20
1119
+ } else if (prec_method == SEMOD_PREC_NEWCOMB) {
1120
+ double cties = 36524.2198782; // trop. centuries
1121
+ double t1 = (J2000 - J1900) / cties;
1122
+ double t2 = (J - J1900) / cties;
1123
+ double T = t2 - t1;
1124
+ double T2 = T * T; double T3 = T2 * T;
1125
+ double Z1 = 2304.253 + 1.3972 * t1 + 0.000125 * t1 * t1;
1126
+ Z = Z1 * T + (0.3023 - 0.000211 * t1) * T2 + 0.0180 * T3;
1127
+ z = Z1 * T + (1.0949 - 0.00046 * t1) * T2 + 0.0183 * T3;
1128
+ TH = (2004.684 - 0.8532 * t1 - 0.000317 * t1 * t1) * T + (-0.4266 - 0.00032 * t1) * T2 - 0.0418 * T3;
1129
+ Z *= (DEGTORAD/3600.0);
1130
+ z *= (DEGTORAD/3600.0);
1131
+ TH *= (DEGTORAD/3600.0);
1132
+ #endif
1133
+ } else {
1134
+ return 0;
1135
+ }
1136
+ sinth = sin(TH);
1137
+ costh = cos(TH);
1138
+ sinZ = sin(Z);
1139
+ cosZ = cos(Z);
1140
+ sinz = sin(z);
1141
+ cosz = cos(z);
1142
+ A = cosZ*costh;
1143
+ B = sinZ*costh;
1144
+ if( direction < 0 ) { /* From J2000.0 to J */
1145
+ x[0] = (A*cosz - sinZ*sinz)*R[0]
1146
+ - (B*cosz + cosZ*sinz)*R[1]
1147
+ - sinth*cosz*R[2];
1148
+ x[1] = (A*sinz + sinZ*cosz)*R[0]
1149
+ - (B*sinz - cosZ*cosz)*R[1]
1150
+ - sinth*sinz*R[2];
1151
+ x[2] = cosZ*sinth*R[0]
1152
+ - sinZ*sinth*R[1]
1153
+ + costh*R[2];
1154
+ } else { /* From J to J2000.0 */
1155
+ x[0] = (A*cosz - sinZ*sinz)*R[0]
1156
+ + (A*sinz + sinZ*cosz)*R[1]
1157
+ + cosZ*sinth*R[2];
1158
+ x[1] = - (B*cosz + cosZ*sinz)*R[0]
1159
+ - (B*sinz - cosZ*cosz)*R[1]
1160
+ - sinZ*sinth*R[2];
1161
+ x[2] = - sinth*cosz*R[0]
1162
+ - sinth*sinz*R[1]
1163
+ + costh*R[2];
1164
+ }
1165
+ for( i=0; i<3; i++ )
1166
+ R[i] = x[i];
1167
+ return(0);
1168
+ }
1169
+
1170
+ /* In WILLIAMS and SIMON, Laskar's terms of order higher than t^4
1171
+ have been retained, because Simon et al mention that the solution
1172
+ is the same except for the lower order terms. */
1173
+
1174
+ /* SEMOD_PREC_WILLIAMS_1994 */
1175
+ static const double pAcof_williams[] = {
1176
+ -8.66e-10, -4.759e-8, 2.424e-7, 1.3095e-5, 1.7451e-4, -1.8055e-3,
1177
+ -0.235316, 0.076, 110.5407, 50287.70000 };
1178
+ static const double nodecof_williams[] = {
1179
+ 6.6402e-16, -2.69151e-15, -1.547021e-12, 7.521313e-12, 1.9e-10,
1180
+ -3.54e-9, -1.8103e-7, 1.26e-7, 7.436169e-5,
1181
+ -0.04207794833, 3.052115282424};
1182
+ static const double inclcof_williams[] = {
1183
+ 1.2147e-16, 7.3759e-17, -8.26287e-14, 2.503410e-13, 2.4650839e-11,
1184
+ -5.4000441e-11, 1.32115526e-9, -6.012e-7, -1.62442e-5,
1185
+ 0.00227850649, 0.0 };
1186
+
1187
+ /* SEMOD_PREC_SIMON_1994 */
1188
+ /* Precession coefficients from Simon et al: */
1189
+ static const double pAcof_simon[] = {
1190
+ -8.66e-10, -4.759e-8, 2.424e-7, 1.3095e-5, 1.7451e-4, -1.8055e-3,
1191
+ -0.235316, 0.07732, 111.2022, 50288.200 };
1192
+ static const double nodecof_simon[] = {
1193
+ 6.6402e-16, -2.69151e-15, -1.547021e-12, 7.521313e-12, 1.9e-10,
1194
+ -3.54e-9, -1.8103e-7, 2.579e-8, 7.4379679e-5,
1195
+ -0.0420782900, 3.0521126906};
1196
+ static const double inclcof_simon[] = {
1197
+ 1.2147e-16, 7.3759e-17, -8.26287e-14, 2.503410e-13, 2.4650839e-11,
1198
+ -5.4000441e-11, 1.32115526e-9, -5.99908e-7, -1.624383e-5,
1199
+ 0.002278492868, 0.0 };
1200
+
1201
+ /* SEMOD_PREC_LASKAR_1986 */
1202
+ /* Precession coefficients taken from Laskar's paper: */
1203
+ static const double pAcof_laskar[] = {
1204
+ -8.66e-10, -4.759e-8, 2.424e-7, 1.3095e-5, 1.7451e-4, -1.8055e-3,
1205
+ -0.235316, 0.07732, 111.1971, 50290.966 };
1206
+ /* Node and inclination of the earth's orbit computed from
1207
+ * Laskar's data as done in Bretagnon and Francou's paper.
1208
+ * Units are radians.
1209
+ */
1210
+ static const double nodecof_laskar[] = {
1211
+ 6.6402e-16, -2.69151e-15, -1.547021e-12, 7.521313e-12, 6.3190131e-10,
1212
+ -3.48388152e-9, -1.813065896e-7, 2.75036225e-8, 7.4394531426e-5,
1213
+ -0.042078604317, 3.052112654975 };
1214
+ static const double inclcof_laskar[] = {
1215
+ 1.2147e-16, 7.3759e-17, -8.26287e-14, 2.503410e-13, 2.4650839e-11,
1216
+ -5.4000441e-11, 1.32115526e-9, -5.998737027e-7, -1.6242797091e-5,
1217
+ 0.002278495537, 0.0 };
1218
+
1219
+ static int precess_2(double *R, double J, int32 iflag, int direction, int prec_method)
1220
+ {
1221
+ int i;
1222
+ double T, z;
1223
+ double eps, sineps, coseps;
1224
+ double x[3];
1225
+ const double *p;
1226
+ double A, B, pA, W;
1227
+ const double *pAcof, *inclcof, *nodecof;
1228
+ if( J == J2000 )
1229
+ return(0);
1230
+ if (prec_method == SEMOD_PREC_LASKAR_1986) {
1231
+ pAcof = pAcof_laskar;
1232
+ nodecof = nodecof_laskar;
1233
+ inclcof = inclcof_laskar;
1234
+ } else if (prec_method == SEMOD_PREC_SIMON_1994) {
1235
+ pAcof = pAcof_simon;
1236
+ nodecof = nodecof_simon;
1237
+ inclcof = inclcof_simon;
1238
+ } else if (prec_method == SEMOD_PREC_WILLIAMS_1994) {
1239
+ pAcof = pAcof_williams;
1240
+ nodecof = nodecof_williams;
1241
+ inclcof = inclcof_williams;
1242
+ } else { /* default, to satisfy compiler */
1243
+ pAcof = pAcof_laskar;
1244
+ nodecof = nodecof_laskar;
1245
+ inclcof = inclcof_laskar;
1246
+ }
1247
+ T = (J - J2000)/36525.0;
1248
+ /* Implementation by elementary rotations using Laskar's expansions.
1249
+ * First rotate about the x axis from the initial equator
1250
+ * to the ecliptic. (The input is equatorial.)
1251
+ */
1252
+ if( direction == 1 )
1253
+ eps = swi_epsiln(J, iflag); /* To J2000 */
1254
+ else
1255
+ eps = swi_epsiln(J2000, iflag); /* From J2000 */
1256
+ sineps = sin(eps);
1257
+ coseps = cos(eps);
1258
+ x[0] = R[0];
1259
+ z = coseps*R[1] + sineps*R[2];
1260
+ x[2] = -sineps*R[1] + coseps*R[2];
1261
+ x[1] = z;
1262
+ /* Precession in longitude */
1263
+ T /= 10.0; /* thousands of years */
1264
+ p = pAcof;
1265
+ pA = *p++;
1266
+ for( i=0; i<9; i++ ) {
1267
+ pA = pA * T + *p++;
1268
+ }
1269
+ pA *= DEGTORAD/3600 * T;
1270
+ /* Node of the moving ecliptic on the J2000 ecliptic.
1271
+ */
1272
+ p = nodecof;
1273
+ W = *p++;
1274
+ for( i=0; i<10; i++ )
1275
+ W = W * T + *p++;
1276
+ /* Rotate about z axis to the node.
1277
+ */
1278
+ if( direction == 1 )
1279
+ z = W + pA;
1280
+ else
1281
+ z = W;
1282
+ B = cos(z);
1283
+ A = sin(z);
1284
+ z = B * x[0] + A * x[1];
1285
+ x[1] = -A * x[0] + B * x[1];
1286
+ x[0] = z;
1287
+ /* Rotate about new x axis by the inclination of the moving
1288
+ * ecliptic on the J2000 ecliptic.
1289
+ */
1290
+ p = inclcof;
1291
+ z = *p++;
1292
+ for( i=0; i<10; i++ )
1293
+ z = z * T + *p++;
1294
+ if( direction == 1 )
1295
+ z = -z;
1296
+ B = cos(z);
1297
+ A = sin(z);
1298
+ z = B * x[1] + A * x[2];
1299
+ x[2] = -A * x[1] + B * x[2];
1300
+ x[1] = z;
1301
+ /* Rotate about new z axis back from the node.
1302
+ */
1303
+ if( direction == 1 )
1304
+ z = -W;
1305
+ else
1306
+ z = -W - pA;
1307
+ B = cos(z);
1308
+ A = sin(z);
1309
+ z = B * x[0] + A * x[1];
1310
+ x[1] = -A * x[0] + B * x[1];
1311
+ x[0] = z;
1312
+ /* Rotate about x axis to final equator.
1313
+ */
1314
+ if( direction == 1 )
1315
+ eps = swi_epsiln(J2000, iflag);
1316
+ else
1317
+ eps = swi_epsiln(J, iflag);
1318
+ sineps = sin(eps);
1319
+ coseps = cos(eps);
1320
+ z = coseps * x[1] - sineps * x[2];
1321
+ x[2] = sineps * x[1] + coseps * x[2];
1322
+ x[1] = z;
1323
+ for( i=0; i<3; i++ )
1324
+ R[i] = x[i];
1325
+ return(0);
1326
+ }
1327
+
1328
+ static int precess_3(double *R, double J, int direction, int iflag, int prec_meth)
1329
+ {
1330
+ //double T;
1331
+ double x[3], pmat[9];
1332
+ int i, j;
1333
+ if( J == J2000 )
1334
+ return(0);
1335
+ /* Each precession angle is specified by a polynomial in
1336
+ * T = Julian centuries from J2000.0. See AA page B18.
1337
+ */
1338
+ //T = (J - J2000)/36525.0;
1339
+ if (prec_meth == SEMOD_PREC_OWEN_1990)
1340
+ owen_pre_matrix(J, pmat, iflag);
1341
+ else
1342
+ pre_pmat(J, pmat);
1343
+ if (direction == -1) {
1344
+ for (i = 0, j = 0; i <= 2; i++, j = i * 3) {
1345
+ x[i] = R[0] * pmat[j + 0] +
1346
+ R[1] * pmat[j + 1] +
1347
+ R[2] * pmat[j + 2];
1348
+ }
1349
+ } else {
1350
+ for (i = 0, j = 0; i <= 2; i++, j = i * 3) {
1351
+ x[i] = R[0] * pmat[i + 0] +
1352
+ R[1] * pmat[i + 3] +
1353
+ R[2] * pmat[i + 6];
1354
+ }
1355
+ }
1356
+ for (i = 0; i < 3; i++)
1357
+ R[i] = x[i];
1358
+ return(0);
1359
+ }
1360
+
1361
+ /* Subroutine arguments:
1362
+ *
1363
+ * R = rectangular equatorial coordinate vector to be precessed.
1364
+ * The result is written back into the input vector.
1365
+ * J = Julian date
1366
+ * direction =
1367
+ * Precess from J to J2000: direction = 1
1368
+ * Precess from J2000 to J: direction = -1
1369
+ * Note that if you want to precess from J1 to J2, you would
1370
+ * first go from J1 to J2000, then call the program again
1371
+ * to go from J2000 to J2.
1372
+ */
1373
+ int swi_precess(double *R, double J, int32 iflag, int direction )
1374
+ {
1375
+ double T = (J - J2000)/36525.0;
1376
+ int prec_model = swed.astro_models[SE_MODEL_PREC_LONGTERM];
1377
+ int prec_model_short = swed.astro_models[SE_MODEL_PREC_SHORTTERM];
1378
+ int jplhora_model = swed.astro_models[SE_MODEL_JPLHORA_MODE];
1379
+ AS_BOOL is_jplhor = FALSE;
1380
+ if (prec_model == 0) prec_model = SEMOD_PREC_DEFAULT;
1381
+ if (prec_model_short == 0) prec_model_short = SEMOD_PREC_DEFAULT_SHORT;
1382
+ if (jplhora_model == 0) jplhora_model = SEMOD_JPLHORA_DEFAULT;
1383
+ if (iflag & SEFLG_JPLHOR)
1384
+ is_jplhor = TRUE;
1385
+ if ((iflag & SEFLG_JPLHOR_APPROX)
1386
+ && jplhora_model == SEMOD_JPLHORA_3
1387
+ && J <= HORIZONS_TJD0_DPSI_DEPS_IAU1980)
1388
+ is_jplhor = TRUE;
1389
+ /* JPL Horizons uses precession IAU 1976 and nutation IAU 1980 plus
1390
+ * some correction to nutation, arriving at extremely high precision */
1391
+ if (is_jplhor) {
1392
+ if (J > 2378131.5 && J < 2525323.5) { // between 1.1.1799 and 1.1.2202
1393
+ return precess_1(R, J, direction, SEMOD_PREC_IAU_1976);
1394
+ } else {
1395
+ return precess_3(R, J, direction, iflag, SEMOD_PREC_OWEN_1990);
1396
+ }
1397
+ /* Use IAU 1976 formula for a few centuries. */
1398
+ } else if (prec_model_short == SEMOD_PREC_IAU_1976 && fabs(T) <= PREC_IAU_1976_CTIES) {
1399
+ return precess_1(R, J, direction, SEMOD_PREC_IAU_1976);
1400
+ } else if (prec_model == SEMOD_PREC_IAU_1976) {
1401
+ return precess_1(R, J, direction, SEMOD_PREC_IAU_1976);
1402
+ /* Use IAU 2000 formula for a few centuries. */
1403
+ } else if (prec_model_short == SEMOD_PREC_IAU_2000 && fabs(T) <= PREC_IAU_2000_CTIES) {
1404
+ return precess_1(R, J, direction, SEMOD_PREC_IAU_2000);
1405
+ } else if (prec_model == SEMOD_PREC_IAU_2000) {
1406
+ return precess_1(R, J, direction, SEMOD_PREC_IAU_2000);
1407
+ /* Use IAU 2006 formula for a few centuries. */
1408
+ } else if (prec_model_short == SEMOD_PREC_IAU_2006 && fabs(T) <= PREC_IAU_2006_CTIES) {
1409
+ return precess_1(R, J, direction, SEMOD_PREC_IAU_2006);
1410
+ } else if (prec_model == SEMOD_PREC_IAU_2006) {
1411
+ return precess_1(R, J, direction, SEMOD_PREC_IAU_2006);
1412
+ } else if (prec_model == SEMOD_PREC_BRETAGNON_2003) {
1413
+ return precess_1(R, J, direction, SEMOD_PREC_BRETAGNON_2003);
1414
+ } else if (prec_model == SEMOD_PREC_NEWCOMB) {
1415
+ return precess_1(R, J, direction, SEMOD_PREC_NEWCOMB);
1416
+ } else if (prec_model == SEMOD_PREC_LASKAR_1986) {
1417
+ return precess_2(R, J, iflag, direction, SEMOD_PREC_LASKAR_1986);
1418
+ } else if (prec_model == SEMOD_PREC_SIMON_1994) {
1419
+ return precess_2(R, J, iflag, direction, SEMOD_PREC_SIMON_1994);
1420
+ } else if (prec_model == SEMOD_PREC_WILLIAMS_1994 || prec_model == SEMOD_PREC_WILL_EPS_LASK) {
1421
+ return precess_2(R, J, iflag, direction, SEMOD_PREC_WILLIAMS_1994);
1422
+ } else if (prec_model == SEMOD_PREC_OWEN_1990) {
1423
+ return precess_3(R, J, direction, iflag, SEMOD_PREC_OWEN_1990);
1424
+ } else { /* SEMOD_PREC_VONDRAK_2011 */
1425
+ //int i;
1426
+ //int retval = precess_3(R, J, direction, iflag, SEMOD_PREC_VONDRAK_2011);
1427
+ // for (i = 0; i < 3; i++) printf("%.9f, ", R[i]);
1428
+ return precess_3(R, J, direction, iflag, SEMOD_PREC_VONDRAK_2011);
1429
+ }
1430
+ }
1431
+
1432
+ /* Nutation in longitude and obliquity
1433
+ * computed at Julian date J.
1434
+ *
1435
+ * References:
1436
+ * "Summary of 1980 IAU Theory of Nutation (Final Report of the
1437
+ * IAU Working Group on Nutation)", P. K. Seidelmann et al., in
1438
+ * Transactions of the IAU Vol. XVIII A, Reports on Astronomy,
1439
+ * P. A. Wayman, ed.; D. Reidel Pub. Co., 1982.
1440
+ *
1441
+ * "Nutation and the Earth's Rotation",
1442
+ * I.A.U. Symposium No. 78, May, 1977, page 256.
1443
+ * I.A.U., 1980.
1444
+ *
1445
+ * Woolard, E.W., "A redevelopment of the theory of nutation",
1446
+ * The Astronomical Journal, 58, 1-3 (1953).
1447
+ *
1448
+ * This program implements all of the 1980 IAU nutation series.
1449
+ * Results checked at 100 points against the 1986 AA; all agreed.
1450
+ *
1451
+ *
1452
+ * - S. L. Moshier, November 1987
1453
+ * October, 1992 - typo fixed in nutation matrix
1454
+ *
1455
+ * - D. Koch, November 1995: small changes in structure,
1456
+ * Corrections to IAU 1980 Series added from Expl. Suppl. p. 116
1457
+ *
1458
+ * Each term in the expansion has a trigonometric
1459
+ * argument given by
1460
+ * W = i*MM + j*MS + k*FF + l*DD + m*OM
1461
+ * where the variables are defined below.
1462
+ * The nutation in longitude is a sum of terms of the
1463
+ * form (a + bT) * sin(W). The terms for nutation in obliquity
1464
+ * are of the form (c + dT) * cos(W). The coefficients
1465
+ * are arranged in the tabulation as follows:
1466
+ *
1467
+ * Coefficient:
1468
+ * i j k l m a b c d
1469
+ * 0, 0, 0, 0, 1, -171996, -1742, 92025, 89,
1470
+ * The first line of the table, above, is done separately
1471
+ * since two of the values do not fit into 16 bit integers.
1472
+ * The values a and c are arc seconds times 10000. b and d
1473
+ * are arc seconds per Julian century times 100000. i through m
1474
+ * are integers. See the program for interpretation of MM, MS,
1475
+ * etc., which are mean orbital elements of the Sun and Moon.
1476
+ *
1477
+ * If terms with coefficient less than X are omitted, the peak
1478
+ * errors will be:
1479
+ *
1480
+ * omit error, omit error,
1481
+ * a < longitude c < obliquity
1482
+ * .0005" .0100" .0008" .0094"
1483
+ * .0046 .0492 .0095 .0481
1484
+ * .0123 .0880 .0224 .0905
1485
+ * .0386 .1808 .0895 .1129
1486
+ */
1487
+ static const short nt[] = {
1488
+ /* LS and OC are units of 0.0001"
1489
+ *LS2 and OC2 are units of 0.00001"
1490
+ *MM,MS,FF,DD,OM, LS, LS2,OC, OC2 */
1491
+ 0, 0, 0, 0, 2, 2062, 2, -895, 5,
1492
+ -2, 0, 2, 0, 1, 46, 0, -24, 0,
1493
+ 2, 0,-2, 0, 0, 11, 0, 0, 0,
1494
+ -2, 0, 2, 0, 2, -3, 0, 1, 0,
1495
+ 1,-1, 0,-1, 0, -3, 0, 0, 0,
1496
+ 0,-2, 2,-2, 1, -2, 0, 1, 0,
1497
+ 2, 0,-2, 0, 1, 1, 0, 0, 0,
1498
+ 0, 0, 2,-2, 2,-13187,-16, 5736,-31,
1499
+ 0, 1, 0, 0, 0, 1426,-34, 54, -1,
1500
+ 0, 1, 2,-2, 2, -517, 12, 224, -6,
1501
+ 0,-1, 2,-2, 2, 217, -5, -95, 3,
1502
+ 0, 0, 2,-2, 1, 129, 1, -70, 0,
1503
+ 2, 0, 0,-2, 0, 48, 0, 1, 0,
1504
+ 0, 0, 2,-2, 0, -22, 0, 0, 0,
1505
+ 0, 2, 0, 0, 0, 17, -1, 0, 0,
1506
+ 0, 1, 0, 0, 1, -15, 0, 9, 0,
1507
+ 0, 2, 2,-2, 2, -16, 1, 7, 0,
1508
+ 0,-1, 0, 0, 1, -12, 0, 6, 0,
1509
+ -2, 0, 0, 2, 1, -6, 0, 3, 0,
1510
+ 0,-1, 2,-2, 1, -5, 0, 3, 0,
1511
+ 2, 0, 0,-2, 1, 4, 0, -2, 0,
1512
+ 0, 1, 2,-2, 1, 4, 0, -2, 0,
1513
+ 1, 0, 0,-1, 0, -4, 0, 0, 0,
1514
+ 2, 1, 0,-2, 0, 1, 0, 0, 0,
1515
+ 0, 0,-2, 2, 1, 1, 0, 0, 0,
1516
+ 0, 1,-2, 2, 0, -1, 0, 0, 0,
1517
+ 0, 1, 0, 0, 2, 1, 0, 0, 0,
1518
+ -1, 0, 0, 1, 1, 1, 0, 0, 0,
1519
+ 0, 1, 2,-2, 0, -1, 0, 0, 0,
1520
+ 0, 0, 2, 0, 2, -2274, -2, 977, -5,
1521
+ 1, 0, 0, 0, 0, 712, 1, -7, 0,
1522
+ 0, 0, 2, 0, 1, -386, -4, 200, 0,
1523
+ 1, 0, 2, 0, 2, -301, 0, 129, -1,
1524
+ 1, 0, 0,-2, 0, -158, 0, -1, 0,
1525
+ -1, 0, 2, 0, 2, 123, 0, -53, 0,
1526
+ 0, 0, 0, 2, 0, 63, 0, -2, 0,
1527
+ 1, 0, 0, 0, 1, 63, 1, -33, 0,
1528
+ -1, 0, 0, 0, 1, -58, -1, 32, 0,
1529
+ -1, 0, 2, 2, 2, -59, 0, 26, 0,
1530
+ 1, 0, 2, 0, 1, -51, 0, 27, 0,
1531
+ 0, 0, 2, 2, 2, -38, 0, 16, 0,
1532
+ 2, 0, 0, 0, 0, 29, 0, -1, 0,
1533
+ 1, 0, 2,-2, 2, 29, 0, -12, 0,
1534
+ 2, 0, 2, 0, 2, -31, 0, 13, 0,
1535
+ 0, 0, 2, 0, 0, 26, 0, -1, 0,
1536
+ -1, 0, 2, 0, 1, 21, 0, -10, 0,
1537
+ -1, 0, 0, 2, 1, 16, 0, -8, 0,
1538
+ 1, 0, 0,-2, 1, -13, 0, 7, 0,
1539
+ -1, 0, 2, 2, 1, -10, 0, 5, 0,
1540
+ 1, 1, 0,-2, 0, -7, 0, 0, 0,
1541
+ 0, 1, 2, 0, 2, 7, 0, -3, 0,
1542
+ 0,-1, 2, 0, 2, -7, 0, 3, 0,
1543
+ 1, 0, 2, 2, 2, -8, 0, 3, 0,
1544
+ 1, 0, 0, 2, 0, 6, 0, 0, 0,
1545
+ 2, 0, 2,-2, 2, 6, 0, -3, 0,
1546
+ 0, 0, 0, 2, 1, -6, 0, 3, 0,
1547
+ 0, 0, 2, 2, 1, -7, 0, 3, 0,
1548
+ 1, 0, 2,-2, 1, 6, 0, -3, 0,
1549
+ 0, 0, 0,-2, 1, -5, 0, 3, 0,
1550
+ 1,-1, 0, 0, 0, 5, 0, 0, 0,
1551
+ 2, 0, 2, 0, 1, -5, 0, 3, 0,
1552
+ 0, 1, 0,-2, 0, -4, 0, 0, 0,
1553
+ 1, 0,-2, 0, 0, 4, 0, 0, 0,
1554
+ 0, 0, 0, 1, 0, -4, 0, 0, 0,
1555
+ 1, 1, 0, 0, 0, -3, 0, 0, 0,
1556
+ 1, 0, 2, 0, 0, 3, 0, 0, 0,
1557
+ 1,-1, 2, 0, 2, -3, 0, 1, 0,
1558
+ -1,-1, 2, 2, 2, -3, 0, 1, 0,
1559
+ -2, 0, 0, 0, 1, -2, 0, 1, 0,
1560
+ 3, 0, 2, 0, 2, -3, 0, 1, 0,
1561
+ 0,-1, 2, 2, 2, -3, 0, 1, 0,
1562
+ 1, 1, 2, 0, 2, 2, 0, -1, 0,
1563
+ -1, 0, 2,-2, 1, -2, 0, 1, 0,
1564
+ 2, 0, 0, 0, 1, 2, 0, -1, 0,
1565
+ 1, 0, 0, 0, 2, -2, 0, 1, 0,
1566
+ 3, 0, 0, 0, 0, 2, 0, 0, 0,
1567
+ 0, 0, 2, 1, 2, 2, 0, -1, 0,
1568
+ -1, 0, 0, 0, 2, 1, 0, -1, 0,
1569
+
1570
+ 1, 0, 0,-4, 0, -1, 0, 0, 0,
1571
+ -2, 0, 2, 2, 2, 1, 0, -1, 0,
1572
+ -1, 0, 2, 4, 2, -2, 0, 1, 0,
1573
+ 2, 0, 0,-4, 0, -1, 0, 0, 0,
1574
+ 1, 1, 2,-2, 2, 1, 0, -1, 0,
1575
+ 1, 0, 2, 2, 1, -1, 0, 1, 0,
1576
+ -2, 0, 2, 4, 2, -1, 0, 1, 0,
1577
+ -1, 0, 4, 0, 2, 1, 0, 0, 0,
1578
+ 1,-1, 0,-2, 0, 1, 0, 0, 0,
1579
+ 2, 0, 2,-2, 1, 1, 0, -1, 0,
1580
+ 2, 0, 2, 2, 2, -1, 0, 0, 0,
1581
+ 1, 0, 0, 2, 1, -1, 0, 0, 0,
1582
+ 0, 0, 4,-2, 2, 1, 0, 0, 0,
1583
+ 3, 0, 2,-2, 2, 1, 0, 0, 0,
1584
+ 1, 0, 2,-2, 0, -1, 0, 0, 0,
1585
+ 0, 1, 2, 0, 1, 1, 0, 0, 0,
1586
+ -1,-1, 0, 2, 1, 1, 0, 0, 0,
1587
+ 0, 0,-2, 0, 1, -1, 0, 0, 0,
1588
+ 0, 0, 2,-1, 2, -1, 0, 0, 0,
1589
+ 0, 1, 0, 2, 0, -1, 0, 0, 0,
1590
+ 1, 0,-2,-2, 0, -1, 0, 0, 0,
1591
+ 0,-1, 2, 0, 1, -1, 0, 0, 0,
1592
+ 1, 1, 0,-2, 1, -1, 0, 0, 0,
1593
+ 1, 0,-2, 2, 0, -1, 0, 0, 0,
1594
+ 2, 0, 0, 2, 0, 1, 0, 0, 0,
1595
+ 0, 0, 2, 4, 2, -1, 0, 0, 0,
1596
+ 0, 1, 0, 1, 0, 1, 0, 0, 0,
1597
+ #if 1
1598
+ /*#if NUT_CORR_1987 switch is handled in function calc_nutation_iau1980() */
1599
+ /* corrections to IAU 1980 nutation series by Herring 1987
1600
+ * in 0.00001" !!!
1601
+ * LS OC */
1602
+ 101, 0, 0, 0, 1,-725, 0, 213, 0,
1603
+ 101, 1, 0, 0, 0, 523, 0, 208, 0,
1604
+ 101, 0, 2,-2, 2, 102, 0, -41, 0,
1605
+ 101, 0, 2, 0, 2, -81, 0, 32, 0,
1606
+ /* LC OS !!! */
1607
+ 102, 0, 0, 0, 1, 417, 0, 224, 0,
1608
+ 102, 1, 0, 0, 0, 61, 0, -24, 0,
1609
+ 102, 0, 2,-2, 2,-118, 0, -47, 0,
1610
+ /*#endif*/
1611
+ #endif
1612
+ ENDMARK,
1613
+ };
1614
+
1615
+ static int calc_nutation_iau1980(double J, double *nutlo)
1616
+ {
1617
+ /* arrays to hold sines and cosines of multiple angles */
1618
+ double ss[5][8];
1619
+ double cc[5][8];
1620
+ double arg;
1621
+ double args[5];
1622
+ double f, g, T, T2;
1623
+ double MM, MS, FF, DD, OM;
1624
+ double cu, su, cv, sv, sw, s;
1625
+ double C, D;
1626
+ int i, j, k, k1, m, n;
1627
+ int ns[5];
1628
+ const short *p;
1629
+ int nut_model = swed.astro_models[SE_MODEL_NUT];
1630
+ if (nut_model == 0) nut_model = SEMOD_NUT_DEFAULT;
1631
+ /* Julian centuries from 2000 January 1.5,
1632
+ * barycentric dynamical time
1633
+ */
1634
+ T = (J - 2451545.0) / 36525.0;
1635
+ T2 = T * T;
1636
+ /* Fundamental arguments in the FK5 reference system.
1637
+ * The coefficients, originally given to 0.001",
1638
+ * are converted here to degrees.
1639
+ */
1640
+ /* longitude of the mean ascending node of the lunar orbit
1641
+ * on the ecliptic, measured from the mean equinox of date
1642
+ */
1643
+ OM = -6962890.539 * T + 450160.280 + (0.008 * T + 7.455) * T2;
1644
+ OM = swe_degnorm(OM/3600) * DEGTORAD;
1645
+ /* mean longitude of the Sun minus the
1646
+ * mean longitude of the Sun's perigee
1647
+ */
1648
+ MS = 129596581.224 * T + 1287099.804 - (0.012 * T + 0.577) * T2;
1649
+ MS = swe_degnorm(MS/3600) * DEGTORAD;
1650
+ /* mean longitude of the Moon minus the
1651
+ * mean longitude of the Moon's perigee
1652
+ */
1653
+ MM = 1717915922.633 * T + 485866.733 + (0.064 * T + 31.310) * T2;
1654
+ MM = swe_degnorm(MM/3600) * DEGTORAD;
1655
+ /* mean longitude of the Moon minus the
1656
+ * mean longitude of the Moon's node
1657
+ */
1658
+ FF = 1739527263.137 * T + 335778.877 + (0.011 * T - 13.257) * T2;
1659
+ FF = swe_degnorm(FF/3600) * DEGTORAD;
1660
+ /* mean elongation of the Moon from the Sun.
1661
+ */
1662
+ DD = 1602961601.328 * T + 1072261.307 + (0.019 * T - 6.891) * T2;
1663
+ DD = swe_degnorm(DD/3600) * DEGTORAD;
1664
+ args[0] = MM;
1665
+ ns[0] = 3;
1666
+ args[1] = MS;
1667
+ ns[1] = 2;
1668
+ args[2] = FF;
1669
+ ns[2] = 4;
1670
+ args[3] = DD;
1671
+ ns[3] = 4;
1672
+ args[4] = OM;
1673
+ ns[4] = 2;
1674
+ /* Calculate sin( i*MM ), etc. for needed multiple angles
1675
+ */
1676
+ for (k = 0; k <= 4; k++) {
1677
+ arg = args[k];
1678
+ n = ns[k];
1679
+ su = sin(arg);
1680
+ cu = cos(arg);
1681
+ ss[k][0] = su; /* sin(L) */
1682
+ cc[k][0] = cu; /* cos(L) */
1683
+ sv = 2.0*su*cu;
1684
+ cv = cu*cu - su*su;
1685
+ ss[k][1] = sv; /* sin(2L) */
1686
+ cc[k][1] = cv;
1687
+ for( i=2; i<n; i++ ) {
1688
+ s = su*cv + cu*sv;
1689
+ cv = cu*cv - su*sv;
1690
+ sv = s;
1691
+ ss[k][i] = sv; /* sin( i+1 L ) */
1692
+ cc[k][i] = cv;
1693
+ }
1694
+ }
1695
+ /* first terms, not in table: */
1696
+ C = (-0.01742*T - 17.1996)*ss[4][0]; /* sin(OM) */
1697
+ D = ( 0.00089*T + 9.2025)*cc[4][0]; /* cos(OM) */
1698
+ for(p = &nt[0]; *p != ENDMARK; p += 9) {
1699
+ if (nut_model != SEMOD_NUT_IAU_CORR_1987 && (p[0] == 101 || p[0] == 102))
1700
+ continue;
1701
+ /* argument of sine and cosine */
1702
+ k1 = 0;
1703
+ cv = 0.0;
1704
+ sv = 0.0;
1705
+ for( m=0; m<5; m++ ) {
1706
+ j = p[m];
1707
+ if (j > 100)
1708
+ j = 0; /* p[0] is a flag */
1709
+ if( j ) {
1710
+ k = j;
1711
+ if( j < 0 )
1712
+ k = -k;
1713
+ su = ss[m][k-1]; /* sin(k*angle) */
1714
+ if( j < 0 )
1715
+ su = -su;
1716
+ cu = cc[m][k-1];
1717
+ if( k1 == 0 ) { /* set first angle */
1718
+ sv = su;
1719
+ cv = cu;
1720
+ k1 = 1;
1721
+ }
1722
+ else { /* combine angles */
1723
+ sw = su*cv + cu*sv;
1724
+ cv = cu*cv - su*sv;
1725
+ sv = sw;
1726
+ }
1727
+ }
1728
+ }
1729
+ /* longitude coefficient, in 0.0001" */
1730
+ f = p[5] * 0.0001;
1731
+ if( p[6] != 0 )
1732
+ f += 0.00001 * T * p[6];
1733
+ /* obliquity coefficient, in 0.0001" */
1734
+ g = p[7] * 0.0001;
1735
+ if( p[8] != 0 )
1736
+ g += 0.00001 * T * p[8];
1737
+ if (*p >= 100) { /* coefficients in 0.00001" */
1738
+ f *= 0.1;
1739
+ g *= 0.1;
1740
+ }
1741
+ /* accumulate the terms */
1742
+ if (*p != 102) {
1743
+ C += f * sv;
1744
+ D += g * cv;
1745
+ }
1746
+ else { /* cos for nutl and sin for nuto */
1747
+ C += f * cv;
1748
+ D += g * sv;
1749
+ }
1750
+ /*
1751
+ if (i >= 105) {
1752
+ printf("%4.10f, %4.10f\n",f*sv,g*cv);
1753
+ }
1754
+ */
1755
+ }
1756
+ /*
1757
+ printf("%4.10f, %4.10f, %4.10f, %4.10f\n",MS*RADTODEG,FF*RADTODEG,DD*RADTODEG,OM*RADTODEG);
1758
+ printf( "nutation: in longitude %.9f\", in obliquity %.9f\"\n", C, D );
1759
+ */
1760
+ /* Save answers, expressed in radians */
1761
+ nutlo[0] = DEGTORAD * C / 3600.0;
1762
+ nutlo[1] = DEGTORAD * D / 3600.0;
1763
+ return(0);
1764
+ }
1765
+
1766
+ /* Nutation IAU 2000A model
1767
+ * (MHB2000 luni-solar and planetary nutation, without free core nutation)
1768
+ *
1769
+ * Function returns nutation in longitude and obliquity in radians with
1770
+ * respect to the equinox of date. For the obliquity of the ecliptic
1771
+ * the calculation of Lieske & al. (1977) must be used.
1772
+ *
1773
+ * The precision in recent years is about 0.001 arc seconds.
1774
+ *
1775
+ * The calculation includes luni-solar and planetary nutation.
1776
+ * Free core nutation, which cannot be predicted, is omitted,
1777
+ * the error being of the order of a few 0.0001 arc seconds.
1778
+ *
1779
+ * References:
1780
+ *
1781
+ * Capitaine, N., Wallace, P.T., Chapront, J., A & A 432, 366 (2005).
1782
+ *
1783
+ * Chapront, J., Chapront-Touze, M. & Francou, G., A & A 387, 700 (2002).
1784
+ *
1785
+ * Lieske, J.H., Lederle, T., Fricke, W. & Morando, B., "Expressions
1786
+ * for the precession quantities based upon the IAU (1976) System of
1787
+ * Astronomical Constants", A & A 58, 1-16 (1977).
1788
+ *
1789
+ * Mathews, P.M., Herring, T.A., Buffet, B.A., "Modeling of nutation
1790
+ * and precession New nutation series for nonrigid Earth and
1791
+ * insights into the Earth's interior", J.Geophys.Res., 107, B4,
1792
+ * 2002.
1793
+ *
1794
+ * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
1795
+ * Francou, G., Laskar, J., A & A 282, 663-683 (1994).
1796
+ *
1797
+ * Souchay, J., Loysel, B., Kinoshita, H., Folgueira, M., A & A Supp.
1798
+ * Ser. 135, 111 (1999).
1799
+ *
1800
+ * Wallace, P.T., "Software for Implementing the IAU 2000
1801
+ * Resolutions", in IERS Workshop 5.1 (2002).
1802
+ *
1803
+ * Nutation IAU 2000A series in:
1804
+ * Kaplan, G.H., United States Naval Observatory Circular No. 179 (Oct. 2005)
1805
+ * aa.usno.navy.mil/publications/docs/Circular_179.html
1806
+ *
1807
+ * MHB2000 code at
1808
+ * - ftp://maia.usno.navy.mil/conv2000/chapter5/IAU2000A.
1809
+ * - http://www.iau-sofa.rl.ac.uk/2005_0901/Downloads.html
1810
+ */
1811
+
1812
+ #include "swenut2000a.h"
1813
+ static int calc_nutation_iau2000ab(double J, double *nutlo)
1814
+ {
1815
+ int i, j, k, inls;
1816
+ double M, SM, F, D, OM;
1817
+ double AL, ALSU, AF, AD, AOM, APA;
1818
+ double ALME, ALVE, ALEA, ALMA, ALJU, ALSA, ALUR, ALNE;
1819
+ double darg, sinarg, cosarg;
1820
+ double dpsi = 0, deps = 0;
1821
+ double T = (J - J2000 ) / 36525.0;
1822
+ int nut_model = swed.astro_models[SE_MODEL_NUT];
1823
+ if (nut_model == 0) nut_model = SEMOD_NUT_DEFAULT;
1824
+ /* luni-solar nutation */
1825
+ /* Fundamental arguments, Simon & al. (1994) */
1826
+ /* Mean anomaly of the Moon. */
1827
+ M = swe_degnorm(( 485868.249036 +
1828
+ T*( 1717915923.2178 +
1829
+ T*( 31.8792 +
1830
+ T*( 0.051635 +
1831
+ T*( - 0.00024470 ))))) / 3600.0) * DEGTORAD;
1832
+ /* Mean anomaly of the Sun */
1833
+ SM = swe_degnorm((1287104.79305 +
1834
+ T*( 129596581.0481 +
1835
+ T*( - 0.5532 +
1836
+ T*( 0.000136 +
1837
+ T*( - 0.00001149 ))))) / 3600.0) * DEGTORAD;
1838
+ /* Mean argument of the latitude of the Moon. */
1839
+ F = swe_degnorm(( 335779.526232 +
1840
+ T*( 1739527262.8478 +
1841
+ T*( - 12.7512 +
1842
+ T*( - 0.001037 +
1843
+ T*( 0.00000417 ))))) / 3600.0) * DEGTORAD;
1844
+ /* Mean elongation of the Moon from the Sun. */
1845
+ D = swe_degnorm((1072260.70369 +
1846
+ T*( 1602961601.2090 +
1847
+ T*( - 6.3706 +
1848
+ T*( 0.006593 +
1849
+ T*( - 0.00003169 ))))) / 3600.0) * DEGTORAD;
1850
+ /* Mean longitude of the ascending node of the Moon. */
1851
+ OM = swe_degnorm(( 450160.398036 +
1852
+ T*( - 6962890.5431 +
1853
+ T*( 7.4722 +
1854
+ T*( 0.007702 +
1855
+ T*( - 0.00005939 ))))) / 3600.0) * DEGTORAD;
1856
+ /* luni-solar nutation series, in reverse order, starting with small terms */
1857
+ if (nut_model == SEMOD_NUT_IAU_2000B)
1858
+ inls = NLS_2000B;
1859
+ else
1860
+ inls = NLS;
1861
+ for (i = inls - 1; i >= 0; i--) {
1862
+ j = i * 5;
1863
+ darg = swe_radnorm((double) nls[j + 0] * M +
1864
+ (double) nls[j + 1] * SM +
1865
+ (double) nls[j + 2] * F +
1866
+ (double) nls[j + 3] * D +
1867
+ (double) nls[j + 4] * OM);
1868
+ sinarg = sin(darg);
1869
+ cosarg = cos(darg);
1870
+ k = i * 6;
1871
+ dpsi += (cls[k+0] + cls[k+1] * T) * sinarg + cls[k+2] * cosarg;
1872
+ deps += (cls[k+3] + cls[k+4] * T) * cosarg + cls[k+5] * sinarg;
1873
+ }
1874
+ nutlo[0] = dpsi * O1MAS2DEG;
1875
+ nutlo[1] = deps * O1MAS2DEG;
1876
+ if (nut_model == SEMOD_NUT_IAU_2000A) {
1877
+ /* planetary nutation
1878
+ * note: The MHB2000 code computes the luni-solar and planetary nutation
1879
+ * in different routines, using slightly different Delaunay
1880
+ * arguments in the two cases. This behaviour is faithfully
1881
+ * reproduced here. Use of the Simon et al. expressions for both
1882
+ * cases leads to negligible changes, well below 0.1 microarcsecond.*/
1883
+ /* Mean anomaly of the Moon.*/
1884
+ AL = swe_radnorm(2.35555598 + 8328.6914269554 * T);
1885
+ /* Mean anomaly of the Sun.*/
1886
+ ALSU = swe_radnorm(6.24006013 + 628.301955 * T);
1887
+ /* Mean argument of the latitude of the Moon. */
1888
+ AF = swe_radnorm(1.627905234 + 8433.466158131 * T);
1889
+ /* Mean elongation of the Moon from the Sun. */
1890
+ AD = swe_radnorm(5.198466741 + 7771.3771468121 * T);
1891
+ /* Mean longitude of the ascending node of the Moon. */
1892
+ AOM = swe_radnorm(2.18243920 - 33.757045 * T);
1893
+ /* Planetary longitudes, Mercury through Neptune (Souchay et al. 1999). */
1894
+ ALME = swe_radnorm(4.402608842 + 2608.7903141574 * T);
1895
+ ALVE = swe_radnorm(3.176146697 + 1021.3285546211 * T);
1896
+ ALEA = swe_radnorm(1.753470314 + 628.3075849991 * T);
1897
+ ALMA = swe_radnorm(6.203480913 + 334.0612426700 * T);
1898
+ ALJU = swe_radnorm(0.599546497 + 52.9690962641 * T);
1899
+ ALSA = swe_radnorm(0.874016757 + 21.3299104960 * T);
1900
+ ALUR = swe_radnorm(5.481293871 + 7.4781598567 * T);
1901
+ ALNE = swe_radnorm(5.321159000 + 3.8127774000 * T);
1902
+ /* General accumulated precession in longitude. */
1903
+ APA = (0.02438175 + 0.00000538691 * T) * T;
1904
+ /* planetary nutation series (in reverse order).*/
1905
+ dpsi = 0;
1906
+ deps = 0;
1907
+ for (i = NPL - 1; i >= 0; i--) {
1908
+ j = i * 14;
1909
+ darg = swe_radnorm((double) npl[j + 0] * AL +
1910
+ (double) npl[j + 1] * ALSU +
1911
+ (double) npl[j + 2] * AF +
1912
+ (double) npl[j + 3] * AD +
1913
+ (double) npl[j + 4] * AOM +
1914
+ (double) npl[j + 5] * ALME +
1915
+ (double) npl[j + 6] * ALVE +
1916
+ (double) npl[j + 7] * ALEA +
1917
+ (double) npl[j + 8] * ALMA +
1918
+ (double) npl[j + 9] * ALJU +
1919
+ (double) npl[j +10] * ALSA +
1920
+ (double) npl[j +11] * ALUR +
1921
+ (double) npl[j +12] * ALNE +
1922
+ (double) npl[j +13] * APA);
1923
+ k = i * 4;
1924
+ sinarg = sin(darg);
1925
+ cosarg = cos(darg);
1926
+ dpsi += (double) icpl[k+0] * sinarg + (double) icpl[k+1] * cosarg;
1927
+ deps += (double) icpl[k+2] * sinarg + (double) icpl[k+3] * cosarg;
1928
+ }
1929
+ nutlo[0] += dpsi * O1MAS2DEG;
1930
+ nutlo[1] += deps * O1MAS2DEG;
1931
+ #if 1
1932
+ /* changes required by adoption of P03 precession
1933
+ * according to Capitaine et al. A & A 412, 366 (2005) = IAU 2006 */
1934
+ dpsi = -8.1 * sin(OM) - 0.6 * sin(2 * F - 2 * D + 2 * OM);
1935
+ dpsi += T * (47.8 * sin(OM) + 3.7 * sin(2 * F - 2 * D + 2 * OM) + 0.6 * sin(2 * F + 2 * OM) - 0.6 * sin(2 * OM));
1936
+ deps = T * (-25.6 * cos(OM) - 1.6 * cos(2 * F - 2 * D + 2 * OM));
1937
+ nutlo[0] += dpsi / (3600.0 * 1000000.0);
1938
+ nutlo[1] += deps / (3600.0 * 1000000.0);
1939
+ #endif
1940
+ }
1941
+ nutlo[0] *= DEGTORAD;
1942
+ nutlo[1] *= DEGTORAD;
1943
+ return 0;
1944
+ }
1945
+
1946
+ /* an incomplete implementation of nutation Woolard 1953 */
1947
+ static int calc_nutation_woolard(double J, double *nutlo)
1948
+ {
1949
+ double deps, dpsi;
1950
+ double ls, ld; /* sun's mean longitude, moon's mean longitude */
1951
+ double ms, md; /* sun's mean anomaly, moon's mean anomaly */
1952
+ double nm; /* longitude of moon's ascending node */
1953
+ double t, t2; /* number of Julian centuries of 36525 days since
1954
+ * Jan 0.5 1900.
1955
+ */
1956
+ double tls, tnm, tld; /* twice above */
1957
+ double a, b; /* temps */
1958
+ double mjd = J - J1900;
1959
+ t = mjd/36525.;
1960
+ t2 = t*t;
1961
+ a = 100.0021358*t;
1962
+ b = 360.*(a-(long)a);
1963
+ ls = 279.697+.000303*t2+b;
1964
+ a = 1336.855231*t;
1965
+ b = 360.*(a-(long)a);
1966
+ ld = 270.434-.001133*t2+b;
1967
+ a = 99.99736056000026*t;
1968
+ b = 360.*(a-(long)a);
1969
+ ms = 358.476-.00015*t2+b;
1970
+ a = 13255523.59*t;
1971
+ b = 360.*(a-(long)a);
1972
+ md = 296.105+.009192*t2+b;
1973
+ a = 5.372616667*t;
1974
+ b = 360.*(a-(long)a);
1975
+ nm = 259.183+.002078*t2-b;
1976
+ /* convert to radian forms for use with trig functions.
1977
+ */
1978
+ tls = 2*ls * DEGTORAD;
1979
+ nm = nm * DEGTORAD;
1980
+ tnm = 2*nm;
1981
+ ms = ms * DEGTORAD;
1982
+ tld = 2*ld * DEGTORAD;
1983
+ md = md * DEGTORAD;
1984
+ /* find delta psi and eps, in arcseconds.
1985
+ */
1986
+ dpsi = (-17.2327-.01737*t)*sin(nm)+(-1.2729-.00013*t)*sin(tls)
1987
+ +.2088*sin(tnm)-.2037*sin(tld)+(.1261-.00031*t)*sin(ms)
1988
+ +.0675*sin(md)-(.0497-.00012*t)*sin(tls+ms)
1989
+ -.0342*sin(tld-nm)-.0261*sin(tld+md)+.0214*sin(tls-ms)
1990
+ -.0149*sin(tls-tld+md)+.0124*sin(tls-nm)+.0114*sin(tld-md);
1991
+ deps = (9.21+.00091*t)*cos(nm)+(.5522-.00029*t)*cos(tls)
1992
+ -.0904*cos(tnm)+.0884*cos(tld)+.0216*cos(tls+ms)
1993
+ +.0183*cos(tld-nm)+.0113*cos(tld+md)-.0093*cos(tls-ms)
1994
+ -.0066*cos(tls-nm);
1995
+ /* convert to radians.
1996
+ */
1997
+ dpsi = dpsi/3600.0 * DEGTORAD;
1998
+ deps = deps/3600.0 * DEGTORAD;
1999
+ nutlo[1] = deps;
2000
+ nutlo[0] = dpsi;
2001
+ return OK;
2002
+ }
2003
+
2004
+ static double bessel(double *v, int n, double t)
2005
+ {
2006
+ int i, iy, k;
2007
+ double ans, p, B, d[6];
2008
+ if (t <= 0) {
2009
+ ans = v[0];
2010
+ goto done;
2011
+ }
2012
+ if (t >= n - 1) {
2013
+ ans = v[n - 1];
2014
+ goto done;
2015
+ }
2016
+ p = floor(t);
2017
+ iy = (int) t;
2018
+ /* Zeroth order estimate is value at start of year */
2019
+ ans = v[iy];
2020
+ k = iy + 1;
2021
+ if (k >= n)
2022
+ goto done;
2023
+ /* The fraction of tabulation interval */
2024
+ p = t - p;
2025
+ ans += p * (v[k] - v[iy]);
2026
+ if( (iy - 1 < 0) || (iy + 2 >= n) )
2027
+ goto done; /* can't do second differences */
2028
+ /* Make table of first differences */
2029
+ k = iy - 2;
2030
+ for (i = 0; i < 5; i++) {
2031
+ if((k < 0) || (k + 1 >= n))
2032
+ d[i] = 0;
2033
+ else
2034
+ d[i] = v[k+1] - v[k];
2035
+ k += 1;
2036
+ }
2037
+ /* Compute second differences */
2038
+ for (i = 0; i < 4; i++ )
2039
+ d[i] = d[i+1] - d[i];
2040
+ B = 0.25 * p * (p - 1.0);
2041
+ ans += B * (d[1] + d[2]);
2042
+ #if DEMO
2043
+ printf("B %.4lf, ans %.4lf\n", B, ans);
2044
+ #endif
2045
+ if (iy + 2 >= n)
2046
+ goto done;
2047
+ /* Compute third differences */
2048
+ for (i = 0; i < 3; i++ )
2049
+ d[i] = d[i + 1] - d[i];
2050
+ B = 2.0 * B / 3.0;
2051
+ ans += (p - 0.5) * B * d[1];
2052
+ #if DEMO
2053
+ printf("B %.4lf, ans %.4lf\n", B * (p - 0.5), ans);
2054
+ #endif
2055
+ if ((iy - 2 < 0) || (iy + 3 > n))
2056
+ goto done;
2057
+ /* Compute fourth differences */
2058
+ for (i = 0; i < 2; i++)
2059
+ d[i] = d[i + 1] - d[i];
2060
+ B = 0.125 * B * (p + 1.0) * (p - 2.0);
2061
+ ans += B * (d[0] + d[1]);
2062
+ #if DEMO
2063
+ printf("B %.4lf, ans %.4lf\n", B, ans);
2064
+ #endif
2065
+ done:
2066
+ return ans;
2067
+ }
2068
+
2069
+ static int calc_nutation(double J, int32 iflag, double *nutlo)
2070
+ {
2071
+ int n;
2072
+ double dpsi, deps, J2;
2073
+ int nut_model = swed.astro_models[SE_MODEL_NUT];
2074
+ int jplhora_model = swed.astro_models[SE_MODEL_JPLHORA_MODE];
2075
+ AS_BOOL is_jplhor = FALSE;
2076
+ if (nut_model == 0) nut_model = SEMOD_NUT_DEFAULT;
2077
+ if (jplhora_model == 0) jplhora_model = SEMOD_JPLHORA_DEFAULT;
2078
+ if (iflag & SEFLG_JPLHOR)
2079
+ is_jplhor = TRUE;
2080
+ if ((iflag & SEFLG_JPLHOR_APPROX) &&
2081
+ jplhora_model == SEMOD_JPLHORA_3
2082
+ && J <= HORIZONS_TJD0_DPSI_DEPS_IAU1980)
2083
+ is_jplhor = TRUE;
2084
+ if (is_jplhor) {
2085
+ calc_nutation_iau1980(J, nutlo);
2086
+ if (iflag & SEFLG_JPLHOR) {
2087
+ n = (int) (swed.eop_tjd_end - swed.eop_tjd_beg + 0.000001);
2088
+ J2 = J;
2089
+ if (J < swed.eop_tjd_beg_horizons)
2090
+ J2 = swed.eop_tjd_beg_horizons;
2091
+ dpsi = bessel(swed.dpsi, n + 1, J2 - swed.eop_tjd_beg);
2092
+ deps = bessel(swed.deps, n + 1, J2 - swed.eop_tjd_beg);
2093
+ nutlo[0] += dpsi / 3600.0 * DEGTORAD;
2094
+ nutlo[1] += deps / 3600.0 * DEGTORAD;
2095
+ #if 0
2096
+ printf("tjd=%f, dpsi=%f, deps=%f\n", J, dpsi * 1000, deps * 1000);
2097
+ #endif
2098
+ } else {
2099
+ nutlo[0] += DPSI_IAU1980_TJD0 / 3600.0 * DEGTORAD;
2100
+ nutlo[1] += DEPS_IAU1980_TJD0 / 3600.0 * DEGTORAD;
2101
+ }
2102
+ } else if (nut_model == SEMOD_NUT_IAU_1980 || nut_model == SEMOD_NUT_IAU_CORR_1987) {
2103
+ calc_nutation_iau1980(J, nutlo);
2104
+ } else if (nut_model == SEMOD_NUT_IAU_2000A || nut_model == SEMOD_NUT_IAU_2000B) {
2105
+ calc_nutation_iau2000ab(J, nutlo);
2106
+ if ((iflag & SEFLG_JPLHOR_APPROX) && jplhora_model == SEMOD_JPLHORA_2) {
2107
+ nutlo[0] += -41.7750 / 3600.0 / 1000.0 * DEGTORAD;
2108
+ nutlo[1] += -6.8192 / 3600.0 / 1000.0 * DEGTORAD;
2109
+ }
2110
+ } else if (nut_model == SEMOD_NUT_WOOLARD) {
2111
+ calc_nutation_woolard(J, nutlo);
2112
+ }
2113
+ return OK;
2114
+ }
2115
+
2116
+ static double quadratic_intp(double ym, double y0, double yp, double x)
2117
+ {
2118
+ double a, b, c, y;
2119
+ c = y0;
2120
+ b = (yp - ym) / 2.0;
2121
+ a = (yp + ym) / 2.0 - c;
2122
+ y = a * x * x + b * x + c;
2123
+ return y;
2124
+ }
2125
+
2126
+ int swi_nutation(double tjd, int32 iflag, double *nutlo)
2127
+ {
2128
+ int retc = OK;
2129
+ double dnut[2], dx;
2130
+ if (!swed.do_interpolate_nut) {
2131
+ retc = calc_nutation(tjd, iflag, nutlo);
2132
+ // from interpolation, with three data points in 1-day steps;
2133
+ // maximum error is about 3 mas
2134
+ } else {
2135
+ // precalculated data points available
2136
+ if (tjd < swed.interpol.tjd_nut2 && tjd > swed.interpol.tjd_nut0) {
2137
+ dx = (tjd - swed.interpol.tjd_nut0) - 1.0;
2138
+ nutlo[0] = quadratic_intp(swed.interpol.nut_dpsi0, swed.interpol.nut_dpsi1, swed.interpol.nut_dpsi2, dx);
2139
+ nutlo[1] = quadratic_intp(swed.interpol.nut_deps0, swed.interpol.nut_deps1, swed.interpol.nut_deps2, dx);
2140
+ } else {
2141
+ swed.interpol.tjd_nut0 = tjd - 1.0; // one day earlier
2142
+ swed.interpol.tjd_nut2 = tjd + 1.0; // one day later
2143
+ retc = calc_nutation(swed.interpol.tjd_nut0, iflag, dnut);
2144
+ if (retc == ERR) return ERR;
2145
+ swed.interpol.nut_dpsi0 = dnut[0];
2146
+ swed.interpol.nut_deps0 = dnut[1];
2147
+ retc = calc_nutation(swed.interpol.tjd_nut2, iflag, dnut);
2148
+ if (retc == ERR) return ERR;
2149
+ swed.interpol.nut_dpsi2 = dnut[0];
2150
+ swed.interpol.nut_deps2 = dnut[1];
2151
+ retc = calc_nutation(tjd, iflag, nutlo);
2152
+ if (retc == ERR) return ERR;
2153
+ swed.interpol.nut_dpsi1 = nutlo[0];
2154
+ swed.interpol.nut_deps1 = nutlo[1];
2155
+ }
2156
+ }
2157
+ return retc;
2158
+ }
2159
+
2160
+ #define OFFSET_JPLHORIZONS (-52.3)
2161
+ #define DCOR_RA_JPL_TJD0 2437846.5
2162
+ #define NDCOR_RA_JPL 51
2163
+ double dcor_ra_jpl[] = {
2164
+ -51.257, -51.103, -51.065, -51.503, -51.224, -50.796, -51.161, -51.181,
2165
+ -50.932, -51.064, -51.182, -51.386, -51.416, -51.428, -51.586, -51.766, -52.038, -52.370,
2166
+ -52.553, -52.397, -52.340, -52.676, -52.348, -51.964, -52.444, -52.364, -51.988, -52.212,
2167
+ -52.370, -52.523, -52.541, -52.496, -52.590, -52.629, -52.788, -53.014, -53.053, -52.902,
2168
+ -52.850, -53.087, -52.635, -52.185, -52.588, -52.292, -51.796, -51.961, -52.055, -52.134,
2169
+ -52.165, -52.141, -52.255,
2170
+ };
2171
+
2172
+ static void swi_approx_jplhor(double *x, double tjd, int32 iflag, AS_BOOL backward)
2173
+ {
2174
+ double t0, t1;
2175
+ double t = (tjd - DCOR_RA_JPL_TJD0) / 365.25;
2176
+ double dofs = OFFSET_JPLHORIZONS;
2177
+ int jplhora_model = swed.astro_models[SE_MODEL_JPLHORA_MODE];
2178
+ if (jplhora_model == 0) jplhora_model = SEMOD_JPLHORA_DEFAULT;
2179
+ if (!(iflag & SEFLG_JPLHOR_APPROX))
2180
+ return;
2181
+ if (jplhora_model == SEMOD_JPLHORA_2)
2182
+ return;
2183
+ if (t < 0) {
2184
+ t = 0;
2185
+ dofs = dcor_ra_jpl[0];
2186
+ } else if (t >= NDCOR_RA_JPL - 1) {
2187
+ t = NDCOR_RA_JPL;
2188
+ dofs = dcor_ra_jpl[NDCOR_RA_JPL - 1];
2189
+ } else {
2190
+ t0 = (int) t;
2191
+ t1 = t0 + 1;
2192
+ dofs = dcor_ra_jpl[(int)t0];
2193
+ dofs = (t - t0) * (dcor_ra_jpl[(int)t0] - dcor_ra_jpl[(int)t1]) + dcor_ra_jpl[(int)t0];
2194
+ }
2195
+ dofs /= (1000.0 * 3600.0);
2196
+ swi_cartpol(x, x);
2197
+ if (backward)
2198
+ x[0] -= dofs * DEGTORAD;
2199
+ else
2200
+ x[0] += dofs * DEGTORAD;
2201
+ swi_polcart(x, x);
2202
+ }
2203
+
2204
+ /* GCRS to J2000 */
2205
+ void swi_bias(double *x, double tjd, int32 iflag, AS_BOOL backward)
2206
+ {
2207
+ #if 0
2208
+ double DAS2R = 1.0 / 3600.0 * DEGTORAD;
2209
+ double dpsi_bias = -0.041775 * DAS2R;
2210
+ double deps_bias = -0.0068192 * DAS2R;
2211
+ double dra0 = -0.0146 * DAS2R;
2212
+ double deps2000 = 84381.448 * DAS2R;
2213
+ #endif
2214
+ double xx[6], rb[3][3];
2215
+ int i;
2216
+ int bias_model = swed.astro_models[SE_MODEL_BIAS];
2217
+ int jplhora_model = swed.astro_models[SE_MODEL_JPLHORA_MODE];
2218
+ if (bias_model == 0) bias_model = SEMOD_BIAS_DEFAULT;
2219
+ if (jplhora_model == 0) jplhora_model = SEMOD_JPLHORA_DEFAULT;
2220
+ if (bias_model == SEMOD_BIAS_NONE)
2221
+ return;
2222
+ if (iflag & SEFLG_JPLHOR_APPROX) {
2223
+ if (jplhora_model == SEMOD_JPLHORA_2)
2224
+ return;
2225
+ if (jplhora_model == SEMOD_JPLHORA_3 && tjd < DPSI_DEPS_IAU1980_TJD0_HORIZONS)
2226
+ return;
2227
+ }
2228
+ /* #if FRAME_BIAS_IAU2006 * frame bias 2006 */
2229
+ if (bias_model == SEMOD_BIAS_IAU2006) {
2230
+ rb[0][0] = +0.99999999999999412;
2231
+ rb[1][0] = -0.00000007078368961;
2232
+ rb[2][0] = +0.00000008056213978;
2233
+ rb[0][1] = +0.00000007078368695;
2234
+ rb[1][1] = +0.99999999999999700;
2235
+ rb[2][1] = +0.00000003306428553;
2236
+ rb[0][2] = -0.00000008056214212;
2237
+ rb[1][2] = -0.00000003306427981;
2238
+ rb[2][2] = +0.99999999999999634;
2239
+ /* #else * frame bias 2000, makes no difference in result */
2240
+ } else {
2241
+ rb[0][0] = +0.9999999999999942;
2242
+ rb[1][0] = -0.0000000707827974;
2243
+ rb[2][0] = +0.0000000805621715;
2244
+ rb[0][1] = +0.0000000707827948;
2245
+ rb[1][1] = +0.9999999999999969;
2246
+ rb[2][1] = +0.0000000330604145;
2247
+ rb[0][2] = -0.0000000805621738;
2248
+ rb[1][2] = -0.0000000330604088;
2249
+ rb[2][2] = +0.9999999999999962;
2250
+ }
2251
+ /*#endif*/
2252
+ #if 0
2253
+ rb[0][0] = +0.9999999999999968;
2254
+ rb[1][0] = +0.0000000000000000;
2255
+ rb[2][0] = +0.0000000805621715;
2256
+ rb[0][1] = -0.0000000000000027;
2257
+ rb[1][1] = +0.9999999999999994;
2258
+ rb[2][1] = +0.0000000330604145;
2259
+ rb[0][2] = -0.0000000805621715;
2260
+ rb[1][2] = -0.0000000330604145;
2261
+ rb[2][2] = +0.9999999999999962;
2262
+ #endif
2263
+ if (backward) {
2264
+ swi_approx_jplhor(x, tjd, iflag, TRUE);
2265
+ for (i = 0; i <= 2; i++) {
2266
+ xx[i] = x[0] * rb[i][0] +
2267
+ x[1] * rb[i][1] +
2268
+ x[2] * rb[i][2];
2269
+ if (iflag & SEFLG_SPEED)
2270
+ xx[i+3] = x[3] * rb[i][0] +
2271
+ x[4] * rb[i][1] +
2272
+ x[5] * rb[i][2];
2273
+ }
2274
+ } else {
2275
+ for (i = 0; i <= 2; i++) {
2276
+ xx[i] = x[0] * rb[0][i] +
2277
+ x[1] * rb[1][i] +
2278
+ x[2] * rb[2][i];
2279
+ if (iflag & SEFLG_SPEED)
2280
+ xx[i+3] = x[3] * rb[0][i] +
2281
+ x[4] * rb[1][i] +
2282
+ x[5] * rb[2][i];
2283
+ }
2284
+ swi_approx_jplhor(xx, tjd, iflag, FALSE);
2285
+ }
2286
+ for (i = 0; i <= 2; i++) x[i] = xx[i];
2287
+ if (iflag & SEFLG_SPEED)
2288
+ for (i = 3; i <= 5; i++) x[i] = xx[i];
2289
+ }
2290
+
2291
+ /* GCRS to FK5 */
2292
+ void swi_icrs2fk5(double *x, int32 iflag, AS_BOOL backward)
2293
+ {
2294
+ #if 0
2295
+ double DAS2R = 1.0 / 3600.0 * DEGTORAD;
2296
+ double dra0 = -0.0229 * DAS2R;
2297
+ double dxi0 = 0.0091 * DAS2R;
2298
+ double det0 = -0.0199 * DAS2R;
2299
+ #endif
2300
+ double xx[6], rb[3][3];
2301
+ int i;
2302
+ rb[0][0] = +0.9999999999999928;
2303
+ rb[0][1] = +0.0000001110223287;
2304
+ rb[0][2] = +0.0000000441180557;
2305
+ rb[1][0] = -0.0000001110223330;
2306
+ rb[1][1] = +0.9999999999999891;
2307
+ rb[1][2] = +0.0000000964779176;
2308
+ rb[2][0] = -0.0000000441180450;
2309
+ rb[2][1] = -0.0000000964779225;
2310
+ rb[2][2] = +0.9999999999999943;
2311
+ if (backward) {
2312
+ for (i = 0; i <= 2; i++) {
2313
+ xx[i] = x[0] * rb[i][0] +
2314
+ x[1] * rb[i][1] +
2315
+ x[2] * rb[i][2];
2316
+ if (iflag & SEFLG_SPEED)
2317
+ xx[i+3] = x[3] * rb[i][0] +
2318
+ x[4] * rb[i][1] +
2319
+ x[5] * rb[i][2];
2320
+ }
2321
+ } else {
2322
+ for (i = 0; i <= 2; i++) {
2323
+ xx[i] = x[0] * rb[0][i] +
2324
+ x[1] * rb[1][i] +
2325
+ x[2] * rb[2][i];
2326
+ if (iflag & SEFLG_SPEED)
2327
+ xx[i+3] = x[3] * rb[0][i] +
2328
+ x[4] * rb[1][i] +
2329
+ x[5] * rb[2][i];
2330
+ }
2331
+ }
2332
+ for (i = 0; i <= 5; i++) x[i] = xx[i];
2333
+ }
2334
+
2335
+ /* DeltaT = Ephemeris Time - Universal Time, in days.
2336
+ *
2337
+ * Before 1955 we use the data developed by
2338
+ * Stephenson, Morrison, and Hohenkerk (2016),
2339
+ *
2340
+ * 1955 - today + a couple of years:
2341
+ * ---------------------------------
2342
+ * The tabulated values of deltaT from the Astronomical
2343
+ * Alamanc (AA 1997 etc. pp. K8-K9) are used. Some
2344
+ * more recent values have been taken from IERS
2345
+ * (http://maia.usno.navy.mil/ser7/deltat.data).
2346
+ * Bessel's interpolation formula is implemented to obtain fourth
2347
+ * order interpolated values at intermediate times.
2348
+ * The values are adjusted depending on the ephemeris used
2349
+ * and its inherent value of secular tidal acceleration ndot.
2350
+ *
2351
+ * future:
2352
+ * ---------------------------------
2353
+ * For the time after the last tabulated value, we use the formula
2354
+ * of Stephenson (1997; p. 507), with a modification that avoids a jump
2355
+ * at the end of the tabulated period. A linear term is added that
2356
+ * makes a slow transition from the table to the formula over a period
2357
+ * of 100 years. (Need not be updated, when table will be enlarged.)
2358
+ *
2359
+ * References:
2360
+ *
2361
+ * Stephenson, F. R., and L. V. Morrison, "Long-term changes
2362
+ * in the rotation of the Earth: 700 B.C. to A.D. 1980,"
2363
+ * Philosophical Transactions of the Royal Society of London
2364
+ * Series A 313, 47-70 (1984)
2365
+ *
2366
+ * Borkowski, K. M., "ELP2000-85 and the Dynamical Time
2367
+ * - Universal Time relation," Astronomy and Astrophysics
2368
+ * 205, L8-L10 (1988)
2369
+ * Borkowski's formula is derived from partly doubtful eclipses
2370
+ * going back to 2137 BC and uses lunar position based on tidal
2371
+ * coefficient of -23.9 arcsec/cy^2.
2372
+ *
2373
+ * Chapront-Touze, Michelle, and Jean Chapront, _Lunar Tables
2374
+ * and Programs from 4000 B.C. to A.D. 8000_, Willmann-Bell 1991
2375
+ * Their table agrees with the one here, but the entries are
2376
+ * rounded to the nearest whole second.
2377
+ *
2378
+ * Stephenson, F. R., and M. A. Houlden, _Atlas of Historical
2379
+ * Eclipse Maps_, Cambridge U. Press (1986)
2380
+ *
2381
+ * Stephenson, F.R. & Morrison, L.V., "Long-Term Fluctuations in
2382
+ * the Earth's Rotation: 700 BC to AD 1990", Philosophical
2383
+ * Transactions of the Royal Society of London,
2384
+ * Ser. A, 351 (1995), 165-202.
2385
+ *
2386
+ * Stephenson, F. Richard, _Historical Eclipses and Earth's
2387
+ * Rotation_, Cambridge U. Press (1997)
2388
+ *
2389
+ * Morrison, L. V., and F.R. Stephenson, "Historical Values of the Earth's
2390
+ * Clock Error DT and the Calculation of Eclipses", JHA xxxv (2004),
2391
+ * pp.327-336
2392
+ *
2393
+ * Stephenson, F.R., Morrison, L.V., and Hohenkerk, C.Y., "Measurement of the
2394
+ * Earth's Rotation: 720 BC to AD 2015", Royal Society Proceedings A
2395
+ * 7 Dec 2016,
2396
+ * http://rspa.royalsocietypublishing.org/lookup/doi/10.1098/rspa.2016.0404
2397
+ *
2398
+ * Table from AA for 1620 through today
2399
+ * Note, Stephenson and Morrison's table starts at the year 1630.
2400
+ * The Chapronts' table does not agree with the Almanac prior to 1630.
2401
+ * The actual accuracy decreases rapidly prior to 1780.
2402
+ *
2403
+ * Jean Meeus, Astronomical Algorithms, 2nd edition, 1998.
2404
+ *
2405
+ * For a comprehensive collection of publications and formulae, see:
2406
+ * http://www.phys.uu.nl/~vgent/deltat/deltat_modern.htm
2407
+ * http://www.phys.uu.nl/~vgent/deltat/deltat_old.htm
2408
+ *
2409
+ * For future values of delta t, the following data from the
2410
+ * Earth Orientation Department of the US Naval Observatory can be used:
2411
+ * (TAI-UTC) from: ftp://maia.usno.navy.mil/ser7/tai-utc.dat
2412
+ * (UT1-UTC) from: ftp://maia.usno.navy.mil/ser7/finals.all (cols. 59-68)
2413
+ * or: ftp://ftp.iers.org/products/eop/rapid/standard/finals.data
2414
+ * file description in: ftp://maia.usno.navy.mil/ser7/readme.finals
2415
+ * Delta T = TAI-UT1 + 32.184 sec = (TAI-UTC) - (UT1-UTC) + 32.184 sec
2416
+ *
2417
+ * Also, there is the following file:
2418
+ * http://maia.usno.navy.mil/ser7/deltat.data, but it is about 3 months
2419
+ * behind (on 3 feb 2009); and predictions:
2420
+ * http://maia.usno.navy.mil/ser7/deltat.preds
2421
+ *
2422
+ * Last update of table dt[]: Dieter Koch, 18 dec 2013.
2423
+ * ATTENTION: Whenever updating this table, do not forget to adjust
2424
+ * the macros TABEND and TABSIZ !
2425
+ */
2426
+ #define TABSTART 1620
2427
+ #define TABEND 2028
2428
+ #define TABSIZ (TABEND-TABSTART+1)
2429
+ /* we make the table greater for additional values read from external file */
2430
+ #define TABSIZ_SPACE (TABSIZ+100)
2431
+ static TLS double dt[TABSIZ_SPACE] = {
2432
+ /* 1620.0 - 1659.0 */
2433
+ 124.00, 119.00, 115.00, 110.00, 106.00, 102.00, 98.00, 95.00, 91.00, 88.00,
2434
+ 85.00, 82.00, 79.00, 77.00, 74.00, 72.00, 70.00, 67.00, 65.00, 63.00,
2435
+ 62.00, 60.00, 58.00, 57.00, 55.00, 54.00, 53.00, 51.00, 50.00, 49.00,
2436
+ 48.00, 47.00, 46.00, 45.00, 44.00, 43.00, 42.00, 41.00, 40.00, 38.00,
2437
+ /* 1660.0 - 1699.0 */
2438
+ 37.00, 36.00, 35.00, 34.00, 33.00, 32.00, 31.00, 30.00, 28.00, 27.00,
2439
+ 26.00, 25.00, 24.00, 23.00, 22.00, 21.00, 20.00, 19.00, 18.00, 17.00,
2440
+ 16.00, 15.00, 14.00, 14.00, 13.00, 12.00, 12.00, 11.00, 11.00, 10.00,
2441
+ 10.00, 10.00, 9.00, 9.00, 9.00, 9.00, 9.00, 9.00, 9.00, 9.00,
2442
+ /* 1700.0 - 1739.0 */
2443
+ 9.00, 9.00, 9.00, 9.00, 9.00, 9.00, 9.00, 9.00, 10.00, 10.00,
2444
+ 10.00, 10.00, 10.00, 10.00, 10.00, 10.00, 10.00, 11.00, 11.00, 11.00,
2445
+ 11.00, 11.00, 11.00, 11.00, 11.00, 11.00, 11.00, 11.00, 11.00, 11.00,
2446
+ 11.00, 11.00, 11.00, 11.00, 12.00, 12.00, 12.00, 12.00, 12.00, 12.00,
2447
+ /* 1740.0 - 1779.0 */
2448
+ 12.00, 12.00, 12.00, 12.00, 13.00, 13.00, 13.00, 13.00, 13.00, 13.00,
2449
+ 13.00, 14.00, 14.00, 14.00, 14.00, 14.00, 14.00, 14.00, 15.00, 15.00,
2450
+ 15.00, 15.00, 15.00, 15.00, 15.00, 16.00, 16.00, 16.00, 16.00, 16.00,
2451
+ 16.00, 16.00, 16.00, 16.00, 16.00, 17.00, 17.00, 17.00, 17.00, 17.00,
2452
+ /* 1780.0 - 1799.0 */
2453
+ 17.00, 17.00, 17.00, 17.00, 17.00, 17.00, 17.00, 17.00, 17.00, 17.00,
2454
+ 17.00, 17.00, 16.00, 16.00, 16.00, 16.00, 15.00, 15.00, 14.00, 14.00,
2455
+ /* 1800.0 - 1819.0 */
2456
+ 13.70, 13.40, 13.10, 12.90, 12.70, 12.60, 12.50, 12.50, 12.50, 12.50,
2457
+ 12.50, 12.50, 12.50, 12.50, 12.50, 12.50, 12.50, 12.40, 12.30, 12.20,
2458
+ /* 1820.0 - 1859.0 */
2459
+ 12.00, 11.70, 11.40, 11.10, 10.60, 10.20, 9.60, 9.10, 8.60, 8.00,
2460
+ 7.50, 7.00, 6.60, 6.30, 6.00, 5.80, 5.70, 5.60, 5.60, 5.60,
2461
+ 5.70, 5.80, 5.90, 6.10, 6.20, 6.30, 6.50, 6.60, 6.80, 6.90,
2462
+ 7.10, 7.20, 7.30, 7.40, 7.50, 7.60, 7.70, 7.70, 7.80, 7.80,
2463
+ /* 1860.0 - 1899.0 */
2464
+ 7.88, 7.82, 7.54, 6.97, 6.40, 6.02, 5.41, 4.10, 2.92, 1.82,
2465
+ 1.61, .10, -1.02, -1.28, -2.69, -3.24, -3.64, -4.54, -4.71, -5.11,
2466
+ -5.40, -5.42, -5.20, -5.46, -5.46, -5.79, -5.63, -5.64, -5.80, -5.66,
2467
+ -5.87, -6.01, -6.19, -6.64, -6.44, -6.47, -6.09, -5.76, -4.66, -3.74,
2468
+ /* 1900.0 - 1939.0 */
2469
+ -2.72, -1.54, -.02, 1.24, 2.64, 3.86, 5.37, 6.14, 7.75, 9.13,
2470
+ 10.46, 11.53, 13.36, 14.65, 16.01, 17.20, 18.24, 19.06, 20.25, 20.95,
2471
+ 21.16, 22.25, 22.41, 23.03, 23.49, 23.62, 23.86, 24.49, 24.34, 24.08,
2472
+ 24.02, 24.00, 23.87, 23.95, 23.86, 23.93, 23.73, 23.92, 23.96, 24.02,
2473
+ /* 1940.0 - 1949.0 */
2474
+ 24.33, 24.83, 25.30, 25.70, 26.24, 26.77, 27.28, 27.78, 28.25, 28.71,
2475
+ /* 1950.0 - 1959.0 */
2476
+ 29.15, 29.57, 29.97, 30.36, 30.72, 31.07, 31.35, 31.68, 32.18, 32.68,
2477
+ /* 1960.0 - 1969.0 */
2478
+ 33.15, 33.59, 34.00, 34.47, 35.03, 35.73, 36.54, 37.43, 38.29, 39.20,
2479
+ /* 1970.0 - 1979.0 */
2480
+ /* from 1974 on values (with 4-digit precision) were calculated from IERS data */
2481
+ 40.18, 41.17, 42.23, 43.37, 44.4841, 45.4761, 46.4567, 47.5214, 48.5344, 49.5862,
2482
+ /* 1980.0 - 1989.0 */
2483
+ 50.5387, 51.3808, 52.1668, 52.9565, 53.7882, 54.3427, 54.8713, 55.3222, 55.8197, 56.3000,
2484
+ /* 1990.0 - 1999.0 */
2485
+ 56.8553, 57.5653, 58.3092, 59.1218, 59.9845, 60.7854, 61.6287, 62.2951, 62.9659, 63.4673,
2486
+ /* 2000.0 - 2009.0 */
2487
+ 63.8285, 64.0908, 64.2998, 64.4734, 64.5736, 64.6876, 64.8452, 65.1464, 65.4574, 65.7768,
2488
+ /* 2010.0 - 2018.0 */
2489
+ 66.0699, 66.3246, 66.6030, 66.9069, 67.2810, 67.6439, 68.1024, 68.5927, 68.9676, 69.2202,
2490
+ /* 2020.0 - 2023.0 */
2491
+ 69.3612, 69.3593, 69.2945, 69.1833,
2492
+ /* Extrapolated values:
2493
+ * 2024 - 2028 */
2494
+ 69.10, 69.00, 68.90, 68.80, 68.80,
2495
+ };
2496
+
2497
+ #define TAB2_SIZ 27
2498
+ #define TAB2_START (-1000)
2499
+ #define TAB2_END 1600
2500
+ #define TAB2_STEP 100
2501
+ #define LTERM_EQUATION_YSTART 1820
2502
+ #define LTERM_EQUATION_COEFF 32
2503
+ /* Table for -1000 through 1600, from Morrison & Stephenson (2004). */
2504
+ static const short dt2[TAB2_SIZ] = {
2505
+ /*-1000 -900 -800 -700 -600 -500 -400 -300 -200 -100*/
2506
+ 25400,23700,22000,21000,19040,17190,15530,14080,12790,11640,
2507
+ /* 0 100 200 300 400 500 600 700 800 900*/
2508
+ 10580, 9600, 8640, 7680, 6700, 5710, 4740, 3810, 2960, 2200,
2509
+ /* 1000 1100 1200 1300 1400 1500 1600, */
2510
+ 1570, 1090, 740, 490, 320, 200, 120,
2511
+ };
2512
+
2513
+ /* Table for -500 through 1600, from Stephenson & Morrison (1995).
2514
+ *
2515
+ * The first value for -550 has been added from Borkowski
2516
+ * in order to make this table fit with the Borkowski formula
2517
+ * for times before -550.
2518
+ */
2519
+ #define TAB97_SIZ 43
2520
+ #define TAB97_START (-500)
2521
+ #define TAB97_END (1600)
2522
+ #define TAB97_STEP (50)
2523
+ static const short dt97[TAB97_SIZ] = {
2524
+ /* -500 -450 -400 -350 -300 -250 -200 -150 -100 -50*/
2525
+ 16800,16000,15300,14600,14000,13400,12800,12200,11600,11100,
2526
+ /* 0 50 100 150 200 250 300 350 400 450*/
2527
+ 10600,10100, 9600, 9100, 8600, 8200, 7700, 7200, 6700, 6200,
2528
+ /* 500 550 600 650 700 750 800 850 900 950*/
2529
+ 5700, 5200, 4700, 4300, 3800, 3400, 3000, 2600, 2200, 1900,
2530
+ /* 1000 1050 1100 1150 1200 1250 1300 1350 1400 1450*/
2531
+ 1600, 1350, 1100, 900, 750, 600, 470, 380, 300, 230,
2532
+ /* 1500 1550 1600 */
2533
+ 180, 140, 110,
2534
+ };
2535
+
2536
+ /* returns DeltaT (ET - UT) in days
2537
+ * double tjd = julian day in UT
2538
+ * delta t is adjusted to the tidal acceleration that is compatible
2539
+ * with the ephemeris flag contained in iflag and with the ephemeris
2540
+ * files made accessible through swe_set_ephe_path() or swe_set_jplfile().
2541
+ * If iflag = -1, then the default tidal acceleration is ussed (i.e.
2542
+ * that of DE431).
2543
+ */
2544
+ #define DEMO 0
2545
+ static int32 calc_deltat(double tjd, int32 iflag, double *deltat, char *serr)
2546
+ {
2547
+ double ans = 0;
2548
+ double B, Y, Ygreg, dd;
2549
+ int iy;
2550
+ int32 retc;
2551
+ int deltat_model = swed.astro_models[SE_MODEL_DELTAT];
2552
+ double tid_acc;
2553
+ int32 denum, denumret;
2554
+ int32 epheflag, otherflag;
2555
+ //fprintf(stderr, "dmod=%f, %.f\n", (double) deltat_model, (double) SEMOD_DELTAT_DEFAULT);
2556
+ if (deltat_model == 0) deltat_model = SEMOD_DELTAT_DEFAULT;
2557
+ epheflag = iflag & SEFLG_EPHMASK;
2558
+ otherflag = iflag & ~SEFLG_EPHMASK;
2559
+ /* with iflag == -1, we use default tid_acc */
2560
+ if (iflag == -1) {
2561
+ retc = swi_get_tid_acc(tjd, 0, 9999, &denumret, &tid_acc, serr); /* for default tid_acc */
2562
+ /* otherwise we use tid_acc consistent with epheflag */
2563
+ } else {
2564
+ denum = swed.jpldenum;
2565
+ if (epheflag & SEFLG_SWIEPH) denum = swed.fidat[SEI_FILE_MOON].sweph_denum;
2566
+ if (swi_init_swed_if_start() == 1 && !(epheflag & SEFLG_MOSEPH)) {
2567
+ if (serr != NULL)
2568
+ strcpy(serr, "Please call swe_set_ephe_path() or swe_set_jplfile() before calling swe_deltat_ex()");
2569
+ retc = swi_set_tid_acc(tjd, epheflag, denum, NULL); /* _set_ saves tid_acc in swed */
2570
+ } else {
2571
+ retc = swi_set_tid_acc(tjd, epheflag, denum, serr); /* _set_ saves tid_acc in swed */
2572
+ }
2573
+ tid_acc = swed.tid_acc;
2574
+ }
2575
+ iflag = otherflag | retc;
2576
+ Y = 2000.0 + (tjd - J2000)/365.25;
2577
+ Ygreg = 2000.0 + (tjd - J2000)/365.2425;
2578
+ /* Model for epochs before 1955, currently default in Swiss Ephemeris:
2579
+ * Stephenson/Morrison/Hohenkerk 2016
2580
+ * (we switch over to Astronomical Almanac K8-K9 and IERS at 1 Jan. 1955.
2581
+ * To make the curve continuous we apply some linear term over
2582
+ * 1000 days before this date.)
2583
+ * Delta T according to Stephenson/Morrison/Hohenkerk 2016 is based on
2584
+ * ancient, medieval, and modern observations of eclipses and occultations.
2585
+ * Values of Deltat T before 1955 depend on this kind of observations.
2586
+ * For more recent data we want to use the data provided by IERS
2587
+ * (or Astronomical Almanac K8-K9).
2588
+ */
2589
+ if (deltat_model == SEMOD_DELTAT_STEPHENSON_ETC_2016 && tjd < 2435108.5) { // tjd < 2432521.453645833) {
2590
+ *deltat = deltat_stephenson_etc_2016(tjd, tid_acc);
2591
+ if (tjd >= 2434108.5) {
2592
+ *deltat += (1.0 - (2435108.5 - tjd) / 1000.0) * 0.6610218 / 86400.0;
2593
+ }
2594
+ return iflag;
2595
+ }
2596
+ /* Model used SE 1.77 - 2.05.01, for epochs before 1633:
2597
+ * Polynomials by Espenak & Meeus 2006,
2598
+ * derived from Stephenson & Morrison 2004.
2599
+ * deltat_model == SEMOD_DELTAT_ESPENAK_MEEUS_2006:
2600
+ * This method is used only for epochs before 1633. (For more recent
2601
+ * epochs, we use the data provided by Astronomical Almanac K8-K9.)
2602
+ */
2603
+ if (deltat_model == SEMOD_DELTAT_ESPENAK_MEEUS_2006 && tjd < 2317746.13090277789) {
2604
+ *deltat = deltat_espenak_meeus_1620(tjd, tid_acc);
2605
+ return iflag;
2606
+ }
2607
+ /* delta t model used in SE 1.72 - 1.76:
2608
+ * Stephenson & Morrison 2004;
2609
+ * before 1620 */
2610
+ if (deltat_model == SEMOD_DELTAT_STEPHENSON_MORRISON_2004 && Y < TABSTART) {
2611
+ // before 1600:
2612
+ if (Y < TAB2_END) {
2613
+ *deltat = deltat_stephenson_morrison_2004_1600(tjd, tid_acc);
2614
+ return iflag;
2615
+ } else {
2616
+ /* between 1600 and 1620:
2617
+ * linear interpolation between
2618
+ * end of table dt2 and start of table dt */
2619
+ if (Y >= TAB2_END) {
2620
+ B = TABSTART - TAB2_END;
2621
+ iy = (TAB2_END - TAB2_START) / TAB2_STEP;
2622
+ dd = (Y - TAB2_END) / B;
2623
+ ans = dt2[iy] + dd * (dt[0] - dt2[iy]);
2624
+ ans = adjust_for_tidacc(ans, Ygreg, tid_acc, SE_TIDAL_26, FALSE);
2625
+ *deltat = ans / 86400.0;
2626
+ return iflag;
2627
+ }
2628
+ }
2629
+ }
2630
+ /* delta t model used in SE 1.64 - 1.71:
2631
+ * Stephenson 1997;
2632
+ * before 1620 */
2633
+ if (deltat_model == SEMOD_DELTAT_STEPHENSON_1997 && Y < TABSTART) {
2634
+ // before 1600:
2635
+ if (Y < TAB97_END) {
2636
+ *deltat = deltat_stephenson_morrison_1997_1600(tjd, tid_acc);
2637
+ return iflag;
2638
+ } else {
2639
+ /* between 1600 and 1620:
2640
+ * linear interpolation between
2641
+ * end of table dt2 and start of table dt */
2642
+ if (Y >= TAB97_END) {
2643
+ B = TABSTART - TAB97_END;
2644
+ iy = (TAB97_END - TAB97_START) / TAB97_STEP;
2645
+ dd = (Y - TAB97_END) / B;
2646
+ ans = dt97[iy] + dd * (dt[0] - dt97[iy]);
2647
+ ans = adjust_for_tidacc(ans, Ygreg, tid_acc, SE_TIDAL_26, FALSE);
2648
+ *deltat = ans / 86400.0;
2649
+ return iflag;
2650
+ }
2651
+ }
2652
+ }
2653
+ /* delta t model used before SE 1.64:
2654
+ * Stephenson/Morrison 1984 with Borkowski 1988;
2655
+ * before 1620 */
2656
+ if (deltat_model == SEMOD_DELTAT_STEPHENSON_MORRISON_1984 && Y < TABSTART) {
2657
+ if( Y >= 948.0 ) {
2658
+ /* Stephenson and Morrison, stated domain is 948 to 1600:
2659
+ * 25.5(centuries from 1800)^2 - 1.9159(centuries from 1955)^2 */
2660
+ B = 0.01 * (Y - 2000.0);
2661
+ ans = (23.58 * B + 100.3) * B + 101.6;
2662
+ } else {
2663
+ /* Borkowski, before 948 and between 1600 and 1620 */
2664
+ B = 0.01 * (Y - 2000.0) + 3.75;
2665
+ ans = 35.0 * B * B + 40.;
2666
+ }
2667
+ *deltat = ans / 86400.0;
2668
+ return iflag;
2669
+ }
2670
+ /* 1620 - today + a few years (tabend):
2671
+ * Tabulated values of deltaT from Astronomical Almanac
2672
+ * (AA 1997etc., pp. K8-K9) and from IERS
2673
+ * (http://maia.usno.navy.mil/ser7/deltat.data).
2674
+ */
2675
+ if (Y >= TABSTART) {
2676
+ *deltat = deltat_aa(tjd, tid_acc);
2677
+ return iflag;
2678
+ }
2679
+ #ifdef TRACE
2680
+ swi_open_trace(NULL);
2681
+ if (swi_trace_count < TRACE_COUNT_MAX) {
2682
+ if (swi_fp_trace_c != NULL) {
2683
+ fputs("\n/*SWE_DELTAT*/\n", swi_fp_trace_c);
2684
+ fprintf(swi_fp_trace_c, " tjd = %.9f;", tjd);
2685
+ fprintf(swi_fp_trace_c, " iflag = %d;", iflag);
2686
+ fprintf(swi_fp_trace_c, " t = swe_deltat_ex(tjd, iflag, NULL);\n");
2687
+ fputs(" printf(\"swe_deltat: %f\\t%f\\t\\n\", ", swi_fp_trace_c);
2688
+ fputs("tjd, t);\n", swi_fp_trace_c);
2689
+ fflush(swi_fp_trace_c);
2690
+ }
2691
+ if (swi_fp_trace_out != NULL) {
2692
+ fprintf(swi_fp_trace_out, "swe_deltat: %f\t%f\t\n", tjd, ans);
2693
+ fflush(swi_fp_trace_out);
2694
+ }
2695
+ }
2696
+ #endif
2697
+ *deltat = ans / 86400.0;
2698
+ return iflag;
2699
+ }
2700
+
2701
+ double CALL_CONV swe_deltat_ex(double tjd, int32 iflag, char *serr)
2702
+ {
2703
+ double deltat;
2704
+ if (swed.delta_t_userdef_is_set)
2705
+ return swed.delta_t_userdef;
2706
+ if (serr != NULL)
2707
+ *serr = '\0';
2708
+ calc_deltat(tjd, iflag, &deltat, serr);
2709
+ return deltat;
2710
+ }
2711
+
2712
+ double CALL_CONV swe_deltat(double tjd)
2713
+ {
2714
+ int32 iflag = swi_guess_ephe_flag();
2715
+ return swe_deltat_ex(tjd, iflag, NULL); /* with default tidal acceleration/default ephemeris */
2716
+ }
2717
+
2718
+ /* The tabulated values of deltaT, in hundredths of a second,
2719
+ * were taken from The Astronomical Almanac 1997etc., pp. K8-K9.
2720
+ * Some more recent values are taken from IERS
2721
+ * http://maia.usno.navy.mil/ser7/deltat.data .
2722
+ * Bessel's interpolation formula is implemented to obtain fourth
2723
+ * order interpolated values at intermediate times.
2724
+ * The values are adjusted depending on the ephemeris used
2725
+ * and its inherent value of secular tidal acceleration ndot.
2726
+ * Note by Dieter Jan. 2017:
2727
+ * Bessel interpolation assumes equidistant sampling points. However the
2728
+ * sampling points are not equidistant, because they are for first January of
2729
+ * every year and years can have either 365 or 366 days. The interpolation uses
2730
+ * a step width of 365.25 days. As a consequence, in three out of four years
2731
+ * the interpolation does not reproduce the exact values of the sampling points
2732
+ * on the days they refer to. */
2733
+ static double deltat_aa(double tjd, double tid_acc)
2734
+ {
2735
+ double ans = 0, ans2 = 0, ans3;
2736
+ double p, B, B2, Y, dd;
2737
+ double d[6];
2738
+ int i, iy, k;
2739
+ /* read additional values from swedelta.txt */
2740
+ int tabsiz = init_dt();
2741
+ int tabend = TABSTART + tabsiz - 1;
2742
+ int deltat_model = swed.astro_models[SE_MODEL_DELTAT];
2743
+ if (deltat_model == 0) deltat_model = SEMOD_DELTAT_DEFAULT;
2744
+ Y = 2000.0 + (tjd - 2451544.5)/365.25;
2745
+ if (Y <= tabend) {
2746
+ /* Index into the table.
2747
+ */
2748
+ p = floor(Y);
2749
+ iy = (int) (p - TABSTART);
2750
+ /* Zeroth order estimate is value at start of year */
2751
+ ans = dt[iy];
2752
+ k = iy + 1;
2753
+ if( k >= tabsiz )
2754
+ goto done; /* No data, can't go on. */
2755
+ /* The fraction of tabulation interval */
2756
+ p = Y - p;
2757
+ /* First order interpolated value */
2758
+ ans += p*(dt[k] - dt[iy]);
2759
+ if( (iy-1 < 0) || (iy+2 >= tabsiz) )
2760
+ goto done; /* can't do second differences */
2761
+ /* Make table of first differences */
2762
+ k = iy - 2;
2763
+ for( i=0; i<5; i++ ) {
2764
+ if( (k < 0) || (k+1 >= tabsiz) )
2765
+ d[i] = 0;
2766
+ else
2767
+ d[i] = dt[k+1] - dt[k];
2768
+ k += 1;
2769
+ }
2770
+ /* Compute second differences */
2771
+ for( i=0; i<4; i++ )
2772
+ d[i] = d[i+1] - d[i];
2773
+ B = 0.25*p*(p-1.0);
2774
+ ans += B*(d[1] + d[2]);
2775
+ #if DEMO
2776
+ printf( "B %.4lf, ans %.4lf\n", B, ans );
2777
+ #endif
2778
+ if( iy+2 >= tabsiz )
2779
+ goto done;
2780
+ /* Compute third differences */
2781
+ for( i=0; i<3; i++ )
2782
+ d[i] = d[i+1] - d[i];
2783
+ B = 2.0*B/3.0;
2784
+ ans += (p-0.5)*B*d[1];
2785
+ #if DEMO
2786
+ printf( "B %.4lf, ans %.4lf\n", B*(p-0.5), ans );
2787
+ #endif
2788
+ if( (iy-2 < 0) || (iy+3 > tabsiz) )
2789
+ goto done;
2790
+ /* Compute fourth differences */
2791
+ for( i=0; i<2; i++ )
2792
+ d[i] = d[i+1] - d[i];
2793
+ B = 0.125*B*(p+1.0)*(p-2.0);
2794
+ ans += B*(d[0] + d[1]);
2795
+ #if DEMO
2796
+ printf( "B %.4lf, ans %.4lf\n", B, ans );
2797
+ #endif
2798
+ done:
2799
+ ans = adjust_for_tidacc(ans, Y, tid_acc, SE_TIDAL_26, FALSE);
2800
+ return ans / 86400.0;
2801
+ }
2802
+ /* today - future:
2803
+ * 3rd degree polynomial based on data given by
2804
+ * Stephenson/Morrison/Hohenkerk 2016 here:
2805
+ * http://astro.ukho.gov.uk/nao/lvm/
2806
+ */
2807
+ if (deltat_model == SEMOD_DELTAT_STEPHENSON_ETC_2016) {
2808
+ B = (Y - 2000);
2809
+ if (Y < 2500) {
2810
+ ans = B * B * B * 121.0 / 30000000.0 + B * B / 1250.0 + B * 521.0 / 3000.0 + 64.0;
2811
+ /* for slow transition from tablulated data */
2812
+ B2 = (tabend - 2000);
2813
+ ans2 = B2 * B2 * B2 * 121.0 / 30000000.0 + B2 * B2 / 1250.0 + B2 * 521.0 / 3000.0 + 64.0;
2814
+ /* we use a parable after 2500 */
2815
+ } else {
2816
+ B = 0.01 * (Y - 2000);
2817
+ ans = B * B * 32.5 + 42.5;
2818
+ }
2819
+ /*
2820
+ * Formula Stephenson (1997; p. 507),
2821
+ * with modification to avoid jump at end of AA table,
2822
+ * similar to what Meeus 1998 had suggested.
2823
+ * Slow transition within 100 years.
2824
+ */
2825
+ } else {
2826
+ B = 0.01 * (Y - 1820);
2827
+ ans = -20 + 31 * B * B;
2828
+ /* for slow transition from tablulated data */
2829
+ B2 = 0.01 * (tabend - 1820);
2830
+ ans2 = -20 + 31 * B2 * B2;
2831
+ }
2832
+ /* slow transition from tabulated values to Stephenson formula: */
2833
+ if (Y <= tabend+100) {
2834
+ ans3 = dt[tabsiz-1];
2835
+ dd = (ans2 - ans3);
2836
+ ans += dd * (Y - (tabend + 100)) * 0.01;
2837
+ }
2838
+ return ans / 86400.0;
2839
+ }
2840
+
2841
+ static double deltat_longterm_morrison_stephenson(double tjd)
2842
+ {
2843
+ double Ygreg = 2000.0 + (tjd - J2000)/365.2425;
2844
+ double u = (Ygreg - 1820) / 100.0;
2845
+ return (-20 + 32 * u * u);
2846
+ }
2847
+
2848
+ static double deltat_stephenson_morrison_1997_1600(double tjd, double tid_acc)
2849
+ {
2850
+ double ans = 0, ans2, ans3;
2851
+ double p, B, Y, dd;
2852
+ int iy;
2853
+ Y = 2000.0 + (tjd - J2000)/365.25;
2854
+ /* before -500:
2855
+ * formula by Stephenson (1997; p. 508) but adjusted to fit the starting
2856
+ * point of table dt97 (Stephenson 1997). */
2857
+ if( Y < TAB97_START ) {
2858
+ B = (Y - 1735) * 0.01;
2859
+ ans = -20 + 35 * B * B;
2860
+ ans = adjust_for_tidacc(ans, Y, tid_acc, SE_TIDAL_26, FALSE);
2861
+ /* transition from formula to table over 100 years */
2862
+ if (Y >= TAB97_START - 100) {
2863
+ /* starting value of table dt97: */
2864
+ ans2 = adjust_for_tidacc(dt97[0], TAB97_START, tid_acc, SE_TIDAL_26, FALSE);
2865
+ /* value of formula at epoch TAB97_START */
2866
+ B = (TAB97_START - 1735) * 0.01;
2867
+ ans3 = -20 + 35 * B * B;
2868
+ ans3 = adjust_for_tidacc(ans3, Y, tid_acc, SE_TIDAL_26, FALSE);
2869
+ dd = ans3 - ans2;
2870
+ B = (Y - (TAB97_START - 100)) * 0.01;
2871
+ /* fit to starting point of table dt97. */
2872
+ ans = ans - dd * B;
2873
+ }
2874
+ }
2875
+ /* between -500 and 1600:
2876
+ * linear interpolation between values of table dt97 (Stephenson 1997) */
2877
+ if (Y >= TAB97_START && Y < TAB2_END) {
2878
+ p = floor(Y);
2879
+ iy = (int) ((p - TAB97_START) / 50.0);
2880
+ dd = (Y - (TAB97_START + 50 * iy)) / 50.0;
2881
+ ans = dt97[iy] + (dt97[iy+1] - dt97[iy]) * dd;
2882
+ /* correction for tidal acceleration used by our ephemeris */
2883
+ ans = adjust_for_tidacc(ans, Y, tid_acc, SE_TIDAL_26, FALSE);
2884
+ }
2885
+ ans /= 86400.0;
2886
+ return ans;
2887
+ }
2888
+
2889
+ /* Stephenson & Morrison (2004) */
2890
+ static double deltat_stephenson_morrison_2004_1600(double tjd, double tid_acc)
2891
+ {
2892
+ double ans = 0, ans2, ans3;
2893
+ double p, B, dd;
2894
+ double tjd0;
2895
+ int iy;
2896
+ double Y = 2000.0 + (tjd - J2000)/365.2425;
2897
+ /* double Y = 2000.0 + (tjd - J2000)/365.25;*/
2898
+ /* before -1000:
2899
+ * formula by Stephenson & Morrison (2004; p. 335) but adjusted to fit the
2900
+ * starting point of table dt2. */
2901
+ if( Y < TAB2_START ) { // before -1000
2902
+ ans = deltat_longterm_morrison_stephenson(tjd);
2903
+ ans = adjust_for_tidacc(ans, Y, tid_acc, SE_TIDAL_26, FALSE);
2904
+ /* transition from formula to table over 100 years */
2905
+ if (Y >= TAB2_START - 100) {
2906
+ /* starting value of table dt2: */
2907
+ ans2 = adjust_for_tidacc(dt2[0], TAB2_START, tid_acc, SE_TIDAL_26, FALSE);
2908
+ /* value of formula at epoch TAB2_START */
2909
+ /* B = (TAB2_START - LTERM_EQUATION_YSTART) * 0.01;
2910
+ ans3 = -20 + LTERM_EQUATION_COEFF * B * B;*/
2911
+ tjd0 = (TAB2_START - 2000) * 365.2425 + J2000;
2912
+ ans3 = deltat_longterm_morrison_stephenson(tjd0);
2913
+ ans3 = adjust_for_tidacc(ans3, Y, tid_acc, SE_TIDAL_26, FALSE);
2914
+ dd = ans3 - ans2;
2915
+ B = (Y - (TAB2_START - 100)) * 0.01;
2916
+ /* fit to starting point of table dt2. */
2917
+ ans = ans - dd * B;
2918
+ }
2919
+ }
2920
+ /* between -1000 and 1600:
2921
+ * linear interpolation between values of table dt2 (Stephenson & Morrison 2004) */
2922
+ if (Y >= TAB2_START && Y < TAB2_END) {
2923
+ double Yjul = 2000 + (tjd - 2451557.5) / 365.25;
2924
+ p = floor(Yjul);
2925
+ iy = (int) ((p - TAB2_START) / TAB2_STEP);
2926
+ dd = (Yjul - (TAB2_START + TAB2_STEP * iy)) / TAB2_STEP;
2927
+ ans = dt2[iy] + (dt2[iy+1] - dt2[iy]) * dd;
2928
+ /* correction for tidal acceleration used by our ephemeris */
2929
+ ans = adjust_for_tidacc(ans, Y, tid_acc, SE_TIDAL_26, FALSE);
2930
+ }
2931
+ ans /= 86400.0;
2932
+ return ans;
2933
+ }
2934
+
2935
+ /*
2936
+ * These coefficients represent the spline approximation discussed in the
2937
+ * paper "Measurement of the Earth's Rotation: 720 BC to AD 2015",
2938
+ * Stephenson, F.R., Morrison, L.V., and Hohenkerk, C.Y., published by
2939
+ * Royal Society Proceedings A and available from their website at
2940
+ * http://rspa.royalsocietypublishing.org/lookup/doi/10.1098/rspa.2016.0404.
2941
+ * Year numbers have been replaced by Julian day numbers by D. Koch.
2942
+ */
2943
+ #define NDTCF16 54
2944
+ double dtcf16[NDTCF16][6] =
2945
+ {
2946
+ /*00*/ {1458085.5, 1867156.5, 20550.593,-21268.478, 11863.418, -4541.129}, /* ybeg=-720, yend= 400 */
2947
+ /*01*/ {1867156.5, 2086302.5, 6604.404, -5981.266, -505.093, 1349.609}, /* ybeg= 400, yend=1000 */
2948
+ /*02*/ {2086302.5, 2268923.5, 1467.654, -2452.187, 2460.927, -1183.759}, /* ybeg=1000, yend=1500 */
2949
+ /*03*/ {2268923.5, 2305447.5, 292.635, -216.322, -43.614, 56.681}, /* ybeg=1500, yend=1600 */
2950
+ /*04*/ {2305447.5, 2323710.5, 89.380, -66.754, 31.607, -10.497}, /* ybeg=1600, yend=1650 */
2951
+ /*05*/ {2323710.5, 2349276.5, 43.736, -49.043, 0.227, 15.811}, /* ybeg=1650, yend=1720 */
2952
+ /*06*/ {2349276.5, 2378496.5, 10.730, -1.321, 62.250, -52.946}, /* ybeg=1720, yend=1800 */
2953
+ /*07*/ {2378496.5, 2382148.5, 18.714, -4.457, -1.509, 2.507}, /* ybeg=1800, yend=1810 */
2954
+ /*08*/ {2382148.5, 2385800.5, 15.255, 0.046, 6.012, -4.634}, /* ybeg=1810, yend=1820 */
2955
+ /*09*/ {2385800.5, 2389453.5, 16.679, -1.831, -7.889, 3.799}, /* ybeg=1820, yend=1830 */
2956
+ /*10*/ {2389453.5, 2393105.5, 10.758, -6.211, 3.509, -0.388}, /* ybeg=1830, yend=1840 */
2957
+ /*11*/ {2393105.5, 2396758.5, 7.668, -0.357, 2.345, -0.338}, /* ybeg=1840, yend=1850 */
2958
+ /*12*/ {2396758.5, 2398584.5, 9.317, 1.659, 0.332, -0.932}, /* ybeg=1850, yend=1855 */
2959
+ /*13*/ {2398584.5, 2400410.5, 10.376, -0.472, -2.463, 1.596}, /* ybeg=1855, yend=1860 */
2960
+ /*14*/ {2400410.5, 2402237.5, 9.038, -0.610, 2.325, -2.497}, /* ybeg=1860, yend=1865 */
2961
+ /*15*/ {2402237.5, 2404063.5, 8.256, -3.450, -5.166, 2.729}, /* ybeg=1865, yend=1870 */
2962
+ /*16*/ {2404063.5, 2405889.5, 2.369, -5.596, 3.020, -0.919}, /* ybeg=1870, yend=1875 */
2963
+ /*17*/ {2405889.5, 2407715.5, -1.126, -2.312, 0.264, -0.037}, /* ybeg=1875, yend=1880 */
2964
+ /*18*/ {2407715.5, 2409542.5, -3.211, -1.894, 0.154, 0.562}, /* ybeg=1880, yend=1885 */
2965
+ /*19*/ {2409542.5, 2411368.5, -4.388, 0.101, 1.841, -1.438}, /* ybeg=1885, yend=1890 */
2966
+ /*20*/ {2411368.5, 2413194.5, -3.884, -0.531, -2.473, 1.870}, /* ybeg=1890, yend=1895 */
2967
+ /*21*/ {2413194.5, 2415020.5, -5.017, 0.134, 3.138, -0.232}, /* ybeg=1895, yend=1900 */
2968
+ /*22*/ {2415020.5, 2416846.5, -1.977, 5.715, 2.443, -1.257}, /* ybeg=1900, yend=1905 */
2969
+ /*23*/ {2416846.5, 2418672.5, 4.923, 6.828, -1.329, 0.720}, /* ybeg=1905, yend=1910 */
2970
+ /*24*/ {2418672.5, 2420498.5, 11.142, 6.330, 0.831, -0.825}, /* ybeg=1910, yend=1915 */
2971
+ /*25*/ {2420498.5, 2422324.5, 17.479, 5.518, -1.643, 0.262}, /* ybeg=1915, yend=1920 */
2972
+ /*26*/ {2422324.5, 2424151.5, 21.617, 3.020, -0.856, 0.008}, /* ybeg=1920, yend=1925 */
2973
+ /*27*/ {2424151.5, 2425977.5, 23.789, 1.333, -0.831, 0.127}, /* ybeg=1925, yend=1930 */
2974
+ /*28*/ {2425977.5, 2427803.5, 24.418, 0.052, -0.449, 0.142}, /* ybeg=1930, yend=1935 */
2975
+ /*29*/ {2427803.5, 2429629.5, 24.164, -0.419, -0.022, 0.702}, /* ybeg=1935, yend=1940 */
2976
+ /*30*/ {2429629.5, 2431456.5, 24.426, 1.645, 2.086, -1.106}, /* ybeg=1940, yend=1945 */
2977
+ /*31*/ {2431456.5, 2433282.5, 27.050, 2.499, -1.232, 0.614}, /* ybeg=1945, yend=1950 */
2978
+ /*32*/ {2433282.5, 2434378.5, 28.932, 1.127, 0.220, -0.277}, /* ybeg=1950, yend=1953 */
2979
+ /*33*/ {2434378.5, 2435473.5, 30.002, 0.737, -0.610, 0.631}, /* ybeg=1953, yend=1956 */
2980
+ /*34*/ {2435473.5, 2436569.5, 30.760, 1.409, 1.282, -0.799}, /* ybeg=1956, yend=1959 */
2981
+ /*35*/ {2436569.5, 2437665.5, 32.652, 1.577, -1.115, 0.507}, /* ybeg=1959, yend=1962 */
2982
+ /*36*/ {2437665.5, 2438761.5, 33.621, 0.868, 0.406, 0.199}, /* ybeg=1962, yend=1965 */
2983
+ /*37*/ {2438761.5, 2439856.5, 35.093, 2.275, 1.002, -0.414}, /* ybeg=1965, yend=1968 */
2984
+ /*38*/ {2439856.5, 2440952.5, 37.956, 3.035, -0.242, 0.202}, /* ybeg=1968, yend=1971 */
2985
+ /*39*/ {2440952.5, 2442048.5, 40.951, 3.157, 0.364, -0.229}, /* ybeg=1971, yend=1974 */
2986
+ /*40*/ {2442048.5, 2443144.5, 44.244, 3.198, -0.323, 0.172}, /* ybeg=1974, yend=1977 */
2987
+ /*41*/ {2443144.5, 2444239.5, 47.291, 3.069, 0.193, -0.192}, /* ybeg=1977, yend=1980 */
2988
+ /*42*/ {2444239.5, 2445335.5, 50.361, 2.878, -0.384, 0.081}, /* ybeg=1980, yend=1983 */
2989
+ /*43*/ {2445335.5, 2446431.5, 52.936, 2.354, -0.140, -0.166}, /* ybeg=1983, yend=1986 */
2990
+ /*44*/ {2446431.5, 2447527.5, 54.984, 1.577, -0.637, 0.448}, /* ybeg=1986, yend=1989 */
2991
+ /*45*/ {2447527.5, 2448622.5, 56.373, 1.649, 0.709, -0.277}, /* ybeg=1989, yend=1992 */
2992
+ /*46*/ {2448622.5, 2449718.5, 58.453, 2.235, -0.122, 0.111}, /* ybeg=1992, yend=1995 */
2993
+ /*47*/ {2449718.5, 2450814.5, 60.677, 2.324, 0.212, -0.315}, /* ybeg=1995, yend=1998 */
2994
+ /*48*/ {2450814.5, 2451910.5, 62.899, 1.804, -0.732, 0.112}, /* ybeg=1998, yend=2001 */
2995
+ /*49*/ {2451910.5, 2453005.5, 64.082, 0.675, -0.396, 0.193}, /* ybeg=2001, yend=2004 */
2996
+ /*50*/ {2453005.5, 2454101.5, 64.555, 0.463, 0.184, -0.008}, /* ybeg=2004, yend=2007 */
2997
+ /*51*/ {2454101.5, 2455197.5, 65.194, 0.809, 0.161, -0.101}, /* ybeg=2007, yend=2010 */
2998
+ /*52*/ {2455197.5, 2456293.5, 66.063, 0.828, -0.142, 0.168}, /* ybeg=2010, yend=2013 */
2999
+ /*53*/ {2456293.5, 2457388.5, 66.917, 1.046, 0.360, -0.282}, /* ybeg=2013, yend=2016 */
3000
+ };
3001
+ static double deltat_stephenson_etc_2016(double tjd, double tid_acc)
3002
+ {
3003
+ double t, dt, Ygreg;
3004
+ int i, irec = -1;
3005
+ Ygreg = 2000.0 + (tjd - J2000)/365.2425;
3006
+ // after the year -720 get value from spline curve
3007
+ for (i = 0; i < NDTCF16; i++) {
3008
+ if (tjd < dtcf16[i][0]) break;
3009
+ if (tjd < dtcf16[i][1]) {
3010
+ irec = i;
3011
+ break;
3012
+ }
3013
+ }
3014
+ if (irec >= 0) {
3015
+ t = (tjd - dtcf16[irec][0]) / (dtcf16[irec][1] - dtcf16[irec][0]);
3016
+ dt = dtcf16[irec][2] + dtcf16[irec][3] * t + dtcf16[irec][4] * t * t + dtcf16[irec][5] * t * t * t;
3017
+ // for earlier epochs, use long term parabola
3018
+ } else if (Ygreg < -720) {
3019
+ t = (Ygreg - 1825) / 100.0;
3020
+ dt = -320 + 32.5 * t * t;
3021
+ dt -= 179.7337208; // to make curve continous on 1 Jan -720 (D. Koch)
3022
+ // future
3023
+ } else {
3024
+ t = (Ygreg - 1825) / 100.0;
3025
+ dt = -320 + 32.5 * t * t;
3026
+ dt += 269.4790417; // to make curve continous on 1 Jan 2016 (D. Koch)
3027
+ }
3028
+ /* The parameter adjust_after_1955 must be TRUE here, because the
3029
+ * Stephenson 2016 curve is based on occultation data alone,
3030
+ * not on IERS data.
3031
+ * Note, however, the current function deltat_stephenson_etc_2016()
3032
+ * is called only for dates before 1 Jan 1955. */
3033
+ dt = adjust_for_tidacc(dt, Ygreg, tid_acc, SE_TIDAL_STEPHENSON_2016, TRUE);
3034
+ dt /= 86400.0;
3035
+ return dt;
3036
+ }
3037
+
3038
+ static double deltat_espenak_meeus_1620(double tjd, double tid_acc)
3039
+ {
3040
+ double ans = 0;
3041
+ double Ygreg;
3042
+ double u;
3043
+ /* double Y = 2000.0 + (tjd - J2000)/365.25;*/
3044
+ Ygreg = 2000.0 + (tjd - J2000)/365.2425;
3045
+ if (Ygreg < -500) {
3046
+ ans = deltat_longterm_morrison_stephenson(tjd);
3047
+ } else if (Ygreg < 500) {
3048
+ u = Ygreg / 100.0;
3049
+ ans = (((((0.0090316521 * u + 0.022174192) * u - 0.1798452) * u - 5.952053) * u+ 33.78311) * u - 1014.41) * u + 10583.6;
3050
+ } else if (Ygreg < 1600) {
3051
+ u = (Ygreg - 1000) / 100.0;
3052
+ ans = (((((0.0083572073 * u - 0.005050998) * u - 0.8503463) * u + 0.319781) * u + 71.23472) * u - 556.01) * u + 1574.2;
3053
+ } else if (Ygreg < 1700) {
3054
+ u = Ygreg - 1600;
3055
+ ans = 120 - 0.9808 * u - 0.01532 * u * u + u * u * u / 7129.0;
3056
+ } else if (Ygreg < 1800) {
3057
+ u = Ygreg - 1700;
3058
+ ans = (((-u / 1174000.0 + 0.00013336) * u - 0.0059285) * u + 0.1603) * u + 8.83;
3059
+ } else if (Ygreg < 1860) {
3060
+ u = Ygreg - 1800;
3061
+ ans = ((((((0.000000000875 * u - 0.0000001699) * u + 0.0000121272) * u - 0.00037436) * u + 0.0041116) * u + 0.0068612) * u - 0.332447) * u + 13.72;
3062
+ } else if (Ygreg < 1900) {
3063
+ u = Ygreg - 1860;
3064
+ ans = ((((u / 233174.0 - 0.0004473624) * u + 0.01680668) * u - 0.251754) * u + 0.5737) * u + 7.62;
3065
+ } else if (Ygreg < 1920) {
3066
+ u = Ygreg - 1900;
3067
+ ans = (((-0.000197 * u + 0.0061966) * u - 0.0598939) * u + 1.494119) * u -2.79;
3068
+ } else if (Ygreg < 1941) {
3069
+ u = Ygreg - 1920;
3070
+ ans = 21.20 + 0.84493 * u - 0.076100 * u * u + 0.0020936 * u * u * u;
3071
+ } else if (Ygreg < 1961) {
3072
+ u = Ygreg - 1950;
3073
+ ans = 29.07 + 0.407 * u - u * u / 233.0 + u * u * u / 2547.0;
3074
+ } else if (Ygreg < 1986) {
3075
+ u = Ygreg - 1975;
3076
+ ans = 45.45 + 1.067 * u - u * u / 260.0 - u * u * u / 718.0;
3077
+ } else if (Ygreg < 2005) {
3078
+ u = Ygreg - 2000;
3079
+ ans = ((((0.00002373599 * u + 0.000651814) * u + 0.0017275) * u - 0.060374) * u + 0.3345) * u + 63.86;
3080
+ }
3081
+ ans = adjust_for_tidacc(ans, Ygreg, tid_acc, SE_TIDAL_26, FALSE);
3082
+ ans /= 86400.0;
3083
+ return ans;
3084
+ }
3085
+
3086
+ /* Read delta t values from external file.
3087
+ * record structure: year(whitespace)delta_t in 0.01 sec.
3088
+ */
3089
+ static int init_dt(void)
3090
+ {
3091
+ FILE *fp;
3092
+ int year;
3093
+ int tab_index;
3094
+ int tabsiz;
3095
+ int i;
3096
+ char s[AS_MAXCH];
3097
+ char *sp;
3098
+ if (!swed.init_dt_done) {
3099
+ swed.init_dt_done = TRUE;
3100
+ /* no error message if file is missing */
3101
+ if ((fp = swi_fopen(-1, "swe_deltat.txt", swed.ephepath, NULL)) == NULL
3102
+ && (fp = swi_fopen(-1, "sedeltat.txt", swed.ephepath, NULL)) == NULL)
3103
+ return TABSIZ;
3104
+ while(fgets(s, AS_MAXCH, fp) != NULL) {
3105
+ sp = s;
3106
+ while (strchr(" \t", *sp) != NULL && *sp != '\0')
3107
+ sp++; /* was *sp++ fixed by Alois 2-jul-2003 */
3108
+ if (*sp == '#' || *sp == '\n')
3109
+ continue;
3110
+ year = atoi(s);
3111
+ tab_index = year - TABSTART;
3112
+ /* table space is limited. no error msg, if exceeded */
3113
+ if (tab_index >= TABSIZ_SPACE)
3114
+ continue;
3115
+ sp += 4;
3116
+ while (strchr(" \t", *sp) != NULL && *sp != '\0')
3117
+ sp++; /* was *sp++ fixed by Alois 2-jul-2003 */
3118
+ /*dt[tab_index] = (short) (atof(sp) * 100 + 0.5);*/
3119
+ dt[tab_index] = atof(sp);
3120
+ }
3121
+ fclose(fp);
3122
+ }
3123
+ /* find table size */
3124
+ tabsiz = 2001 - TABSTART + 1;
3125
+ for (i = tabsiz - 1; i < TABSIZ_SPACE; i++) {
3126
+ if (dt[i] == 0)
3127
+ break;
3128
+ else
3129
+ tabsiz++;
3130
+ }
3131
+ tabsiz--;
3132
+ return tabsiz;
3133
+ }
3134
+
3135
+ /* Astronomical Almanac table is corrected by adding the expression
3136
+ * -0.000091 (ndot + 26)(year-1955)^2 seconds
3137
+ * to entries prior to 1955 (AA page K8), where ndot is the secular
3138
+ * tidal term in the mean motion of the Moon.
3139
+ *
3140
+ * Entries after 1955 are referred to atomic time standards and
3141
+ * are not affected by errors in Lunar or planetary theory.
3142
+ */
3143
+ static double adjust_for_tidacc(double ans, double Y, double tid_acc, double tid_acc0, AS_BOOL adjust_after_1955)
3144
+ {
3145
+ double B;
3146
+ if( Y < 1955.0 || adjust_after_1955) {
3147
+ B = (Y - 1955.0);
3148
+ ans += -0.000091 * (tid_acc - tid_acc0) * B * B;
3149
+ }
3150
+ return ans;
3151
+ }
3152
+
3153
+ /* returns tidal acceleration used in swe_deltat() and swe_deltat_ex() */
3154
+ double CALL_CONV swe_get_tid_acc()
3155
+ {
3156
+ return swed.tid_acc;
3157
+ }
3158
+
3159
+ /* function sets tidal acceleration of the Moon.
3160
+ * t_acc can be either
3161
+ * - the value of the tidal acceleration in arcsec/cty^2
3162
+ * of the Moon will be set consistent with that ephemeris.
3163
+ * - SE_TIDAL_AUTOMATIC,
3164
+ */
3165
+ void CALL_CONV swe_set_tid_acc(double t_acc)
3166
+ {
3167
+ if (t_acc == SE_TIDAL_AUTOMATIC) {
3168
+ swed.tid_acc = SE_TIDAL_DEFAULT;
3169
+ swed.is_tid_acc_manual = FALSE;
3170
+ return;
3171
+ }
3172
+ swed.tid_acc = t_acc;
3173
+ swed.is_tid_acc_manual = TRUE;
3174
+ }
3175
+
3176
+ void CALL_CONV swe_set_delta_t_userdef(double dt)
3177
+ {
3178
+ if (dt == SE_DELTAT_AUTOMATIC) {
3179
+ swed.delta_t_userdef_is_set = FALSE;
3180
+ } else {
3181
+ swed.delta_t_userdef_is_set = TRUE;
3182
+ swed.delta_t_userdef = dt;
3183
+ }
3184
+ }
3185
+
3186
+ int32 swi_guess_ephe_flag()
3187
+ {
3188
+ int32 iflag = SEFLG_SWIEPH;
3189
+ /* if jpl file is open, assume SEFLG_JPLEPH */
3190
+ if (swed.jpl_file_is_open) {
3191
+ iflag = SEFLG_JPLEPH;
3192
+ } else {
3193
+ iflag = SEFLG_SWIEPH;
3194
+ }
3195
+ return iflag;
3196
+ }
3197
+
3198
+ int32 swi_get_tid_acc(double tjd_ut, int32 iflag, int32 denum, int32 *denumret, double *tid_acc, char *serr)
3199
+ {
3200
+ iflag &= SEFLG_EPHMASK;
3201
+ if (swed.is_tid_acc_manual) {
3202
+ *tid_acc = swed.tid_acc;
3203
+ return iflag;
3204
+ }
3205
+ if (denum == 0) {
3206
+ if (iflag & SEFLG_MOSEPH) {
3207
+ *tid_acc = SE_TIDAL_DE404;
3208
+ *denumret = 404;
3209
+ return iflag;
3210
+ }
3211
+ if (iflag & SEFLG_JPLEPH) {
3212
+ if (swed.jpl_file_is_open) {
3213
+ denum = swed.jpldenum;
3214
+ }
3215
+ }
3216
+ /* SEFLG_SWIEPH wanted or SEFLG_JPLEPH failed: */
3217
+ if (iflag & SEFLG_SWIEPH) {
3218
+ if (swed.fidat[SEI_FILE_MOON].fptr != NULL) {
3219
+ denum = swed.fidat[SEI_FILE_MOON].sweph_denum;
3220
+ }
3221
+ }
3222
+ }
3223
+ switch(denum) {
3224
+ case 200: *tid_acc = SE_TIDAL_DE200; break;
3225
+ case 403: *tid_acc = SE_TIDAL_DE403; break;
3226
+ case 404: *tid_acc = SE_TIDAL_DE404; break;
3227
+ case 405: *tid_acc = SE_TIDAL_DE405; break;
3228
+ case 406: *tid_acc = SE_TIDAL_DE406; break;
3229
+ case 421: *tid_acc = SE_TIDAL_DE421; break;
3230
+ case 422: *tid_acc = SE_TIDAL_DE422; break;
3231
+ case 430: *tid_acc = SE_TIDAL_DE430; break;
3232
+ case 431: *tid_acc = SE_TIDAL_DE431; break;
3233
+ case 440: *tid_acc = SE_TIDAL_DE441; break;
3234
+ case 441: *tid_acc = SE_TIDAL_DE441; break;
3235
+ default: denum = SE_DE_NUMBER; *tid_acc = SE_TIDAL_DEFAULT; break;
3236
+ }
3237
+ *denumret = denum;
3238
+ iflag &= SEFLG_EPHMASK;
3239
+ return iflag;
3240
+ }
3241
+
3242
+ int32 swi_set_tid_acc(double tjd_ut, int32 iflag, int32 denum, char *serr)
3243
+ {
3244
+ int32 retc = iflag;
3245
+ int32 denumret;
3246
+ /* manual tid_acc overrides automatic tid_acc */
3247
+ if (swed.is_tid_acc_manual)
3248
+ return retc;
3249
+ retc = swi_get_tid_acc(tjd_ut, iflag, denum, &denumret, &(swed.tid_acc), serr);
3250
+ #if TRACE
3251
+ swi_open_trace(NULL);
3252
+ if (swi_trace_count < TRACE_COUNT_MAX) {
3253
+ if (swi_fp_trace_c != NULL) {
3254
+ fputs("\n/*SWE_SET_TID_ACC*/\n", swi_fp_trace_c);
3255
+ fprintf(swi_fp_trace_c, " t = %.9f;\n", swed.tid_acc);
3256
+ fprintf(swi_fp_trace_c, " swe_set_tid_acc(t);\n");
3257
+ fputs(" printf(\"swe_set_tid_acc: %f\\t\\n\", ", swi_fp_trace_c);
3258
+ fputs("t);\n", swi_fp_trace_c);
3259
+ fflush(swi_fp_trace_c);
3260
+ }
3261
+ if (swi_fp_trace_out != NULL) {
3262
+ fprintf(swi_fp_trace_out, "swe_set_tid_acc: %f\t\n", swed.tid_acc);
3263
+ fflush(swi_fp_trace_out);
3264
+ }
3265
+ }
3266
+ #endif
3267
+ return retc;
3268
+ }
3269
+
3270
+ /*
3271
+ * The time range of DE431 requires a new calculation of sidereal time that
3272
+ * gives sensible results for the remote past and future.
3273
+ * The algorithm is based on the formula of the mean earth by Simon & alii,
3274
+ * "Precession formulae and mean elements for the Moon and the Planets",
3275
+ * A&A 282 (1994), p. 675/678.
3276
+ * The longitude of the mean earth relative to the mean equinox J2000
3277
+ * is calculated and then precessed to the equinox of date, using the
3278
+ * default precession model of the Swiss Ephmeris. Afte that,
3279
+ * sidereal time is derived.
3280
+ * The algoritm provides exact agreement for epoch 1 Jan. 2003 with the
3281
+ * definition of sidereal time as given in the IERS Convention 2010.
3282
+ */
3283
+ /*#define SIDT_LTERM TRUE
3284
+ #if SIDT_LTERM*/
3285
+ static double sidtime_long_term(double tjd_ut, double eps, double nut)
3286
+ {
3287
+ double tsid = 0, tjd_et;
3288
+ double dlon, xs[6], xobl[6], dhour, nutlo[2];
3289
+ double dlt = AUNIT / CLIGHT / 86400.0;
3290
+ double t, t2, t3;
3291
+ tjd_et = tjd_ut + swe_deltat_ex(tjd_ut, -1, NULL);
3292
+ t = (tjd_et - J2000) / 365250.0;
3293
+ t2 = t * t; t3 = t * t2;
3294
+ /* mean longitude of earth J2000 */
3295
+ dlon = 100.46645683 + (1295977422.83429 * t - 2.04411 * t2 - 0.00523 * t3) / 3600.0;
3296
+ /* light time sun-earth */
3297
+ dlon = swe_degnorm(dlon - dlt * 360.0 / 365.2425);
3298
+ xs[0] = dlon * DEGTORAD; xs[1] = 0; xs[2] = 1;
3299
+ /* to mean equator J2000, cartesian */
3300
+ xobl[0] = 23.45; xobl[1] = 23.45;
3301
+ xobl[1] = swi_epsiln(J2000 + swe_deltat_ex(J2000, -1, NULL), 0) * RADTODEG;
3302
+ swi_polcart(xs, xs);
3303
+ swi_coortrf(xs, xs, -xobl[1] * DEGTORAD);
3304
+ /* precess to mean equinox of date */
3305
+ swi_precess(xs, tjd_et, 0, -1);
3306
+ /* to mean equinox of date */
3307
+ xobl[1] = swi_epsiln(tjd_et, 0) * RADTODEG;
3308
+ swi_nutation(tjd_et, 0, nutlo);
3309
+ xobl[0] = xobl[1] + nutlo[1] * RADTODEG;
3310
+ xobl[2] = nutlo[0] * RADTODEG;
3311
+ swi_coortrf(xs, xs, xobl[1] * DEGTORAD);
3312
+ swi_cartpol(xs, xs);
3313
+ xs[0] *= RADTODEG;
3314
+ dhour = fmod(tjd_ut - 0.5, 1) * 360;
3315
+ /* mean to true (if nut != 0) */
3316
+ if (eps == 0)
3317
+ xs[0] += xobl[2] * cos(xobl[0] * DEGTORAD);
3318
+ else
3319
+ xs[0] += nut * cos(eps * DEGTORAD);
3320
+ /* add hour */
3321
+ xs[0] = swe_degnorm(xs[0] + dhour);
3322
+ tsid = xs[0] / 15;
3323
+ return tsid;
3324
+ }
3325
+ /*#endif*/
3326
+
3327
+ /* Apparent Sidereal Time at Greenwich with equation of the equinoxes
3328
+ * ERA-based expression for for Greenwich Sidereal Time (GST) based
3329
+ * on the IAU 2006 precession and IAU 2000A_R06 nutation
3330
+ * ftp://maia.usno.navy.mil/conv2010/chapter5/tab5.2e.txt
3331
+ *
3332
+ * returns sidereal time in hours.
3333
+ *
3334
+ * program returns sidereal hours since sidereal midnight
3335
+ * tjd julian day UT
3336
+ * eps obliquity of ecliptic, degrees
3337
+ * nut nutation, degrees
3338
+ */
3339
+ /* C'_{s,j})_i C'_{c,j})_i */
3340
+ #define SIDTNTERM 33
3341
+ static const double stcf[SIDTNTERM * 2] = {
3342
+ 2640.96,-0.39,
3343
+ 63.52,-0.02,
3344
+ 11.75,0.01,
3345
+ 11.21,0.01,
3346
+ -4.55,0.00,
3347
+ 2.02,0.00,
3348
+ 1.98,0.00,
3349
+ -1.72,0.00,
3350
+ -1.41,-0.01,
3351
+ -1.26,-0.01,
3352
+ -0.63,0.00,
3353
+ -0.63,0.00,
3354
+ 0.46,0.00,
3355
+ 0.45,0.00,
3356
+ 0.36,0.00,
3357
+ -0.24,-0.12,
3358
+ 0.32,0.00,
3359
+ 0.28,0.00,
3360
+ 0.27,0.00,
3361
+ 0.26,0.00,
3362
+ -0.21,0.00,
3363
+ 0.19,0.00,
3364
+ 0.18,0.00,
3365
+ -0.10,0.05,
3366
+ 0.15,0.00,
3367
+ -0.14,0.00,
3368
+ 0.14,0.00,
3369
+ -0.14,0.00,
3370
+ 0.14,0.00,
3371
+ 0.13,0.00,
3372
+ -0.11,0.00,
3373
+ 0.11,0.00,
3374
+ 0.11,0.00,
3375
+ };
3376
+ #define SIDTNARG 14
3377
+ /* l l' F D Om L_Me L_Ve L_E L_Ma L_J L_Sa L_U L_Ne p_A*/
3378
+ static const int stfarg[SIDTNTERM * SIDTNARG] = {
3379
+ 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3380
+ 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3381
+ 0, 0, 2, -2, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3382
+ 0, 0, 2, -2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3383
+ 0, 0, 2, -2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3384
+ 0, 0, 2, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3385
+ 0, 0, 2, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3386
+ 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3387
+ 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3388
+ 0, 1, 0, 0, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3389
+ 1, 0, 0, 0, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3390
+ 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3391
+ 0, 1, 2, -2, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3392
+ 0, 1, 2, -2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3393
+ 0, 0, 4, -4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3394
+ 0, 0, 1, -1, 1, 0, -8, 12, 0, 0, 0, 0, 0, 0,
3395
+ 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3396
+ 0, 0, 2, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3397
+ 1, 0, 2, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3398
+ 1, 0, 2, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3399
+ 0, 0, 2, -2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3400
+ 0, 1, -2, 2, -3, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3401
+ 0, 1, -2, 2, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3402
+ 0, 0, 0, 0, 0, 0, 8, -13, 0, 0, 0, 0, 0, -1,
3403
+ 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3404
+ 2, 0, -2, 0, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3405
+ 1, 0, 0, -2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3406
+ 0, 1, 2, -2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3407
+ 1, 0, 0, -2, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3408
+ 0, 0, 4, -2, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3409
+ 0, 0, 2, -2, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3410
+ 1, 0, -2, 0, -3, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3411
+ 1, 0, -2, 0, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3412
+ };
3413
+ static double sidtime_non_polynomial_part(double tt)
3414
+ {
3415
+ int i, j;
3416
+ double delm[SIDTNARG];
3417
+ double dadd, darg;
3418
+ /* L Mean anomaly of the Moon.*/
3419
+ delm[0] = swe_radnorm(2.35555598 + 8328.6914269554 * tt);
3420
+ /* LSU Mean anomaly of the Sun.*/
3421
+ delm[1] = swe_radnorm(6.24006013 + 628.301955 * tt);
3422
+ /* F Mean argument of the latitude of the Moon. */
3423
+ delm[2] = swe_radnorm(1.627905234 + 8433.466158131 * tt);
3424
+ /* D Mean elongation of the Moon from the Sun. */
3425
+ delm[3] = swe_radnorm(5.198466741 + 7771.3771468121 * tt);
3426
+ /* OM Mean longitude of the ascending node of the Moon. */
3427
+ delm[4] = swe_radnorm(2.18243920 - 33.757045 * tt);
3428
+ /* Planetary longitudes, Mercury through Neptune (Souchay et al. 1999).
3429
+ * LME, LVE, LEA, LMA, LJU, LSA, LUR, LNE */
3430
+ delm[5] = swe_radnorm(4.402608842 + 2608.7903141574 * tt);
3431
+ delm[6] = swe_radnorm(3.176146697 + 1021.3285546211 * tt);
3432
+ delm[7] = swe_radnorm(1.753470314 + 628.3075849991 * tt);
3433
+ delm[8] = swe_radnorm(6.203480913 + 334.0612426700 * tt);
3434
+ delm[9] = swe_radnorm(0.599546497 + 52.9690962641 * tt);
3435
+ delm[10] = swe_radnorm(0.874016757 + 21.3299104960 * tt);
3436
+ delm[11] = swe_radnorm(5.481293871 + 7.4781598567 * tt);
3437
+ delm[12] = swe_radnorm(5.321159000 + 3.8127774000 * tt);
3438
+ /* PA General accumulated precession in longitude. */
3439
+ delm[13] = (0.02438175 + 0.00000538691 * tt) * tt;
3440
+ dadd = -0.87 * sin(delm[4]) * tt;
3441
+ for (i = 0; i < SIDTNTERM; i++) {
3442
+ darg = 0;
3443
+ for (j = 0; j < SIDTNARG; j++) {
3444
+ darg += stfarg[i * SIDTNARG + j] * delm[j];
3445
+ }
3446
+ dadd += stcf[i * 2] * sin(darg) + stcf[i * 2 + 1] * cos(darg);
3447
+ }
3448
+ dadd /= (3600.0 * 1000000.0);
3449
+ return dadd;
3450
+ }
3451
+
3452
+ /*
3453
+ * SEMOD_SIDT_IAU_2006
3454
+ * N. Capitaine, P.T. Wallace, and J. Chapront, "Expressions for IAU 2000
3455
+ * precession quantities", 2003, A&A 412, 567-586 (2003), p. 582.
3456
+ * This is a "short" term model, that can be combined with other models
3457
+ */
3458
+ /*#define SIDT_IERS_CONV_2010 TRUE*/
3459
+ /* sidtime_long_term() is not used between the following two dates */
3460
+ #define SIDT_LTERM_T0 2396758.5 /* 1 Jan 1850 */
3461
+ #define SIDT_LTERM_T1 2469807.5 /* 1 Jan 2050 */
3462
+ #define SIDT_LTERM_OFS0 (0.000378172 / 15.0)
3463
+ #define SIDT_LTERM_OFS1 (0.001385646 / 15.0)
3464
+ double CALL_CONV swe_sidtime0(double tjd, double eps, double nut)
3465
+ {
3466
+ double jd0; /* Julian day at midnight Universal Time */
3467
+ double secs; /* Time of day, UT seconds since UT midnight */
3468
+ double eqeq, jd, tu, tt, msday, jdrel;
3469
+ double gmst, dadd;
3470
+ int prec_model_short = swed.astro_models[SE_MODEL_PREC_SHORTTERM];
3471
+ int sidt_model = swed.astro_models[SE_MODEL_SIDT];
3472
+ if (prec_model_short == 0) prec_model_short = SEMOD_PREC_DEFAULT_SHORT;
3473
+ if (sidt_model == 0) sidt_model = SEMOD_SIDT_DEFAULT;
3474
+ swi_init_swed_if_start();
3475
+ if (sidt_model == SEMOD_SIDT_LONGTERM) {
3476
+ if (tjd <= SIDT_LTERM_T0 || tjd >= SIDT_LTERM_T1) {
3477
+ gmst = sidtime_long_term(tjd, eps, nut);
3478
+ if (tjd <= SIDT_LTERM_T0)
3479
+ gmst -= SIDT_LTERM_OFS0;
3480
+ else if (tjd >= SIDT_LTERM_T1)
3481
+ gmst -= SIDT_LTERM_OFS1;
3482
+ if (gmst >= 24) gmst -= 24;
3483
+ if (gmst < 0) gmst += 24;
3484
+ goto sidtime_done;
3485
+ }
3486
+ }
3487
+ /* Julian day at given UT */
3488
+ jd = tjd;
3489
+ jd0 = floor(jd);
3490
+ secs = tjd - jd0;
3491
+ if( secs < 0.5 ) {
3492
+ jd0 -= 0.5;
3493
+ secs += 0.5;
3494
+ } else {
3495
+ jd0 += 0.5;
3496
+ secs -= 0.5;
3497
+ }
3498
+ secs *= 86400.0;
3499
+ tu = (jd0 - J2000)/36525.0; /* UT1 in centuries after J2000 */
3500
+ if (sidt_model == SEMOD_SIDT_IERS_CONV_2010 || sidt_model == SEMOD_SIDT_LONGTERM) {
3501
+ /* ERA-based expression for Greenwich Sidereal Time (GST) based
3502
+ * on the IAU 2006 precession */
3503
+ jdrel = tjd - J2000;
3504
+ tt = (tjd + swe_deltat_ex(tjd, -1, NULL) - J2000) / 36525.0;
3505
+ gmst = swe_degnorm((0.7790572732640 + 1.00273781191135448 * jdrel) * 360);
3506
+ gmst += (0.014506 + tt * (4612.156534 + tt * (1.3915817 + tt * (-0.00000044 + tt * (-0.000029956 + tt * -0.0000000368))))) / 3600.0;
3507
+ dadd = sidtime_non_polynomial_part(tt);
3508
+ gmst = swe_degnorm(gmst + dadd);
3509
+ /*printf("gmst iers=%f \n", gmst);*/
3510
+ gmst = gmst / 15.0 * 3600.0;
3511
+ /* sidt_model == SEMOD_SIDT_IAU_2006, older standards according to precession model */
3512
+ } else if (sidt_model == SEMOD_SIDT_IAU_2006) {
3513
+ tt = (jd0 + swe_deltat_ex(jd0, -1, NULL) - J2000)/36525.0; /* TT in centuries after J2000 */
3514
+ gmst = (((-0.000000002454*tt - 0.00000199708)*tt - 0.0000002926)*tt + 0.092772110)*tt*tt + 307.4771013*(tt-tu) + 8640184.79447825*tu + 24110.5493771;
3515
+ /* mean solar days per sidereal day at date tu;
3516
+ * for the derivative of gmst, we can assume UT1 =~ TT */
3517
+ msday = 1 + ((((-0.000000012270*tt - 0.00000798832)*tt - 0.0000008778)*tt + 0.185544220)*tt + 8640184.79447825)/(86400.*36525.);
3518
+ gmst += msday * secs;
3519
+ /* SEMOD_SIDT_IAU_1976 */
3520
+ } else { /* IAU 1976 formula */
3521
+ /* Greenwich Mean Sidereal Time at 0h UT of date */
3522
+ gmst = (( -6.2e-6*tu + 9.3104e-2)*tu + 8640184.812866)*tu + 24110.54841;
3523
+ /* mean solar days per sidereal day at date tu, = 1.00273790934 in 1986 */
3524
+ msday = 1.0 + ((-1.86e-5*tu + 0.186208)*tu + 8640184.812866)/(86400.*36525.);
3525
+ gmst += msday * secs;
3526
+ }
3527
+ /* Local apparent sidereal time at given UT at Greenwich */
3528
+ eqeq = 240.0 * nut * cos(eps * DEGTORAD);
3529
+ gmst = gmst + eqeq /* + 240.0*tlong */;
3530
+ /* Sidereal seconds modulo 1 sidereal day */
3531
+ gmst = gmst - 86400.0 * floor( gmst/86400.0 );
3532
+ /* return in hours */
3533
+ gmst /= 3600;
3534
+ goto sidtime_done;
3535
+ sidtime_done:
3536
+ #ifdef TRACE
3537
+ swi_open_trace(NULL);
3538
+ if (swi_trace_count < TRACE_COUNT_MAX) {
3539
+ if (swi_fp_trace_c != NULL) {
3540
+ fputs("\n/*SWE_SIDTIME0*/\n", swi_fp_trace_c);
3541
+ fprintf(swi_fp_trace_c, " tjd = %.9f;", tjd);
3542
+ fprintf(swi_fp_trace_c, " eps = %.9f;", eps);
3543
+ fprintf(swi_fp_trace_c, " nut = %.9f;\n", nut);
3544
+ fprintf(swi_fp_trace_c, " t = swe_sidtime0(tjd, eps, nut);\n");
3545
+ fputs(" printf(\"swe_sidtime0: %f\\tsidt = %f\\teps = %f\\tnut = %f\\t\\n\", ", swi_fp_trace_c);
3546
+ fputs("tjd, t, eps, nut);\n", swi_fp_trace_c);
3547
+ fflush(swi_fp_trace_c);
3548
+ }
3549
+ if (swi_fp_trace_out != NULL) {
3550
+ fprintf(swi_fp_trace_out, "swe_sidtime0: %f\tsidt = %f\teps = %f\tnut = %f\t\n", tjd, gmst, eps, nut);
3551
+ fflush(swi_fp_trace_out);
3552
+ }
3553
+ }
3554
+ #endif
3555
+ return gmst;
3556
+ }
3557
+
3558
+ void CALL_CONV swe_set_interpolate_nut(AS_BOOL do_interpolate)
3559
+ {
3560
+ if (swed.do_interpolate_nut == do_interpolate)
3561
+ return;
3562
+ if (do_interpolate)
3563
+ swed.do_interpolate_nut = TRUE;
3564
+ else
3565
+ swed.do_interpolate_nut = FALSE;
3566
+ swed.interpol.tjd_nut0 = 0;
3567
+ swed.interpol.tjd_nut2 = 0;
3568
+ swed.interpol.nut_dpsi0 = 0;
3569
+ swed.interpol.nut_dpsi1 = 0;
3570
+ swed.interpol.nut_dpsi2 = 0;
3571
+ swed.interpol.nut_deps0 = 0;
3572
+ swed.interpol.nut_deps1 = 0;
3573
+ swed.interpol.nut_deps2 = 0;
3574
+ }
3575
+
3576
+ /* sidereal time, without eps and nut as parameters.
3577
+ * tjd must be UT !!!
3578
+ * for more informsation, see comment with swe_sidtime0()
3579
+ */
3580
+ double CALL_CONV swe_sidtime(double tjd_ut)
3581
+ {
3582
+ int i;
3583
+ double eps, nutlo[2], tsid;
3584
+ double tjde;
3585
+ /* delta t adjusted to default tidal acceleration of the moon */
3586
+ tjde = tjd_ut + swe_deltat_ex(tjd_ut, -1, NULL);
3587
+ swi_init_swed_if_start();
3588
+ eps = swi_epsiln(tjde, 0) * RADTODEG;
3589
+ swi_nutation(tjde, 0, nutlo);
3590
+ for (i = 0; i < 2; i++)
3591
+ nutlo[i] *= RADTODEG;
3592
+ tsid = swe_sidtime0(tjd_ut, eps + nutlo[1], nutlo[0]);
3593
+ return tsid;
3594
+ }
3595
+
3596
+ /* SWISSEPH
3597
+ * generates name of ephemeris file
3598
+ * file name looks as follows:
3599
+ * swephpl.m30, where
3600
+ *
3601
+ * "sweph" "swiss ephemeris"
3602
+ * "pl","mo","as" planet, moon, or asteroid
3603
+ * "m" or "_" BC or AD
3604
+ *
3605
+ * "30" start century
3606
+ * tjd = ephemeris file for which julian day
3607
+ * ipli = number of planet
3608
+ * fname = ephemeris file name
3609
+ */
3610
+ void swi_gen_filename(double tjd, int ipli, char *fname)
3611
+ {
3612
+ int icty;
3613
+ int ncties = (int) NCTIES;
3614
+ short gregflag;
3615
+ int jmon, jday, jyear, sgn;
3616
+ double jut;
3617
+ char *sform;
3618
+ switch(ipli) {
3619
+ case SEI_MOON:
3620
+ strcpy(fname, "semo");
3621
+ break;
3622
+ case SEI_EMB:
3623
+ case SEI_MERCURY:
3624
+ case SEI_VENUS:
3625
+ case SEI_MARS:
3626
+ case SEI_JUPITER:
3627
+ case SEI_SATURN:
3628
+ case SEI_URANUS:
3629
+ case SEI_NEPTUNE:
3630
+ case SEI_PLUTO:
3631
+ case SEI_SUNBARY:
3632
+ strcpy(fname, "sepl");
3633
+ break;
3634
+ case SEI_CERES:
3635
+ case SEI_PALLAS:
3636
+ case SEI_JUNO:
3637
+ case SEI_VESTA:
3638
+ case SEI_CHIRON:
3639
+ case SEI_PHOLUS:
3640
+ strcpy(fname, "seas");
3641
+ break;
3642
+ default: /* asteroid or planetary moon */
3643
+ if (ipli > SE_PLMOON_OFFSET && ipli < SE_AST_OFFSET) {
3644
+ sprintf(fname, "sat%ssepm%d.%s", DIR_GLUE, ipli, SE_FILE_SUFFIX);
3645
+ } else {
3646
+ sform = "ast%d%sse%05d.%s";
3647
+ if (ipli - SE_AST_OFFSET > 99999)
3648
+ sform = "ast%d%ss%06d.%s";
3649
+ sprintf(fname, sform, (ipli - SE_AST_OFFSET) / 1000, DIR_GLUE, ipli - SE_AST_OFFSET, SE_FILE_SUFFIX);
3650
+ }
3651
+ return; /* asteroids or planetary moons: only one file 3000 bc - 3000 ad */
3652
+ /* break; */
3653
+ }
3654
+ /* century of tjd */
3655
+ /* if tjd > 1600 then gregorian calendar */
3656
+ if (tjd >= 2305447.5) {
3657
+ gregflag = TRUE;
3658
+ swe_revjul(tjd, gregflag, &jyear, &jmon, &jday, &jut);
3659
+ /* else julian calendar */
3660
+ } else {
3661
+ gregflag = FALSE;
3662
+ swe_revjul(tjd, gregflag, &jyear, &jmon, &jday, &jut);
3663
+ }
3664
+ /* start century of file containing tjd */
3665
+ if (jyear < 0)
3666
+ sgn = -1;
3667
+ else
3668
+ sgn = 1;
3669
+ icty = jyear / 100;
3670
+ if (sgn < 0 && jyear % 100 != 0)
3671
+ icty -=1;
3672
+ while(icty % ncties != 0)
3673
+ icty--;
3674
+ #if 0
3675
+ if (icty < BEG_YEAR / 100)
3676
+ icty = BEG_YEAR / 100;
3677
+ if (icty >= END_YEAR / 100)
3678
+ icty = END_YEAR / 100 - ncties;
3679
+ #endif
3680
+ /* B.C. or A.D. */
3681
+ if (icty < 0)
3682
+ strcat(fname, "m");
3683
+ else
3684
+ strcat(fname, "_");
3685
+ icty = abs(icty);
3686
+ sprintf(fname + strlen(fname), "%02d.%s", icty, SE_FILE_SUFFIX);
3687
+ #if 0
3688
+ printf("fname %s\n", fname);
3689
+ fflush(stdout);
3690
+ #endif
3691
+ }
3692
+
3693
+ /**************************************************************
3694
+ cut the string s at any char in cutlist; put pointers to partial strings
3695
+ into cpos[0..n-1], return number of partial strings;
3696
+ if less than nmax fields are found, the first empty pointer is
3697
+ set to NULL.
3698
+ More than one character of cutlist in direct sequence count as one
3699
+ separator only! cut_str_any("word,,,word2",","..) cuts only two parts,
3700
+ cpos[0] = "word" and cpos[1] = "word2".
3701
+ If more than nmax fields are found, nmax is returned and the
3702
+ last field nmax-1 rmains un-cut.
3703
+ **************************************************************/
3704
+ int swi_cutstr(char *s, char *cutlist, char *cpos[], int nmax)
3705
+ {
3706
+ int n = 1;
3707
+ cpos [0] = s;
3708
+ while (*s != '\0') {
3709
+ if ((strchr(cutlist, (int) *s) != NULL) && n < nmax) {
3710
+ *s = '\0';
3711
+ while (*(s + 1) != '\0' && strchr (cutlist, (int) *(s + 1)) != NULL) s++;
3712
+ cpos[n++] = s + 1;
3713
+ }
3714
+ if (*s == '\n' || *s == '\r') { /* treat nl or cr like end of string */
3715
+ *s = '\0';
3716
+ break;
3717
+ }
3718
+ s++;
3719
+ }
3720
+ if (n < nmax) cpos[n] = NULL;
3721
+ return (n);
3722
+ } /* cutstr */
3723
+
3724
+ char *swi_right_trim(char *s)
3725
+ {
3726
+ char *sp = s + strlen(s) - 1;
3727
+ // while (isspace((int)(unsigned char) *sp) && sp >= s)
3728
+ while (sp >= s && isspace((int)(unsigned char) *sp))
3729
+ *sp-- = '\0';
3730
+ return s;
3731
+ }
3732
+
3733
+ /*
3734
+ * The following C code (by Rob Warnock rpw3@sgi.com) does CRC-32 in
3735
+ * BigEndian/BigEndian byte/bit order. That is, the data is sent most
3736
+ * significant byte first, and each of the bits within a byte is sent most
3737
+ * significant bit first, as in FDDI. You will need to twiddle with it to do
3738
+ * Ethernet CRC, i.e., BigEndian/LittleEndian byte/bit order.
3739
+ *
3740
+ * The CRCs this code generates agree with the vendor-supplied Verilog models
3741
+ * of several of the popular FDDI "MAC" chips.
3742
+ */
3743
+ static TLS uint32 crc32_table[256];
3744
+ /* Initialized first time "crc32()" is called. If you prefer, you can
3745
+ * statically initialize it at compile time. [Another exercise.]
3746
+ */
3747
+
3748
+ uint32 swi_crc32(unsigned char *buf, int len)
3749
+ {
3750
+ unsigned char *p;
3751
+ uint32 crc;
3752
+ if (!crc32_table[1]) /* if not already done, */
3753
+ init_crc32(); /* build table */
3754
+ crc = 0xffffffff; /* preload shift register, per CRC-32 spec */
3755
+ for (p = buf; len > 0; ++p, --len)
3756
+ crc = (crc << 8) ^ crc32_table[(crc >> 24) ^ *p];
3757
+ return ~crc; /* transmit complement, per CRC-32 spec */
3758
+ }
3759
+
3760
+ /*
3761
+ * Build auxiliary table for parallel byte-at-a-time CRC-32.
3762
+ */
3763
+ #define CRC32_POLY 0x04c11db7 /* AUTODIN II, Ethernet, & FDDI */
3764
+
3765
+ static void init_crc32(void)
3766
+ {
3767
+ int32 j;
3768
+ uint32 c, i;
3769
+ for (i = 0; i < 256; ++i) {
3770
+ for (c = i << 24, j = 8; j > 0; --j)
3771
+ c = c & 0x80000000 ? (c << 1) ^ CRC32_POLY : (c << 1);
3772
+ crc32_table[i] = c;
3773
+ }
3774
+ }
3775
+
3776
+ /*******************************************************
3777
+ * other functions from swephlib.c;
3778
+ * they are not needed for Swiss Ephemeris,
3779
+ * but may be useful to former Placalc users.
3780
+ ********************************************************/
3781
+
3782
+ /************************************
3783
+ normalize argument into interval [0..DEG360]
3784
+ *************************************/
3785
+ centisec CALL_CONV swe_csnorm(centisec p)
3786
+ {
3787
+ if (p < 0)
3788
+ do { p += DEG360; } while (p < 0);
3789
+ else if (p >= DEG360)
3790
+ do { p -= DEG360; } while (p >= DEG360);
3791
+ return (p);
3792
+ }
3793
+
3794
+ /************************************
3795
+ distance in centisecs p1 - p2
3796
+ normalized to [0..360[
3797
+ **************************************/
3798
+ centisec CALL_CONV swe_difcsn (centisec p1, centisec p2)
3799
+ {
3800
+ return (swe_csnorm(p1 - p2));
3801
+ }
3802
+
3803
+ double CALL_CONV swe_difdegn (double p1, double p2)
3804
+ {
3805
+ return (swe_degnorm(p1 - p2));
3806
+ }
3807
+
3808
+ /************************************
3809
+ distance in centisecs p1 - p2
3810
+ normalized to [-180..180[
3811
+ **************************************/
3812
+ centisec CALL_CONV swe_difcs2n(centisec p1, centisec p2)
3813
+ { centisec dif;
3814
+ dif = swe_csnorm(p1 - p2);
3815
+ if (dif >= DEG180) return (dif - DEG360);
3816
+ return (dif);
3817
+ }
3818
+
3819
+ double CALL_CONV swe_difdeg2n(double p1, double p2)
3820
+ { double dif;
3821
+ dif = swe_degnorm(p1 - p2);
3822
+ if (dif >= 180.0) return (dif - 360.0);
3823
+ return (dif);
3824
+ }
3825
+
3826
+ double CALL_CONV swe_difrad2n(double p1, double p2)
3827
+ { double dif;
3828
+ dif = swe_radnorm(p1 - p2);
3829
+ if (dif >= TWOPI / 2) return (dif - TWOPI);
3830
+ return (dif);
3831
+ }
3832
+
3833
+ /*************************************
3834
+ round second, but at 29.5959 always down
3835
+ *************************************/
3836
+ centisec CALL_CONV swe_csroundsec(centisec x)
3837
+ {
3838
+ centisec t;
3839
+ t = (x + 50) / 100 *100L; /* round to seconds */
3840
+ if (t > x && t % DEG30 == 0) /* was rounded up to next sign */
3841
+ t = x / 100 * 100L; /* round last second of sign downwards */
3842
+ return (t);
3843
+ }
3844
+
3845
+ /*************************************
3846
+ double to int32 with rounding, no overflow check
3847
+ *************************************/
3848
+ int32 CALL_CONV swe_d2l(double x)
3849
+ {
3850
+ if (x >=0)
3851
+ return ((int32) (x + 0.5));
3852
+ else
3853
+ return (- (int32) (0.5 - x));
3854
+ }
3855
+
3856
+ /*
3857
+ * monday = 0, ... sunday = 6
3858
+ */
3859
+ int CALL_CONV swe_day_of_week(double jd)
3860
+ {
3861
+ return (((int) floor (jd - 2433282 - 1.5) %7) + 7) % 7;
3862
+ }
3863
+
3864
+ char *CALL_CONV swe_cs2timestr(CSEC t, int sep, AS_BOOL suppressZero, char *a)
3865
+ /* does not suppress zeros in hours or minutes */
3866
+ {
3867
+ /* static char a[9];*/
3868
+ centisec h,m,s;
3869
+ strcpy (a, " ");
3870
+ a[2] = a [5] = sep;
3871
+ t = ((t + 50) / 100) % (24L *3600L); /* round to seconds */
3872
+ s = t % 60L;
3873
+ m = (t / 60) % 60L;
3874
+ h = t / 3600 % 100L;
3875
+ if (s == 0 && suppressZero)
3876
+ a[5] = '\0';
3877
+ else {
3878
+ a [6] = (char) (s / 10 + '0');
3879
+ a [7] = (char) (s % 10 + '0');
3880
+ };
3881
+ a [0] = (char) (h / 10 + '0');
3882
+ a [1] = (char) (h % 10 + '0');
3883
+ a [3] = (char) (m / 10 + '0');
3884
+ a [4] = (char) (m % 10 + '0');
3885
+ return (a);
3886
+ } /* swe_cs2timestr() */
3887
+
3888
+ char *CALL_CONV swe_cs2lonlatstr(CSEC t, char pchar, char mchar, char *sp)
3889
+ {
3890
+ char a[10]; /* must be initialized at each call */
3891
+ char *aa;
3892
+ centisec h,m,s;
3893
+ strcpy (a, " ' ");
3894
+ /* mask dddEmm'ss" */
3895
+ if (t < 0 ) pchar = mchar;
3896
+ t = (ABS4 (t) + 50) / 100; /* round to seconds */
3897
+ s = t % 60L;
3898
+ m = t / 60 % 60L;
3899
+ h = t / 3600 % 1000L;
3900
+ if (s == 0)
3901
+ a[6] = '\0'; /* cut off seconds */
3902
+ else {
3903
+ a [7] = (char) (s / 10 + '0');
3904
+ a [8] = (char) (s % 10 + '0');
3905
+ }
3906
+ a [3] = pchar;
3907
+ if (h > 99) a [0] = (char) (h / 100 + '0');
3908
+ if (h > 9) a [1] = (char) (h % 100 / 10 + '0');
3909
+ a [2] = (char) (h % 10 + '0');
3910
+ a [4] = (char) (m / 10 + '0');
3911
+ a [5] = (char) (m % 10 + '0');
3912
+ aa = a;
3913
+ while (*aa == ' ') aa++;
3914
+ strcpy(sp, aa);
3915
+ return (sp);
3916
+ } /* swe_cs2lonlatstr() */
3917
+
3918
+ char *CALL_CONV swe_cs2degstr(CSEC t, char *a)
3919
+ /* does suppress leading zeros in degrees */
3920
+ {
3921
+ /* char a[9]; must be initialized at each call */
3922
+ centisec h,m,s;
3923
+ t = t / 100 % (30L*3600L); /* truncate to seconds */
3924
+ s = t % 60L;
3925
+ m = t / 60 % 60L;
3926
+ h = t / 3600 % 100L; /* only 0..99 degrees */
3927
+ sprintf(a, "%2d%s%02d'%02d", h, ODEGREE_STRING, m, s);
3928
+ return (a);
3929
+ } /* swe_cs2degstr() */
3930
+
3931
+ /******************************************************************
3932
+ * decimal degrees in zodiac to nakshatra position, deg, min, sec *
3933
+ * for definition of input see function swe_split_deg().
3934
+ * output:
3935
+ * ideg degrees,
3936
+ * imin minutes,
3937
+ * isec seconds,
3938
+ * dsecfr fraction of seconds
3939
+ * inak nakshatra number;
3940
+ ******************************************************************/
3941
+ static void split_deg_nakshatra(double ddeg, int32 roundflag, int32 *ideg, int32 *imin, int32 *isec, double *dsecfr, int32 *inak)
3942
+ {
3943
+ double dadd = 0;
3944
+ double dnakshsize = 13.33333333333333;
3945
+ double ddeghelp = fmod(ddeg, dnakshsize);
3946
+ *inak = 1;
3947
+ if (ddeg < 0) {
3948
+ *inak = -1;
3949
+ ddeg = 0;
3950
+ }
3951
+ // Sheoran "Vedic" ayanamsha: 0 Aries = 3°20 Ashvini
3952
+ if ((swed.sidd.sid_mode & SE_SIDM_TRUE_SHEORAN) == SE_SIDM_TRUE_SHEORAN)
3953
+ ddeg = swe_degnorm(ddeg + 3.33333333333333);
3954
+ if (roundflag & SE_SPLIT_DEG_ROUND_DEG) {
3955
+ dadd = 0.5;
3956
+ } else if (roundflag & SE_SPLIT_DEG_ROUND_MIN) {
3957
+ dadd = 0.5 / 60;
3958
+ } else if (roundflag & SE_SPLIT_DEG_ROUND_SEC) {
3959
+ dadd = 0.5 / 3600;
3960
+ }
3961
+ if (roundflag & SE_SPLIT_DEG_KEEP_DEG) {
3962
+ if ((int32) (ddeghelp + dadd) - (int32) ddeghelp > 0)
3963
+ dadd = 0;
3964
+ } else if (roundflag & SE_SPLIT_DEG_KEEP_SIGN) {
3965
+ if (ddeghelp + dadd >= dnakshsize)
3966
+ dadd = 0;
3967
+ }
3968
+ ddeg += dadd;
3969
+ *inak = (int32) (ddeg / dnakshsize);
3970
+ if (*inak == 27) *inak = 0; // with rounding up from 359.9999
3971
+ ddeg = fmod(ddeg, dnakshsize);
3972
+ *ideg = (int32) ddeg;
3973
+ ddeg -= *ideg;
3974
+ *imin = (int32) (ddeg * 60);
3975
+ ddeg -= *imin / 60.0;
3976
+ *isec = (int32) (ddeg * 3600);
3977
+ if (!(roundflag & (SE_SPLIT_DEG_ROUND_DEG | SE_SPLIT_DEG_ROUND_MIN | SE_SPLIT_DEG_ROUND_SEC))) {
3978
+ *dsecfr = ddeg * 3600 - *isec;
3979
+ } else {
3980
+ *dsecfr = *isec; // is rounded, no fractional seconds
3981
+ }
3982
+ } /* end split_deg_nakshtra */
3983
+
3984
+ /************************************************************
3985
+ * splitting decimal degrees into (zod.sign,) deg, min, sec. *
3986
+ * input:
3987
+ * ddeg decimal degrees, ecliptic longitude
3988
+ * roundflag by default there is no rounding. if rounding is
3989
+ * required, the following bits can be set:
3990
+ # define SE_SPLIT_DEG_ROUND_SEC 1
3991
+ # define SE_SPLIT_DEG_ROUND_MIN 2
3992
+ # define SE_SPLIT_DEG_ROUND_DEG 4
3993
+ # define SE_SPLIT_DEG_ZODIACAL 8 * split into zodiac signs
3994
+ # define SE_SPLIT_DEG_NAKSHATRA 1024 * split into nakshatras *
3995
+ # define SE_SPLIT_DEG_KEEP_SIGN 16 * don't round to next zodiac sign,
3996
+ * e.g. 29.9999998 will be rounded
3997
+ * to 29°59'59" (or 29°59' or 29°) *
3998
+ * or next nakshatra:
3999
+ * e.g. 13.3333332 will be rounded
4000
+ * to 13°19'59" (or 13°19' or 13°) *
4001
+ # define SE_SPLIT_DEG_KEEP_DEG 32 * don't round to next degree
4002
+ * e.g. 10.9999999 will be rounded
4003
+ * to 10d59'59" (or 10d59' or 10d) *
4004
+ * output:
4005
+ * ideg degrees,
4006
+ * imin minutes,
4007
+ * isec seconds,
4008
+ * dsecfr fraction of seconds
4009
+ * isgn zodiac sign number;
4010
+ * or +/- sign
4011
+ *
4012
+ *********************************************************/
4013
+ void CALL_CONV swe_split_deg(double ddeg, int32 roundflag, int32 *ideg, int32 *imin, int32 *isec, double *dsecfr, int32 *isgn)
4014
+ {
4015
+ double dadd = 0;
4016
+ *isgn = 1;
4017
+ if (ddeg < 0) {
4018
+ *isgn = -1;
4019
+ ddeg = -ddeg;
4020
+ } else if (roundflag & SE_SPLIT_DEG_NAKSHATRA) {
4021
+ split_deg_nakshatra(ddeg, roundflag, ideg, imin, isec, dsecfr, isgn);
4022
+ return;
4023
+ }
4024
+ if (roundflag & SE_SPLIT_DEG_ROUND_DEG) {
4025
+ dadd = 0.5;
4026
+ } else if (roundflag & SE_SPLIT_DEG_ROUND_MIN) {
4027
+ dadd = 0.5 / 60.0;
4028
+ } else if (roundflag & SE_SPLIT_DEG_ROUND_SEC) {
4029
+ dadd = 0.5 / 3600.0;
4030
+ }
4031
+ if (roundflag & SE_SPLIT_DEG_KEEP_DEG) {
4032
+ if ((int32) (ddeg + dadd) - (int32) ddeg > 0)
4033
+ dadd = 0;
4034
+ } else if (roundflag & SE_SPLIT_DEG_KEEP_SIGN) {
4035
+ if (fmod(ddeg, 30) + dadd >= 30)
4036
+ dadd = 0;
4037
+ }
4038
+ ddeg += dadd;
4039
+ if (roundflag & SE_SPLIT_DEG_ZODIACAL) {
4040
+ *isgn = (int32) (ddeg / 30);
4041
+ if (*isgn == 12) // 360° = 0°
4042
+ *isgn = 0;
4043
+ ddeg = fmod(ddeg, 30);
4044
+ }
4045
+ *ideg = (int32) ddeg;
4046
+ ddeg -= *ideg;
4047
+ *imin = (int32) (ddeg * 60);
4048
+ ddeg -= *imin / 60.0;
4049
+ *isec = (int32) (ddeg * 3600);
4050
+ if (!(roundflag & (SE_SPLIT_DEG_ROUND_DEG | SE_SPLIT_DEG_ROUND_MIN | SE_SPLIT_DEG_ROUND_SEC))) {
4051
+ *dsecfr = ddeg * 3600 - *isec;
4052
+ } else {
4053
+ *dsecfr = *isec; // is rounded, no fractional seconds
4054
+ }
4055
+ } /* end split_deg */
4056
+
4057
+ double swi_kepler(double E, double M, double ecce)
4058
+ {
4059
+ double dE = 1, E0;
4060
+ double x;
4061
+ /* simple formula for small eccentricities */
4062
+ if (ecce < 0.4) {
4063
+ while(dE > 1e-12) {
4064
+ E0 = E;
4065
+ E = M + ecce * sin(E0);
4066
+ dE = fabs(E - E0);
4067
+ }
4068
+ /* complicated formula for high eccentricities */
4069
+ } else {
4070
+ while(dE > 1e-12) {
4071
+ E0 = E;
4072
+ /*
4073
+ * Alois 21-jul-2000: workaround an optimizer problem in gcc
4074
+ * swi_mod2PI sees very small negative argument e-322 and returns +2PI;
4075
+ * we avoid swi_mod2PI for small x.
4076
+ */
4077
+ x = (M + ecce * sin(E0) - E0) / (1 - ecce * cos(E0));
4078
+ dE = fabs(x);
4079
+ if (dE < 1e-2) {
4080
+ E = E0 + x;
4081
+ } else {
4082
+ E = swi_mod2PI(E0 + x);
4083
+ dE = fabs(E - E0);
4084
+ }
4085
+ }
4086
+ }
4087
+ return E;
4088
+ }
4089
+
4090
+ void swi_FK4_FK5(double *xp, double tjd)
4091
+ {
4092
+ AS_BOOL correct_speed = TRUE;
4093
+ if (xp[0] == 0 && xp[1] == 0 && xp[2] == 0)
4094
+ return;
4095
+ /* with zero speed, we assume that it should be really zero */
4096
+ if (xp[3] == 0)
4097
+ correct_speed = FALSE;
4098
+ swi_cartpol_sp(xp, xp);
4099
+ /* according to Expl.Suppl., p. 167f. */
4100
+ xp[0] += (0.035 + 0.085 * (tjd - B1950) / 36524.2198782) / 3600 * 15 * DEGTORAD;
4101
+ if (correct_speed)
4102
+ xp[3] += (0.085 / 36524.2198782) / 3600 * 15 * DEGTORAD;
4103
+ swi_polcart_sp(xp, xp);
4104
+ }
4105
+
4106
+ void swi_FK5_FK4(double *xp, double tjd)
4107
+ {
4108
+ if (xp[0] == 0 && xp[1] == 0 && xp[2] == 0)
4109
+ return;
4110
+ swi_cartpol_sp(xp, xp);
4111
+ /* according to Expl.Suppl., p. 167f. */
4112
+ xp[0] -= (0.035 + 0.085 * (tjd - B1950) / 36524.2198782) / 3600 * 15 * DEGTORAD;
4113
+ xp[3] -= (0.085 / 36524.2198782) / 3600 * 15 * DEGTORAD;
4114
+ swi_polcart_sp(xp, xp);
4115
+ }
4116
+
4117
+ /* function for inhouse testing only */
4118
+ void set_astro_models(char *samod)
4119
+ {
4120
+ int *pmodel = &(swed.astro_models[0]);
4121
+ char *sp, *sp2;
4122
+ int i = 0;
4123
+ swi_init_swed_if_start();
4124
+ sp = samod;
4125
+ pmodel[0] = atoi(sp);
4126
+ i++;
4127
+ while((sp2 = strchr(sp, ',')) != NULL && i < NSE_MODELS) {
4128
+ sp = sp2 + 1;
4129
+ pmodel[i] = atoi(sp);
4130
+ i++;
4131
+ }
4132
+ }
4133
+
4134
+
4135
+ /*
4136
+ * Function for inhouse testing of old SE versions.
4137
+ *
4138
+ * Values of the following macros are defined in swephexp.h
4139
+ * and must be identical to the ones used in the defines below
4140
+ D1 SEMOD_DELTAT_STEPHENSON_MORRISON_1984
4141
+ D2 SEMOD_DELTAT_STEPHENSON_1997
4142
+ D3 SEMOD_DELTAT_STEPHENSON_MORRISON_2004
4143
+ D4 SEMOD_DELTAT_ESPENAK_MEEUS_2006
4144
+ D5 SEMOD_DELTAT_STEPHENSON_ETC_2016
4145
+
4146
+ P1 SEMOD_PREC_IAU_1976
4147
+ P2 SEMOD_PREC_LASKAR_1986
4148
+ P3 SEMOD_PREC_WILL_EPS_LASK
4149
+ P4 SEMOD_PREC_WILLIAMS_1994
4150
+ P5 SEMOD_PREC_SIMON_1994
4151
+ P6 SEMOD_PREC_IAU_2000
4152
+ P7 SEMOD_PREC_BRETAGNON_2003
4153
+ P8 SEMOD_PREC_IAU_2006
4154
+ P9 SEMOD_PREC_VONDRAK_2011
4155
+ P10 SEMOD_PREC_OWEN_1990
4156
+ P11 SEMOD_PREC_NEWCOMB
4157
+
4158
+ N1 SEMOD_NUT_IAU_1980
4159
+ N2 SEMOD_NUT_IAU_CORR_1987
4160
+ N3 SEMOD_NUT_IAU_2000A
4161
+ N4 SEMOD_NUT_IAU_2000B
4162
+ N5 SEMOD_NUT_WOOLARD
4163
+
4164
+ B1 SEMOD_BIAS_NONE
4165
+ B2 SEMOD_BIAS_IAU2000
4166
+ B3 SEMOD_BIAS_IAU2006
4167
+
4168
+ S1 SEMOD_SIDT_IAU_1976
4169
+ S2 SEMOD_SIDT_IAU_2006
4170
+ S3 SEMOD_SIDT_IERS_CONV_2010
4171
+ S4 SEMOD_SIDT_LONGTERM
4172
+ * D P P N B J J S
4173
+ */
4174
+ # define AMODELS_SE_1_00 "1,3,1,1,1,0,0,1"
4175
+ # define AMODELS_SE_1_64 "2,3,1,1,1,0,0,1"
4176
+ # define AMODELS_SE_1_70 "2,8,8,4,2,0,0,2"
4177
+ # define AMODELS_SE_1_72 "3,8,8,4,2,0,0,2"
4178
+ # define AMODELS_SE_1_77 "4,8,8,4,2,0,0,2"
4179
+ # define AMODELS_SE_1_78 "4,9,9,4,2,0,0,2"
4180
+ # define AMODELS_SE_1_80 "4,9,9,4,3,0,0,1" /* note sid. time (S)! */
4181
+ # define AMODELS_SE_2_00 "4,9,9,4,3,0,0,4"
4182
+ # define AMODELS_SE_2_06 "5,9,9,4,3,0,0,4"
4183
+ void CALL_CONV swe_set_astro_models(char *samod, int32 iflag)
4184
+ {
4185
+ double dversion;
4186
+ char s[30], *sp;
4187
+ swi_init_swed_if_start();
4188
+ if (*samod != '\0' && isdigit((int) *samod)) {
4189
+ set_astro_models(samod);
4190
+ } else if (*samod == '\0' || strncmp(samod, "SE", 2) == 0) {
4191
+ strncpy(s, samod, 20);
4192
+ s[20] = '\0';
4193
+ if ((sp = strchr(s + 5, '.')) != NULL) // remove second '.' in "SE2.05.01"
4194
+ swi_strcpy(sp, sp+1);
4195
+ if ((sp = strchr(s + 5, 'b')) != NULL) // remove 'b' in "SE2.05.02b04"
4196
+ swi_strcpy(sp, sp+1);
4197
+ dversion = atof(s + 2);
4198
+ if (dversion == 0)
4199
+ dversion = atof(SE_VERSION);
4200
+ if (dversion >= 2.06) {
4201
+ set_astro_models(AMODELS_SE_2_06);
4202
+ } else if (dversion >= 2.01) {
4203
+ set_astro_models(AMODELS_SE_2_00);
4204
+ } else if (dversion >= 2.00) {
4205
+ set_astro_models(AMODELS_SE_2_00);
4206
+ if (swi_get_denum(SEI_SUN, iflag) == 431)
4207
+ swe_set_tid_acc(SE_TIDAL_DE406);
4208
+ } else if (dversion >= 1.80) {
4209
+ set_astro_models(AMODELS_SE_1_80);
4210
+ swe_set_tid_acc(SE_TIDAL_DE406);
4211
+ } else if (dversion >= 1.78) {
4212
+ set_astro_models(AMODELS_SE_1_78);
4213
+ swe_set_tid_acc(SE_TIDAL_DE406);
4214
+ } else if (dversion >= 1.77) {
4215
+ set_astro_models(AMODELS_SE_1_77);
4216
+ swe_set_tid_acc(SE_TIDAL_DE406);
4217
+ } else if (dversion >= 1.72) {
4218
+ set_astro_models(AMODELS_SE_1_72);
4219
+ swe_set_tid_acc(-25.7376);
4220
+ } else if (dversion >= 1.70) {
4221
+ set_astro_models(AMODELS_SE_1_70);
4222
+ swe_set_tid_acc(-25.7376);
4223
+ } else if (dversion >= 1.64) {
4224
+ set_astro_models(AMODELS_SE_1_64);
4225
+ swe_set_tid_acc(-25.7376);
4226
+ } else {
4227
+ set_astro_models(AMODELS_SE_1_00);
4228
+ swe_set_tid_acc(-25.7376);
4229
+ }
4230
+ }
4231
+ }
4232
+
4233
+ /* function for inhouse testing only */
4234
+ static void get_precession_model(int precmod, int32 iflag, char *s)
4235
+ {
4236
+ if (precmod == 0)
4237
+ precmod = SEMOD_PREC_DEFAULT;
4238
+ if (iflag & SEFLG_JPLEPH) {
4239
+ if (iflag & SEFLG_JPLHOR) {
4240
+ strcpy(s, "IAU 1976 (Lieske) / Owen 1990 before 1799");
4241
+ return;
4242
+ }
4243
+ if (iflag & SEFLG_JPLHOR_APPROX) {
4244
+ strcpy(s, "Vondrak 2011 / IAU 1976 (Lieske) before 1962 / Owen 1990 before 1799");
4245
+ return;
4246
+ }
4247
+ }
4248
+ switch(precmod) {
4249
+ case SEMOD_PREC_IAU_1976:
4250
+ strcpy(s, "IAU 1976 (Lieske)");
4251
+ break;
4252
+ case SEMOD_PREC_IAU_2000:
4253
+ strcpy(s, "IAU 2000 (Lieske 1976, Mathews 2002)");
4254
+ break;
4255
+ case SEMOD_PREC_IAU_2006:
4256
+ strcpy(s, "IAU 2006 (Capitaine & alii)");
4257
+ break;
4258
+ case SEMOD_PREC_BRETAGNON_2003:
4259
+ strcpy(s, "Bretagnon 2003");
4260
+ break;
4261
+ case SEMOD_PREC_LASKAR_1986:
4262
+ strcpy(s, "Laskar 1986");
4263
+ break;
4264
+ case SEMOD_PREC_SIMON_1994:
4265
+ strcpy(s, "Simon 1994");
4266
+ break;
4267
+ case SEMOD_PREC_WILLIAMS_1994:
4268
+ strcpy(s, "Williams 1994");
4269
+ break;
4270
+ case SEMOD_PREC_WILL_EPS_LASK:
4271
+ strcpy(s, "Williams 1994 / Epsilon Laskar 1986");
4272
+ break;
4273
+ case SEMOD_PREC_OWEN_1990:
4274
+ strcpy(s, "Owen 1990");
4275
+ break;
4276
+ case SEMOD_PREC_NEWCOMB:
4277
+ strcpy(s, "Newcomb 1895");
4278
+ break;
4279
+ case SEMOD_PREC_VONDRAK_2011:
4280
+ strcpy(s, "Vondrák 2011");
4281
+ break;
4282
+ default:
4283
+ break;
4284
+ }
4285
+ }
4286
+
4287
+ /* function for inhouse testing only */
4288
+ static void get_deltat_model(int dtmod, char *s)
4289
+ {
4290
+ if (dtmod == 0)
4291
+ dtmod = SEMOD_DELTAT_DEFAULT;
4292
+ switch(dtmod) {
4293
+ case SEMOD_DELTAT_ESPENAK_MEEUS_2006:
4294
+ strcpy(s, "Espenak/Meeus 2006 (before 1633)");
4295
+ break;
4296
+ case SEMOD_DELTAT_STEPHENSON_MORRISON_2004:
4297
+ strcpy(s, "Stephenson/Morrison 2004 (before 1600)");
4298
+ break;
4299
+ case SEMOD_DELTAT_STEPHENSON_1997:
4300
+ strcpy(s, "Stephenson 1997 (before 1600)");
4301
+ break;
4302
+ case SEMOD_DELTAT_STEPHENSON_MORRISON_1984:
4303
+ strcpy(s, "Stephenson/Morrison 1984 (before 1600)");
4304
+ break;
4305
+ case SEMOD_DELTAT_STEPHENSON_ETC_2016:
4306
+ strcpy(s, "Stephenson/Morrison/Hohenkerk 2016 (before 1955)");
4307
+ break;
4308
+ }
4309
+ }
4310
+
4311
+ /* function for inhouse testing only */
4312
+ static void get_nutation_model(int nutmod, int32 iflag, char *s)
4313
+ {
4314
+ int jplhormod = swed.astro_models[SE_MODEL_JPLHOR_MODE];
4315
+ int jplhoramod = swed.astro_models[SE_MODEL_JPLHORA_MODE];
4316
+ if (jplhormod == 0)
4317
+ jplhormod = SEMOD_JPLHOR_DEFAULT;
4318
+ if (jplhoramod == 0)
4319
+ jplhoramod = SEMOD_JPLHORA_DEFAULT;
4320
+ if (nutmod == 0)
4321
+ nutmod = SEMOD_NUT_DEFAULT;
4322
+ switch(nutmod) {
4323
+ case SEMOD_NUT_WOOLARD:
4324
+ strcpy(s, "Woolard 1953");
4325
+ break;
4326
+ case SEMOD_NUT_IAU_1980:
4327
+ strcpy(s, "IAU 1980 (Wahr)");
4328
+ break;
4329
+ case SEMOD_NUT_IAU_CORR_1987:
4330
+ strcpy(s, "Herring 1986");
4331
+ break;
4332
+ case SEMOD_NUT_IAU_2000A:
4333
+ strcpy(s, "IAU 2000A (Mathews)");
4334
+ break;
4335
+ case SEMOD_NUT_IAU_2000B:
4336
+ strcpy(s, "IAU 2000B (Mathews)");
4337
+ break;
4338
+ }
4339
+ if (iflag & SEFLG_JPLEPH) {
4340
+ if (iflag & SEFLG_JPLHOR)
4341
+ strcpy(s, "IAU 1980 (Wahr)");
4342
+ if (iflag & SEFLG_JPLHOR) {
4343
+ strcat(s, "\n+ daily corrections to dpsi/deps 1962-today");
4344
+ if (jplhormod == SEMOD_JPLHOR_LONG_AGREEMENT)
4345
+ strcat(s, "\n good agreement with JPL Horizons between 1800 and today");
4346
+ else
4347
+ strcat(s, "\n defaults to SEFLG_JPLEPH_APPROX before 1962");
4348
+ } else if (iflag & SEFLG_JPLHOR_APPROX){
4349
+ strcat(s, "\n+ some corrections, approximating JPL Horizons");
4350
+ if (jplhoramod == SEMOD_JPLHORA_1)
4351
+ strcat(s, " (SEMOD_JPLHORA_1)");
4352
+ else if (jplhoramod == SEMOD_JPLHORA_2)
4353
+ strcat(s, " (SEMOD_JPLHORA_2)");
4354
+ else
4355
+ strcat(s, " (SEMOD_JPLHORA_3)");
4356
+ }
4357
+ }
4358
+ }
4359
+
4360
+ /* function for inhouse testing only */
4361
+ static void get_frame_bias_model(int biasmod, char *s)
4362
+ {
4363
+ if (biasmod == 0)
4364
+ biasmod = SEMOD_BIAS_DEFAULT;
4365
+ switch(biasmod) {
4366
+ case SEMOD_BIAS_IAU2000:
4367
+ strcpy(s, "IAU 2000");
4368
+ break;
4369
+ case SEMOD_BIAS_IAU2006:
4370
+ strcpy(s, "IAU 2006");
4371
+ break;
4372
+ case SEMOD_BIAS_NONE:
4373
+ strcpy(s, "none");
4374
+ break;
4375
+ }
4376
+ }
4377
+
4378
+ /* function for inhouse testing only */
4379
+ static void get_sidt_model(int sidtmod, char *s)
4380
+ {
4381
+ if (sidtmod == 0)
4382
+ sidtmod = SEMOD_SIDT_DEFAULT;
4383
+ switch(sidtmod) {
4384
+ case SEMOD_SIDT_IAU_1976:
4385
+ strcpy(s, "IAU 1976");
4386
+ break;
4387
+ case SEMOD_SIDT_IAU_2006:
4388
+ strcpy(s, "IAU 2006 (Capitaine 2003)");
4389
+ break;
4390
+ case SEMOD_SIDT_IERS_CONV_2010:
4391
+ strcpy(s, "IERS Convention 2010");
4392
+ break;
4393
+ case SEMOD_SIDT_LONGTERM:
4394
+ strcpy(s, "IERS Convention 2010 + long-term extension by Astrodienst");
4395
+ break;
4396
+ }
4397
+ }
4398
+
4399
+ /* function for inhouse testing only */
4400
+ void CALL_CONV swe_get_astro_models(char *samod, char *sdet, int32 iflag)
4401
+ {
4402
+ int i, imod;
4403
+ int *pmodel = &(swed.astro_models[0]);
4404
+ char s[AS_MAXCH], samod0[AS_MAXCH];
4405
+ AS_BOOL list_all_models = FALSE;
4406
+ if (samod != NULL) {
4407
+ if (strchr(samod, '+') != NULL)
4408
+ list_all_models = TRUE;
4409
+ swe_set_astro_models(samod, iflag);
4410
+ }
4411
+ *samod0 = '\0';
4412
+ for (i = 0; i < NSE_MODELS; i++) {
4413
+ imod = pmodel[i];
4414
+ switch(i) {
4415
+ case SE_MODEL_PREC_LONGTERM:
4416
+ if (imod == SEMOD_PREC_DEFAULT) imod = 0;
4417
+ break;
4418
+ case SE_MODEL_PREC_SHORTTERM:
4419
+ if (imod == SEMOD_PREC_DEFAULT_SHORT) imod = 0;
4420
+ break;
4421
+ case SE_MODEL_NUT:
4422
+ if (imod == SEMOD_NUT_DEFAULT) imod = 0;
4423
+ break;
4424
+ case SE_MODEL_SIDT:
4425
+ if (imod == SEMOD_SIDT_DEFAULT) imod = 0;
4426
+ break;
4427
+ case SE_MODEL_BIAS:
4428
+ if (imod == SEMOD_BIAS_DEFAULT) imod = 0;
4429
+ break;
4430
+ case SE_MODEL_JPLHOR_MODE:
4431
+ if (imod == SEMOD_JPLHOR_DEFAULT) imod = 0;
4432
+ break;
4433
+ case SE_MODEL_JPLHORA_MODE:
4434
+ if (imod == SEMOD_JPLHORA_DEFAULT) imod = 0;
4435
+ break;
4436
+ case SE_MODEL_DELTAT:
4437
+ if (imod == SEMOD_DELTAT_DEFAULT) imod = 0;
4438
+ break;
4439
+ }
4440
+ sprintf(samod0 + strlen(samod0), "%d,", imod);
4441
+ }
4442
+ /*if (samod != NULL)
4443
+ strcpy(samod, samod0);*/
4444
+ *sdet = '\0';
4445
+ if (sdet != NULL) {
4446
+ /* JPL ephemeris number and tidal acceleration used with it */
4447
+ sprintf(sdet + strlen(sdet), "JPL eph. %d; tidal acc. Moon used by SE: %.4f\n",
4448
+ swi_get_denum(SEI_SUN, iflag), swe_get_tid_acc());
4449
+ if (iflag & SEFLG_JPLEPH) {
4450
+ if (iflag & SEFLG_JPLHOR)
4451
+ strcat(sdet, "JPL Horizons method:\n");
4452
+ if (iflag & SEFLG_JPLHOR_APPROX)
4453
+ strcat(sdet, "JPL Horizons method (approximation):\n");
4454
+ } else if (iflag & SEFLG_SWIEPH) {
4455
+ strcat(sdet, "Swiss Ephemeris compressed files sepl*/semo*\n");
4456
+ } else {
4457
+ strcat(sdet, "Moshier semi-analytical approximation\n");
4458
+ }
4459
+ /* long-term Delta T calculation */
4460
+ get_deltat_model(pmodel[SE_MODEL_DELTAT], s);
4461
+ sprintf(sdet + strlen(sdet), "Delta T (long-term): %s\n", s);
4462
+ /* precession model */
4463
+ get_precession_model(pmodel[SE_MODEL_PREC_LONGTERM], iflag, s);
4464
+ sprintf(sdet + strlen(sdet), "Precession: %s\n", s);
4465
+ if (pmodel[SE_MODEL_PREC_LONGTERM] != pmodel[SE_MODEL_PREC_SHORTTERM] && !(iflag & (SEFLG_JPLHOR | SEFLG_JPLHOR_APPROX))) {
4466
+ get_precession_model(pmodel[SE_MODEL_PREC_SHORTTERM], iflag, s);
4467
+ sprintf(sdet + strlen(sdet), "+ short-term model: %s\n", s);
4468
+ }
4469
+ /* nutation */
4470
+ get_nutation_model(pmodel[SE_MODEL_NUT], iflag, s);
4471
+ sprintf(sdet + strlen(sdet), "Nutation: %s\n", s);
4472
+ /* frame bias */
4473
+ get_frame_bias_model(pmodel[SE_MODEL_BIAS], s);
4474
+ sprintf(sdet + strlen(sdet), "Frame bias: %s\n", s);
4475
+ /* sidereal time */
4476
+ get_sidt_model(pmodel[SE_MODEL_SIDT], s);
4477
+ sprintf(sdet + strlen(sdet), "Sid. time: %s\n", s);
4478
+ /* swetest parameters */
4479
+ sprintf(sdet + strlen(sdet), "swetest parameters: D P P N B J J S\n");
4480
+ sprintf(sdet + strlen(sdet), " -amod%s", samod0);
4481
+ sprintf(sdet + strlen(sdet), " -tidacc%f", swe_get_tid_acc());
4482
+ strcat(sdet, "\n");
4483
+ /* list all available astronomical models */
4484
+ if (!list_all_models) {
4485
+ sprintf(sdet + strlen(sdet), "For list of all available astronomical models, add a '+' to the version string\n(swetest parameter -amod%s+ or -amod%s+)\n", samod, samod0);
4486
+ } else {
4487
+ strcat(sdet, "DELTA T MODELS (D)\n");
4488
+ for (i = 0; i <= SEMOD_NDELTAT; i++) {
4489
+ if (i == SEMOD_DELTAT_DEFAULT) continue;
4490
+ sprintf(sdet + strlen(sdet), " (%d)", i);
4491
+ if (i == 0) sprintf(sdet + strlen(sdet), " (=%d)", SEMOD_DELTAT_DEFAULT);
4492
+ get_deltat_model(i, s);
4493
+ sprintf(sdet + strlen(sdet), ": %s\n", s);
4494
+ }
4495
+ strcat(sdet, "PRECESSION MODELS (P P) (long-term/short-term)\n");
4496
+ for (i = 0; i <= SEMOD_NPREC; i++) {
4497
+ if (i == SEMOD_PREC_DEFAULT) continue;
4498
+ sprintf(sdet + strlen(sdet), " (%d)", i);
4499
+ if (i == 0) sprintf(sdet + strlen(sdet), " (=%d)", SEMOD_PREC_DEFAULT);
4500
+ get_precession_model(i, iflag, s);
4501
+ sprintf(sdet + strlen(sdet), ": %s\n", s);
4502
+ }
4503
+ strcat(sdet, "NUTATION MODELS (N)\n");
4504
+ for (i = 0; i <= SEMOD_NNUT; i++) {
4505
+ if (i == SEMOD_NUT_DEFAULT) continue;
4506
+ sprintf(sdet + strlen(sdet), " (%d)", i);
4507
+ if (i == 0) sprintf(sdet + strlen(sdet), " (=%d)", SEMOD_NUT_DEFAULT);
4508
+ get_nutation_model(i, iflag, s);
4509
+ sprintf(sdet + strlen(sdet), ": %s\n", s);
4510
+ }
4511
+ strcat(sdet, "FRAME BIAS MODELS (B)\n");
4512
+ for (i = 0; i <= SEMOD_NBIAS; i++) {
4513
+ if (i == SEMOD_BIAS_DEFAULT) continue;
4514
+ sprintf(sdet + strlen(sdet), " (%d)", i);
4515
+ if (i == 0) sprintf(sdet + strlen(sdet), " (=%d)", SEMOD_BIAS_DEFAULT);
4516
+ get_frame_bias_model(i, s);
4517
+ sprintf(sdet + strlen(sdet), ": %s\n", s);
4518
+ }
4519
+ strcat(sdet, "JPL HORIZONS MODELS (J) (with SEFLG_JPLEPH|SEFLG_JPLHOR).\n");
4520
+ strcat(sdet, " IAU 1980 (Wahr) + daily corrections to dpsi/deps 1962-today.\n");
4521
+ strcat(sdet, " (0 (=1): between 1799 and 1962, dpsi/deps of 20-jan-1962 are used.\n");
4522
+ strcat(sdet, " For times beyond the dpsi/deps table, the last tabulated values are used.\n");
4523
+ strcat(sdet, " Beyond 1799 and 2201, precession Owen 1990 is used..\n");
4524
+ strcat(sdet, " Documentation in swephexp.h under 'methods of JPL Horizons'\n");
4525
+ strcat(sdet, "JPL HORIZONS APPROXIMATION (J) (with SEFLG_JPLEPH|SEFLG_JPLHORA)\n");
4526
+ strcat(sdet, " Documentation in swephexp.h under 'methods of JPL Horizons'\n");
4527
+ strcat(sdet, "SIDEREAL TIME MODELS (S)\n");
4528
+ for (i = 0; i <= SEMOD_NSIDT; i++) {
4529
+ if (i == SEMOD_SIDT_DEFAULT) continue;
4530
+ sprintf(sdet + strlen(sdet), " (%d)", i);
4531
+ if (i == 0) sprintf(sdet + strlen(sdet), " (=%d)", SEMOD_SIDT_DEFAULT);
4532
+ get_sidt_model(i, s);
4533
+ sprintf(sdet + strlen(sdet), ": %s\n", s);
4534
+ }
4535
+ }
4536
+ }
4537
+ }
4538
+
4539
+ char *swi_strcpy(char *to, char *from)
4540
+ {
4541
+ char *sp, s[AS_MAXCH];
4542
+ if (*from == '\0') {
4543
+ *to = '\0';
4544
+ return to;
4545
+ }
4546
+ if (strlen(from) < AS_MAXCH) {
4547
+ strcpy(s, from);
4548
+ strcpy(to, s);
4549
+ } else {
4550
+ sp = strdup(from);
4551
+ if (sp == NULL) {
4552
+ strcpy(to, from);
4553
+ } else {
4554
+ strcpy(to, sp);
4555
+ free(sp);
4556
+ }
4557
+ }
4558
+ return to;
4559
+ }
4560
+
4561
+ #ifdef TRACE
4562
+ void swi_open_trace(char *serr)
4563
+ {
4564
+ swi_trace_count++;
4565
+ if (swi_trace_count >= TRACE_COUNT_MAX) {
4566
+ if (swi_trace_count == TRACE_COUNT_MAX) {
4567
+ if (serr != NULL)
4568
+ sprintf(serr, "trace stopped, %d calls exceeded.", TRACE_COUNT_MAX);
4569
+ if (swi_fp_trace_out != NULL)
4570
+ fprintf(swi_fp_trace_out, "trace stopped, %d calls exceeded.\n", TRACE_COUNT_MAX);
4571
+ if (swi_fp_trace_c != NULL)
4572
+ fprintf(swi_fp_trace_c, "/* trace stopped, %d calls exceeded. */\n", TRACE_COUNT_MAX);
4573
+ }
4574
+ return;
4575
+ }
4576
+ if (swi_fp_trace_c == NULL) {
4577
+ char fname[AS_MAXCH];
4578
+ #if TRACE == 2
4579
+ char *sp, *sp1;
4580
+ int ipid;
4581
+ #endif
4582
+ /* remove(fname_trace_c); */
4583
+ strcpy(fname, fname_trace_c);
4584
+ #if TRACE == 2
4585
+ sp = strchr(fname_trace_c, '.');
4586
+ sp1 = strchr(fname, '.');
4587
+ # if MSDOS
4588
+ ipid = _getpid();
4589
+ # else
4590
+ ipid = getpid();
4591
+ # endif
4592
+ sprintf(sp1, "_%d%s", ipid, sp);
4593
+ #endif
4594
+ if ((swi_fp_trace_c = fopen(fname, FILE_A_ACCESS)) == NULL) {
4595
+ if (serr != NULL) {
4596
+ sprintf(serr, "could not open trace output file '%s'", fname);
4597
+ }
4598
+ } else {
4599
+ fputs("#include \"sweodef.h\"\n", swi_fp_trace_c);
4600
+ fputs("#include \"swephexp.h\"\n\n", swi_fp_trace_c);
4601
+ fputs("void main()\n{\n", swi_fp_trace_c);
4602
+ fputs(" double tjd, t, nut, eps; int i, ipl, retc; int32 iflag;\n", swi_fp_trace_c);
4603
+ fputs(" double armc, geolat, cusp[12], ascmc[10]; int hsys;\n", swi_fp_trace_c);
4604
+ fputs(" double xx[6]; int32 iflgret;\n", swi_fp_trace_c);
4605
+ fputs(" char s[AS_MAXCH], star[AS_MAXCH], serr[AS_MAXCH];\n", swi_fp_trace_c);
4606
+ fflush(swi_fp_trace_c);
4607
+ }
4608
+ }
4609
+ if (swi_fp_trace_out == NULL) {
4610
+ char fname[AS_MAXCH];
4611
+ #if TRACE == 2
4612
+ char *sp, *sp1;
4613
+ int ipid;
4614
+ #endif
4615
+ /* remove(fname_trace_out); */
4616
+ strcpy(fname, fname_trace_out);
4617
+ #if TRACE == 2
4618
+ sp = strchr(fname_trace_out, '.');
4619
+ sp1 = strchr(fname, '.');
4620
+ # if MSDOS
4621
+ ipid = _getpid();
4622
+ # else
4623
+ ipid = getpid();
4624
+ # endif
4625
+ sprintf(sp1, "_%d%s", ipid, sp);
4626
+ #endif
4627
+ if ((swi_fp_trace_out = fopen(fname, FILE_A_ACCESS)) == NULL) {
4628
+ if (serr != NULL) {
4629
+ sprintf(serr, "could not open trace output file '%s'", fname);
4630
+ }
4631
+ }
4632
+ }
4633
+ }
4634
+ #endif