swe4r 0.0.0

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,2581 @@
1
+
2
+ /* SWISSEPH
3
+ $Header: /home/dieter/sweph/RCS/swephlib.c,v 1.75 2009/11/27 11:00:57 dieter Exp $
4
+
5
+ SWISSEPH modules that may be useful for other applications
6
+ e.g. chopt.c, venus.c, swetest.c
7
+
8
+ Authors: Dieter Koch and Alois Treindl, Astrodienst Zurich
9
+
10
+ coordinate transformations
11
+ obliquity of ecliptic
12
+ nutation
13
+ precession
14
+ delta t
15
+ sidereal time
16
+ setting or getting of tidal acceleration of moon
17
+ chebyshew interpolation
18
+ ephemeris file name generation
19
+ cyclic redundancy checksum CRC
20
+ modulo and normalization functions
21
+
22
+ **************************************************************/
23
+ /* Copyright (C) 1997 - 2008 Astrodienst AG, Switzerland. All rights reserved.
24
+
25
+ License conditions
26
+ ------------------
27
+
28
+ This file is part of Swiss Ephemeris.
29
+
30
+ Swiss Ephemeris is distributed with NO WARRANTY OF ANY KIND. No author
31
+ or distributor accepts any responsibility for the consequences of using it,
32
+ or for whether it serves any particular purpose or works at all, unless he
33
+ or she says so in writing.
34
+
35
+ Swiss Ephemeris is made available by its authors under a dual licensing
36
+ system. The software developer, who uses any part of Swiss Ephemeris
37
+ in his or her software, must choose between one of the two license models,
38
+ which are
39
+ a) GNU public license version 2 or later
40
+ b) Swiss Ephemeris Professional License
41
+
42
+ The choice must be made before the software developer distributes software
43
+ containing parts of Swiss Ephemeris to others, and before any public
44
+ service using the developed software is activated.
45
+
46
+ If the developer choses the GNU GPL software license, he or she must fulfill
47
+ the conditions of that license, which includes the obligation to place his
48
+ or her whole software project under the GNU GPL or a compatible license.
49
+ See http://www.gnu.org/licenses/old-licenses/gpl-2.0.html
50
+
51
+ If the developer choses the Swiss Ephemeris Professional license,
52
+ he must follow the instructions as found in http://www.astro.com/swisseph/
53
+ and purchase the Swiss Ephemeris Professional Edition from Astrodienst
54
+ and sign the corresponding license contract.
55
+
56
+ The License grants you the right to use, copy, modify and redistribute
57
+ Swiss Ephemeris, but only under certain conditions described in the License.
58
+ Among other things, the License requires that the copyright notices and
59
+ this notice be preserved on all copies.
60
+
61
+ Authors of the Swiss Ephemeris: Dieter Koch and Alois Treindl
62
+
63
+ The authors of Swiss Ephemeris have no control or influence over any of
64
+ the derived works, i.e. over software or services created by other
65
+ programmers which use Swiss Ephemeris functions.
66
+
67
+ The names of the authors or of the copyright holder (Astrodienst) must not
68
+ be used for promoting any software, product or service which uses or contains
69
+ the Swiss Ephemeris. This copyright notice is the ONLY place where the
70
+ names of the authors can legally appear, except in cases where they have
71
+ given special permission in writing.
72
+
73
+ The trademarks 'Swiss Ephemeris' and 'Swiss Ephemeris inside' may be used
74
+ for promoting such software, products or services.
75
+ */
76
+
77
+ #include <string.h>
78
+ #include <ctype.h>
79
+ #include "swephexp.h"
80
+ #include "sweph.h"
81
+ #include "swephlib.h"
82
+ #if MSDOS
83
+ # include <process.h>
84
+ #endif
85
+
86
+ #ifdef TRACE
87
+ void swi_open_trace(char *serr);
88
+ FILE *swi_fp_trace_c = NULL;
89
+ FILE *swi_fp_trace_out = NULL;
90
+ int32 swi_trace_count = 0;
91
+ #endif
92
+
93
+ static double tid_acc = SE_TIDAL_DEFAULT;
94
+ static AS_BOOL init_dt_done = FALSE;
95
+ static void init_crc32(void);
96
+ static int init_dt(void);
97
+ static double adjust_for_tidacc(double ans, double Y);
98
+ static double deltat_espenak_meeus_1620(double tjd);
99
+ static double deltat_longterm_morrison_stephenson(double tjd);
100
+ static double deltat_stephenson_morrison_1600(double tjd);
101
+ static double deltat_aa(double tjd);
102
+
103
+ /* Reduce x modulo 360 degrees
104
+ */
105
+ double FAR PASCAL_CONV swe_degnorm(double x)
106
+ {
107
+ double y;
108
+ y = fmod(x, 360.0);
109
+ if (fabs(y) < 1e-13) y = 0; /* Alois fix 11-dec-1999 */
110
+ if( y < 0.0 ) y += 360.0;
111
+ return(y);
112
+ }
113
+
114
+ /* Reduce x modulo TWOPI degrees
115
+ */
116
+ double FAR PASCAL_CONV swe_radnorm(double x)
117
+ {
118
+ double y;
119
+ y = fmod(x, TWOPI);
120
+ if (fabs(y) < 1e-13) y = 0; /* Alois fix 11-dec-1999 */
121
+ if( y < 0.0 ) y += TWOPI;
122
+ return(y);
123
+ }
124
+
125
+ double FAR PASCAL_CONV swe_deg_midp(double x1, double x0)
126
+ {
127
+ double d, y;
128
+ d = swe_difdeg2n(x1, x0); /* arc from x0 to x1 */
129
+ y = swe_degnorm(x0 + d / 2);
130
+ return(y);
131
+ }
132
+
133
+ double FAR PASCAL_CONV swe_rad_midp(double x1, double x0)
134
+ {
135
+ return DEGTORAD * swe_deg_midp(x1 * RADTODEG, x0 * RADTODEG);
136
+ }
137
+
138
+ /* Reduce x modulo 2*PI
139
+ */
140
+ double swi_mod2PI(double x)
141
+ {
142
+ double y;
143
+ y = fmod(x, TWOPI);
144
+ if( y < 0.0 ) y += TWOPI;
145
+ return(y);
146
+ }
147
+
148
+
149
+ double swi_angnorm(double x)
150
+ {
151
+ if (x < 0.0 )
152
+ return x + TWOPI;
153
+ else if (x >= TWOPI)
154
+ return x - TWOPI;
155
+ else
156
+ return x;
157
+ }
158
+
159
+ void swi_cross_prod(double *a, double *b, double *x)
160
+ {
161
+ x[0] = a[1]*b[2] - a[2]*b[1];
162
+ x[1] = a[2]*b[0] - a[0]*b[2];
163
+ x[2] = a[0]*b[1] - a[1]*b[0];
164
+ }
165
+
166
+ /* Evaluates a given chebyshev series coef[0..ncf-1]
167
+ * with ncf terms at x in [-1,1]. Communications of the ACM, algorithm 446,
168
+ * April 1973 (vol. 16 no.4) by Dr. Roger Broucke.
169
+ */
170
+ double swi_echeb(double x, double *coef, int ncf)
171
+ {
172
+ int j;
173
+ double x2, br, brp2, brpp;
174
+ x2 = x * 2.;
175
+ br = 0.;
176
+ brp2 = 0.; /* dummy assign to silence gcc warning */
177
+ brpp = 0.;
178
+ for (j = ncf - 1; j >= 0; j--) {
179
+ brp2 = brpp;
180
+ brpp = br;
181
+ br = x2 * brpp - brp2 + coef[j];
182
+ }
183
+ return (br - brp2) * .5;
184
+ }
185
+
186
+ /*
187
+ * evaluates derivative of chebyshev series, see echeb
188
+ */
189
+ double swi_edcheb(double x, double *coef, int ncf)
190
+ {
191
+ double bjpl, xjpl;
192
+ int j;
193
+ double x2, bf, bj, dj, xj, bjp2, xjp2;
194
+ x2 = x * 2.;
195
+ bf = 0.; /* dummy assign to silence gcc warning */
196
+ bj = 0.; /* dummy assign to silence gcc warning */
197
+ xjp2 = 0.;
198
+ xjpl = 0.;
199
+ bjp2 = 0.;
200
+ bjpl = 0.;
201
+ for (j = ncf - 1; j >= 1; j--) {
202
+ dj = (double) (j + j);
203
+ xj = coef[j] * dj + xjp2;
204
+ bj = x2 * bjpl - bjp2 + xj;
205
+ bf = bjp2;
206
+ bjp2 = bjpl;
207
+ bjpl = bj;
208
+ xjp2 = xjpl;
209
+ xjpl = xj;
210
+ }
211
+ return (bj - bf) * .5;
212
+ }
213
+
214
+ /*
215
+ * conversion between ecliptical and equatorial polar coordinates.
216
+ * for users of SWISSEPH, not used by our routines.
217
+ * for ecl. to equ. eps must be negative.
218
+ * for equ. to ecl. eps must be positive.
219
+ * xpo, xpn are arrays of 3 doubles containing position.
220
+ * attention: input must be in degrees!
221
+ */
222
+ void FAR PASCAL_CONV swe_cotrans(double *xpo, double *xpn, double eps)
223
+ {
224
+ int i;
225
+ double x[6], e = eps * DEGTORAD;
226
+ for(i = 0; i <= 1; i++)
227
+ x[i] = xpo[i];
228
+ x[0] *= DEGTORAD;
229
+ x[1] *= DEGTORAD;
230
+ x[2] = 1;
231
+ for(i = 3; i <= 5; i++)
232
+ x[i] = 0;
233
+ swi_polcart(x, x);
234
+ swi_coortrf(x, x, e);
235
+ swi_cartpol(x, x);
236
+ xpn[0] = x[0] * RADTODEG;
237
+ xpn[1] = x[1] * RADTODEG;
238
+ xpn[2] = xpo[2];
239
+ }
240
+
241
+ /*
242
+ * conversion between ecliptical and equatorial polar coordinates
243
+ * with speed.
244
+ * for users of SWISSEPH, not used by our routines.
245
+ * for ecl. to equ. eps must be negative.
246
+ * for equ. to ecl. eps must be positive.
247
+ * xpo, xpn are arrays of 6 doubles containing position and speed.
248
+ * attention: input must be in degrees!
249
+ */
250
+ void FAR PASCAL_CONV swe_cotrans_sp(double *xpo, double *xpn, double eps)
251
+ {
252
+ int i;
253
+ double x[6], e = eps * DEGTORAD;
254
+ for (i = 0; i <= 5; i++)
255
+ x[i] = xpo[i];
256
+ x[0] *= DEGTORAD;
257
+ x[1] *= DEGTORAD;
258
+ x[2] = 1; /* avoids problems with polcart(), if x[2] = 0 */
259
+ x[3] *= DEGTORAD;
260
+ x[4] *= DEGTORAD;
261
+ swi_polcart_sp(x, x);
262
+ swi_coortrf(x, x, e);
263
+ swi_coortrf(x+3, x+3, e);
264
+ swi_cartpol_sp(x, xpn);
265
+ xpn[0] *= RADTODEG;
266
+ xpn[1] *= RADTODEG;
267
+ xpn[2] = xpo[2];
268
+ xpn[3] *= RADTODEG;
269
+ xpn[4] *= RADTODEG;
270
+ xpn[5] = xpo[5];
271
+ }
272
+
273
+ /*
274
+ * conversion between ecliptical and equatorial cartesian coordinates
275
+ * for ecl. to equ. eps must be negative
276
+ * for equ. to ecl. eps must be positive
277
+ */
278
+ void swi_coortrf(double *xpo, double *xpn, double eps)
279
+ {
280
+ double sineps, coseps;
281
+ double x[3];
282
+ sineps = sin(eps);
283
+ coseps = cos(eps);
284
+ x[0] = xpo[0];
285
+ x[1] = xpo[1] * coseps + xpo[2] * sineps;
286
+ x[2] = -xpo[1] * sineps + xpo[2] * coseps;
287
+ xpn[0] = x[0];
288
+ xpn[1] = x[1];
289
+ xpn[2] = x[2];
290
+ }
291
+
292
+ /*
293
+ * conversion between ecliptical and equatorial cartesian coordinates
294
+ * sineps sin(eps)
295
+ * coseps cos(eps)
296
+ * for ecl. to equ. sineps must be -sin(eps)
297
+ */
298
+ void swi_coortrf2(double *xpo, double *xpn, double sineps, double coseps)
299
+ {
300
+ double x[3];
301
+ x[0] = xpo[0];
302
+ x[1] = xpo[1] * coseps + xpo[2] * sineps;
303
+ x[2] = -xpo[1] * sineps + xpo[2] * coseps;
304
+ xpn[0] = x[0];
305
+ xpn[1] = x[1];
306
+ xpn[2] = x[2];
307
+ }
308
+
309
+ /* conversion of cartesian (x[3]) to polar coordinates (l[3]).
310
+ * x = l is allowed.
311
+ * if |x| = 0, then lon, lat and rad := 0.
312
+ */
313
+ void swi_cartpol(double *x, double *l)
314
+ {
315
+ double rxy;
316
+ double ll[3];
317
+ if (x[0] == 0 && x[1] == 0 && x[2] == 0) {
318
+ l[0] = l[1] = l[2] = 0;
319
+ return;
320
+ }
321
+ rxy = x[0]*x[0] + x[1]*x[1];
322
+ ll[2] = sqrt(rxy + x[2]*x[2]);
323
+ rxy = sqrt(rxy);
324
+ ll[0] = atan2(x[1], x[0]);
325
+ if (ll[0] < 0.0) ll[0] += TWOPI;
326
+ ll[1] = atan(x[2] / rxy);
327
+ l[0] = ll[0];
328
+ l[1] = ll[1];
329
+ l[2] = ll[2];
330
+ }
331
+
332
+ /* conversion from polar (l[3]) to cartesian coordinates (x[3]).
333
+ * x = l is allowed.
334
+ */
335
+ void swi_polcart(double *l, double *x)
336
+ {
337
+ double xx[3];
338
+ double cosl1;
339
+ cosl1 = cos(l[1]);
340
+ xx[0] = l[2] * cosl1 * cos(l[0]);
341
+ xx[1] = l[2] * cosl1 * sin(l[0]);
342
+ xx[2] = l[2] * sin(l[1]);
343
+ x[0] = xx[0];
344
+ x[1] = xx[1];
345
+ x[2] = xx[2];
346
+ }
347
+
348
+ /* conversion of position and speed.
349
+ * from cartesian (x[6]) to polar coordinates (l[6]).
350
+ * x = l is allowed.
351
+ * if position is 0, function returns direction of
352
+ * motion.
353
+ */
354
+ void swi_cartpol_sp(double *x, double *l)
355
+ {
356
+ double xx[6], ll[6];
357
+ double rxy, coslon, sinlon, coslat, sinlat;
358
+ /* zero position */
359
+ if (x[0] == 0 && x[1] == 0 && x[2] == 0) {
360
+ l[0] = l[1] = l[3] = l[4] = 0;
361
+ l[5] = sqrt(square_sum((x+3)));
362
+ swi_cartpol(x+3, l);
363
+ l[2] = 0;
364
+ return;
365
+ }
366
+ /* zero speed */
367
+ if (x[3] == 0 && x[4] == 0 && x[5] == 0) {
368
+ l[3] = l[4] = l[5] = 0;
369
+ swi_cartpol(x, l);
370
+ return;
371
+ }
372
+ /* position */
373
+ rxy = x[0]*x[0] + x[1]*x[1];
374
+ ll[2] = sqrt(rxy + x[2]*x[2]);
375
+ rxy = sqrt(rxy);
376
+ ll[0] = atan2(x[1], x[0]);
377
+ if (ll[0] < 0.0) ll[0] += TWOPI;
378
+ ll[1] = atan(x[2] / rxy);
379
+ /* speed:
380
+ * 1. rotate coordinate system by longitude of position about z-axis,
381
+ * so that new x-axis = position radius projected onto x-y-plane.
382
+ * in the new coordinate system
383
+ * vy'/r = dlong/dt, where r = sqrt(x^2 +y^2).
384
+ * 2. rotate coordinate system by latitude about new y-axis.
385
+ * vz"/r = dlat/dt, where r = position radius.
386
+ * vx" = dr/dt
387
+ */
388
+ coslon = x[0] / rxy; /* cos(l[0]); */
389
+ sinlon = x[1] / rxy; /* sin(l[0]); */
390
+ coslat = rxy / ll[2]; /* cos(l[1]); */
391
+ sinlat = x[2] / ll[2]; /* sin(ll[1]); */
392
+ xx[3] = x[3] * coslon + x[4] * sinlon;
393
+ xx[4] = -x[3] * sinlon + x[4] * coslon;
394
+ l[3] = xx[4] / rxy; /* speed in longitude */
395
+ xx[4] = -sinlat * xx[3] + coslat * x[5];
396
+ xx[5] = coslat * xx[3] + sinlat * x[5];
397
+ l[4] = xx[4] / ll[2]; /* speed in latitude */
398
+ l[5] = xx[5]; /* speed in radius */
399
+ l[0] = ll[0]; /* return position */
400
+ l[1] = ll[1];
401
+ l[2] = ll[2];
402
+ }
403
+
404
+ /* conversion of position and speed
405
+ * from polar (l[6]) to cartesian coordinates (x[6])
406
+ * x = l is allowed
407
+ * explanation s. swi_cartpol_sp()
408
+ */
409
+ void swi_polcart_sp(double *l, double *x)
410
+ {
411
+ double sinlon, coslon, sinlat, coslat;
412
+ double xx[6], rxy, rxyz;
413
+ /* zero speed */
414
+ if (l[3] == 0 && l[4] == 0 && l[5] == 0) {
415
+ x[3] = x[4] = x[5] = 0;
416
+ swi_polcart(l, x);
417
+ return;
418
+ }
419
+ /* position */
420
+ coslon = cos(l[0]);
421
+ sinlon = sin(l[0]);
422
+ coslat = cos(l[1]);
423
+ sinlat = sin(l[1]);
424
+ xx[0] = l[2] * coslat * coslon;
425
+ xx[1] = l[2] * coslat * sinlon;
426
+ xx[2] = l[2] * sinlat;
427
+ /* speed; explanation s. swi_cartpol_sp(), same method the other way round*/
428
+ rxyz = l[2];
429
+ rxy = sqrt(xx[0] * xx[0] + xx[1] * xx[1]);
430
+ xx[5] = l[5];
431
+ xx[4] = l[4] * rxyz;
432
+ x[5] = sinlat * xx[5] + coslat * xx[4]; /* speed z */
433
+ xx[3] = coslat * xx[5] - sinlat * xx[4];
434
+ xx[4] = l[3] * rxy;
435
+ x[3] = coslon * xx[3] - sinlon * xx[4]; /* speed x */
436
+ x[4] = sinlon * xx[3] + coslon * xx[4]; /* speed y */
437
+ x[0] = xx[0]; /* return position */
438
+ x[1] = xx[1];
439
+ x[2] = xx[2];
440
+ }
441
+
442
+ double swi_dot_prod_unit(double *x, double *y)
443
+ {
444
+ double dop = x[0]*y[0]+x[1]*y[1]+x[2]*y[2];
445
+ double e1 = sqrt(x[0]*x[0]+x[1]*x[1]+x[2]*x[2]);
446
+ double e2 = sqrt(y[0]*y[0]+y[1]*y[1]+y[2]*y[2]);
447
+ dop /= e1;
448
+ dop /= e2;
449
+ if (dop > 1)
450
+ dop = 1;
451
+ if (dop < -1)
452
+ dop = -1;
453
+ return dop;
454
+ }
455
+
456
+ /* Obliquity of the ecliptic at Julian date J
457
+ *
458
+ * IAU Coefficients are from:
459
+ * J. H. Lieske, T. Lederle, W. Fricke, and B. Morando,
460
+ * "Expressions for the Precession Quantities Based upon the IAU
461
+ * (1976) System of Astronomical Constants," Astronomy and Astrophysics
462
+ * 58, 1-16 (1977).
463
+ *
464
+ * Before or after 200 years from J2000, the formula used is from:
465
+ * J. Laskar, "Secular terms of classical planetary theories
466
+ * using the results of general theory," Astronomy and Astrophysics
467
+ * 157, 59070 (1986).
468
+ *
469
+ * Bretagnon, P. et al.: 2003, "Expressions for Precession Consistent with
470
+ * the IAU 2000A Model". A&A 400,785
471
+ *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
472
+ *C03 84381.406 -46.836769*t -1831*10-7*t2 +20034*10-7*t3 -576*10-9*t4 -434*10-10*t5
473
+ *
474
+ * See precess and page B18 of the Astronomical Almanac.
475
+ */
476
+ double swi_epsiln(double J)
477
+ {
478
+ double T, eps;
479
+ T = (J - 2451545.0)/36525.0;
480
+ if (PREC_IAU_1976 && fabs(T) <= PREC_IAU_1976_CTIES )
481
+ eps = (((1.813e-3*T-5.9e-4)*T-46.8150)*T+84381.448)*DEGTORAD/3600;
482
+ else if (PREC_IAU_2003 && fabs(T) <= PREC_IAU_2003_CTIES)
483
+ 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;
484
+ else if (PREC_BRETAGNON_2003)
485
+ 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;/* */
486
+ else if (PREC_SIMON_1994)
487
+ 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;/* */
488
+ else if (PREC_WILLIAMS_1994)
489
+ eps = ((((-1.0e-6 * T +2.0e-3) * T -1.74e-4) * T -46.833960) * T + 84381.409) * DEGTORAD / 3600.0;/* */
490
+ else { /* PREC_LASKAR_1986 */
491
+ T /= 10.0;
492
+ eps = ((((((((( 2.45e-10*T + 5.79e-9)*T + 2.787e-7)*T
493
+ + 7.12e-7)*T - 3.905e-5)*T - 2.4967e-3)*T
494
+ - 5.138e-3)*T + 1.99925)*T - 0.0155)*T - 468.093)*T
495
+ + 84381.448;
496
+ eps *= DEGTORAD/3600;
497
+ }
498
+ return(eps);
499
+ }
500
+
501
+ /* Precession of the equinox and ecliptic
502
+ * from epoch Julian date J to or from J2000.0
503
+ *
504
+ * Program by Steve Moshier.
505
+ * Changes in program structure by Dieter Koch.
506
+ *
507
+ * #define PREC_WILLIAMS_1994 1
508
+ * James G. Williams, "Contributions to the Earth's obliquity rate,
509
+ * precession, and nutation," Astron. J. 108, 711-724 (1994).
510
+ *
511
+ * #define PREC_SIMON_1994 0
512
+ * J. L. Simon, P. Bretagnon, J. Chapront, M. Chapront-Touze', G. Francou,
513
+ * and J. Laskar, "Numerical Expressions for precession formulae and
514
+ * mean elements for the Moon and the planets," Astronomy and Astrophysics
515
+ * 282, 663-683 (1994).
516
+ *
517
+ * #define PREC_IAU_1976 0
518
+ * IAU Coefficients are from:
519
+ * J. H. Lieske, T. Lederle, W. Fricke, and B. Morando,
520
+ * "Expressions for the Precession Quantities Based upon the IAU
521
+ * (1976) System of Astronomical Constants," Astronomy and
522
+ * Astrophysics 58, 1-16 (1977).
523
+ *
524
+ * #define PREC_LASKAR_1986 0
525
+ * Newer formulas that cover a much longer time span are from:
526
+ * J. Laskar, "Secular terms of classical planetary theories
527
+ * using the results of general theory," Astronomy and Astrophysics
528
+ * 157, 59070 (1986).
529
+ *
530
+ * See also:
531
+ * P. Bretagnon and G. Francou, "Planetary theories in rectangular
532
+ * and spherical variables. VSOP87 solutions," Astronomy and
533
+ * Astrophysics 202, 309-315 (1988).
534
+ *
535
+ * Laskar's expansions are said by Bretagnon and Francou
536
+ * to have "a precision of about 1" over 10000 years before
537
+ * and after J2000.0 in so far as the precession constants p^0_A
538
+ * and epsilon^0_A are perfectly known."
539
+ *
540
+ * Bretagnon and Francou's expansions for the node and inclination
541
+ * of the ecliptic were derived from Laskar's data but were truncated
542
+ * after the term in T**6. I have recomputed these expansions from
543
+ * Laskar's data, retaining powers up to T**10 in the result.
544
+ *
545
+ * The following table indicates the differences between the result
546
+ * of the IAU formula and Laskar's formula using four different test
547
+ * vectors, checking at J2000 plus and minus the indicated number
548
+ * of years.
549
+ *
550
+ * Years Arc
551
+ * from J2000 Seconds
552
+ * ---------- -------
553
+ * 0 0
554
+ * 100 .006
555
+ * 200 .006
556
+ * 500 .015
557
+ * 1000 .28
558
+ * 2000 6.4
559
+ * 3000 38.
560
+ * 10000 9400.
561
+ */
562
+ /* In WILLIAMS and SIMON, Laskar's terms of order higher than t^4
563
+ have been retained, because Simon et al mention that the solution
564
+ is the same except for the lower order terms. */
565
+
566
+ #if PREC_WILLIAMS_1994
567
+ static double pAcof[] = {
568
+ -8.66e-10, -4.759e-8, 2.424e-7, 1.3095e-5, 1.7451e-4, -1.8055e-3,
569
+ -0.235316, 0.076, 110.5407, 50287.70000 };
570
+ static double nodecof[] = {
571
+ 6.6402e-16, -2.69151e-15, -1.547021e-12, 7.521313e-12, 1.9e-10,
572
+ -3.54e-9, -1.8103e-7, 1.26e-7, 7.436169e-5,
573
+ -0.04207794833, 3.052115282424};
574
+ static double inclcof[] = {
575
+ 1.2147e-16, 7.3759e-17, -8.26287e-14, 2.503410e-13, 2.4650839e-11,
576
+ -5.4000441e-11, 1.32115526e-9, -6.012e-7, -1.62442e-5,
577
+ 0.00227850649, 0.0 };
578
+ #endif
579
+
580
+ #if PREC_SIMON_1994
581
+ /* Precession coefficients from Simon et al: */
582
+ static double pAcof[] = {
583
+ -8.66e-10, -4.759e-8, 2.424e-7, 1.3095e-5, 1.7451e-4, -1.8055e-3,
584
+ -0.235316, 0.07732, 111.2022, 50288.200 };
585
+ static double nodecof[] = {
586
+ 6.6402e-16, -2.69151e-15, -1.547021e-12, 7.521313e-12, 1.9e-10,
587
+ -3.54e-9, -1.8103e-7, 2.579e-8, 7.4379679e-5,
588
+ -0.0420782900, 3.0521126906};
589
+ static double inclcof[] = {
590
+ 1.2147e-16, 7.3759e-17, -8.26287e-14, 2.503410e-13, 2.4650839e-11,
591
+ -5.4000441e-11, 1.32115526e-9, -5.99908e-7, -1.624383e-5,
592
+ 0.002278492868, 0.0 };
593
+ #endif
594
+
595
+ #if PREC_LASKAR_1986
596
+ /* Precession coefficients taken from Laskar's paper: */
597
+ static double pAcof[] = {
598
+ -8.66e-10, -4.759e-8, 2.424e-7, 1.3095e-5, 1.7451e-4, -1.8055e-3,
599
+ -0.235316, 0.07732, 111.1971, 50290.966 };
600
+ /* Node and inclination of the earth's orbit computed from
601
+ * Laskar's data as done in Bretagnon and Francou's paper.
602
+ * Units are radians.
603
+ */
604
+ static double nodecof[] = {
605
+ 6.6402e-16, -2.69151e-15, -1.547021e-12, 7.521313e-12, 6.3190131e-10,
606
+ -3.48388152e-9, -1.813065896e-7, 2.75036225e-8, 7.4394531426e-5,
607
+ -0.042078604317, 3.052112654975 };
608
+ static double inclcof[] = {
609
+ 1.2147e-16, 7.3759e-17, -8.26287e-14, 2.503410e-13, 2.4650839e-11,
610
+ -5.4000441e-11, 1.32115526e-9, -5.998737027e-7, -1.6242797091e-5,
611
+ 0.002278495537, 0.0 };
612
+ #endif
613
+
614
+ #if PREC_BRETAGNON_2003
615
+ static double pAcof[] = {};
616
+ static double nodecof[] = {};
617
+ static double inclcof[] = {};
618
+ #endif
619
+
620
+ /* Subroutine arguments:
621
+ *
622
+ * R = rectangular equatorial coordinate vector to be precessed.
623
+ * The result is written back into the input vector.
624
+ * J = Julian date
625
+ * direction =
626
+ * Precess from J to J2000: direction = 1
627
+ * Precess from J2000 to J: direction = -1
628
+ * Note that if you want to precess from J1 to J2, you would
629
+ * first go from J1 to J2000, then call the program again
630
+ * to go from J2000 to J2.
631
+ */
632
+ int swi_precess(double *R, double J, int direction )
633
+ {
634
+ double sinth, costh, sinZ, cosZ, sinz, cosz;
635
+ double eps, sineps, coseps;
636
+ double A, B, T, Z, z, TH, pA, W;
637
+ double x[3];
638
+ double *p;
639
+ int i;
640
+ if( J == J2000 )
641
+ return(0);
642
+ /* Each precession angle is specified by a polynomial in
643
+ * T = Julian centuries from J2000.0. See AA page B18.
644
+ */
645
+ T = (J - J2000)/36525.0;
646
+ /* Use IAU formula for a few centuries. */
647
+ if (PREC_IAU_1976 && fabs(T) <= PREC_IAU_1976_CTIES) {
648
+ Z = (( 0.017998*T + 0.30188)*T + 2306.2181)*T*DEGTORAD/3600;
649
+ z = (( 0.018203*T + 1.09468)*T + 2306.2181)*T*DEGTORAD/3600;
650
+ TH = ((-0.041833*T - 0.42665)*T + 2004.3109)*T*DEGTORAD/3600;
651
+ } else if (PREC_IAU_2003 && fabs(T) <= PREC_IAU_2003_CTIES) {
652
+ Z = (((((- 0.0000003173*T - 0.000005971)*T + 0.01801828)*T + 0.2988499)*T + 2306.083227)*T + 2.650545)*DEGTORAD/3600;
653
+ z = (((((- 0.0000002904*T - 0.000028596)*T + 0.01826837)*T + 1.0927348)*T + 2306.077181)*T - 2.650545)*DEGTORAD/3600;
654
+ TH = ((((-0.00000011274*T - 0.000007089)*T - 0.04182264)*T - 0.4294934)*T + 2004.191903)*T*DEGTORAD/3600;
655
+ /* AA 2006 B28:
656
+ Z = (((((- 0.0000002*T - 0.0000327)*T + 0.0179663)*T + 0.3019015)*T + 2306.0809506)*T + 2.5976176)*DEGTORAD/3600;
657
+ z = (((((- 0.0000003*T - 0.000047)*T + 0.0182237)*T + 1.0947790)*T + 2306.0803226)*T - 2.5976176)*DEGTORAD/3600;
658
+ TH = ((((-0.0000001*T - 0.0000601)*T - 0.0418251)*T - 0.4269353)*T + 2004.1917476)*T*DEGTORAD/3600;
659
+ */
660
+ } else if (PREC_BRETAGNON_2003) {
661
+ Z = ((((((-0.00000000013*T - 0.0000003040)*T - 0.000005708)*T + 0.01801752)*T + 0.3023262)*T + 2306.080472)*T + 2.72767)*DEGTORAD/3600;
662
+ z = ((((((-0.00000000005*T - 0.0000002486)*T - 0.000028276)*T + 0.01826676)*T + 1.0956768)*T + 2306.076070)*T - 2.72767)*DEGTORAD/3600;
663
+ TH = ((((((0.000000000009*T + 0.00000000036)*T -0.0000001127)*T - 0.000007291)*T - 0.04182364)*T - 0.4266980)*T + 2004.190936)*T*DEGTORAD/3600;
664
+ } else {
665
+ goto laskar;
666
+ }
667
+ sinth = sin(TH);
668
+ costh = cos(TH);
669
+ sinZ = sin(Z);
670
+ cosZ = cos(Z);
671
+ sinz = sin(z);
672
+ cosz = cos(z);
673
+ A = cosZ*costh;
674
+ B = sinZ*costh;
675
+ if( direction < 0 ) { /* From J2000.0 to J */
676
+ x[0] = (A*cosz - sinZ*sinz)*R[0]
677
+ - (B*cosz + cosZ*sinz)*R[1]
678
+ - sinth*cosz*R[2];
679
+ x[1] = (A*sinz + sinZ*cosz)*R[0]
680
+ - (B*sinz - cosZ*cosz)*R[1]
681
+ - sinth*sinz*R[2];
682
+ x[2] = cosZ*sinth*R[0]
683
+ - sinZ*sinth*R[1]
684
+ + costh*R[2];
685
+ }
686
+ else { /* From J to J2000.0 */
687
+ x[0] = (A*cosz - sinZ*sinz)*R[0]
688
+ + (A*sinz + sinZ*cosz)*R[1]
689
+ + cosZ*sinth*R[2];
690
+ x[1] = - (B*cosz + cosZ*sinz)*R[0]
691
+ - (B*sinz - cosZ*cosz)*R[1]
692
+ - sinZ*sinth*R[2];
693
+ x[2] = - sinth*cosz*R[0]
694
+ - sinth*sinz*R[1]
695
+ + costh*R[2];
696
+ }
697
+ goto done;
698
+ laskar:
699
+ /* Implementation by elementary rotations using Laskar's expansions.
700
+ * First rotate about the x axis from the initial equator
701
+ * to the ecliptic. (The input is equatorial.)
702
+ */
703
+ if( direction == 1 )
704
+ eps = swi_epsiln(J); /* To J2000 */
705
+ else
706
+ eps = swi_epsiln(J2000); /* From J2000 */
707
+ sineps = sin(eps);
708
+ coseps = cos(eps);
709
+ x[0] = R[0];
710
+ z = coseps*R[1] + sineps*R[2];
711
+ x[2] = -sineps*R[1] + coseps*R[2];
712
+ x[1] = z;
713
+ /* Precession in longitude */
714
+ T /= 10.0; /* thousands of years */
715
+ p = pAcof;
716
+ pA = *p++;
717
+ for( i=0; i<9; i++ )
718
+ pA = pA * T + *p++;
719
+ pA *= DEGTORAD/3600 * T;
720
+ /* Node of the moving ecliptic on the J2000 ecliptic.
721
+ */
722
+ p = nodecof;
723
+ W = *p++;
724
+ for( i=0; i<10; i++ )
725
+ W = W * T + *p++;
726
+ /* Rotate about z axis to the node.
727
+ */
728
+ if( direction == 1 )
729
+ z = W + pA;
730
+ else
731
+ z = W;
732
+ B = cos(z);
733
+ A = sin(z);
734
+ z = B * x[0] + A * x[1];
735
+ x[1] = -A * x[0] + B * x[1];
736
+ x[0] = z;
737
+ /* Rotate about new x axis by the inclination of the moving
738
+ * ecliptic on the J2000 ecliptic.
739
+ */
740
+ p = inclcof;
741
+ z = *p++;
742
+ for( i=0; i<10; i++ )
743
+ z = z * T + *p++;
744
+ if( direction == 1 )
745
+ z = -z;
746
+ B = cos(z);
747
+ A = sin(z);
748
+ z = B * x[1] + A * x[2];
749
+ x[2] = -A * x[1] + B * x[2];
750
+ x[1] = z;
751
+ /* Rotate about new z axis back from the node.
752
+ */
753
+ if( direction == 1 )
754
+ z = -W;
755
+ else
756
+ z = -W - pA;
757
+ B = cos(z);
758
+ A = sin(z);
759
+ z = B * x[0] + A * x[1];
760
+ x[1] = -A * x[0] + B * x[1];
761
+ x[0] = z;
762
+ /* Rotate about x axis to final equator.
763
+ */
764
+ if( direction == 1 )
765
+ eps = swi_epsiln(J2000);
766
+ else
767
+ eps = swi_epsiln(J);
768
+ sineps = sin(eps);
769
+ coseps = cos(eps);
770
+ z = coseps * x[1] - sineps * x[2];
771
+ x[2] = sineps * x[1] + coseps * x[2];
772
+ x[1] = z;
773
+ done:
774
+ for( i=0; i<3; i++ )
775
+ R[i] = x[i];
776
+ return(0);
777
+ }
778
+
779
+ #if NUT_IAU_1980
780
+ /* Nutation in longitude and obliquity
781
+ * computed at Julian date J.
782
+ *
783
+ * References:
784
+ * "Summary of 1980 IAU Theory of Nutation (Final Report of the
785
+ * IAU Working Group on Nutation)", P. K. Seidelmann et al., in
786
+ * Transactions of the IAU Vol. XVIII A, Reports on Astronomy,
787
+ * P. A. Wayman, ed.; D. Reidel Pub. Co., 1982.
788
+ *
789
+ * "Nutation and the Earth's Rotation",
790
+ * I.A.U. Symposium No. 78, May, 1977, page 256.
791
+ * I.A.U., 1980.
792
+ *
793
+ * Woolard, E.W., "A redevelopment of the theory of nutation",
794
+ * The Astronomical Journal, 58, 1-3 (1953).
795
+ *
796
+ * This program implements all of the 1980 IAU nutation series.
797
+ * Results checked at 100 points against the 1986 AA; all agreed.
798
+ *
799
+ *
800
+ * - S. L. Moshier, November 1987
801
+ * October, 1992 - typo fixed in nutation matrix
802
+ *
803
+ * - D. Koch, November 1995: small changes in structure,
804
+ * Corrections to IAU 1980 Series added from Expl. Suppl. p. 116
805
+ *
806
+ * Each term in the expansion has a trigonometric
807
+ * argument given by
808
+ * W = i*MM + j*MS + k*FF + l*DD + m*OM
809
+ * where the variables are defined below.
810
+ * The nutation in longitude is a sum of terms of the
811
+ * form (a + bT) * sin(W). The terms for nutation in obliquity
812
+ * are of the form (c + dT) * cos(W). The coefficients
813
+ * are arranged in the tabulation as follows:
814
+ *
815
+ * Coefficient:
816
+ * i j k l m a b c d
817
+ * 0, 0, 0, 0, 1, -171996, -1742, 92025, 89,
818
+ * The first line of the table, above, is done separately
819
+ * since two of the values do not fit into 16 bit integers.
820
+ * The values a and c are arc seconds times 10000. b and d
821
+ * are arc seconds per Julian century times 100000. i through m
822
+ * are integers. See the program for interpretation of MM, MS,
823
+ * etc., which are mean orbital elements of the Sun and Moon.
824
+ *
825
+ * If terms with coefficient less than X are omitted, the peak
826
+ * errors will be:
827
+ *
828
+ * omit error, omit error,
829
+ * a < longitude c < obliquity
830
+ * .0005" .0100" .0008" .0094"
831
+ * .0046 .0492 .0095 .0481
832
+ * .0123 .0880 .0224 .0905
833
+ * .0386 .1808 .0895 .1129
834
+ */
835
+ static short FAR nt[] = {
836
+ /* LS and OC are units of 0.0001"
837
+ *LS2 and OC2 are units of 0.00001"
838
+ *MM,MS,FF,DD,OM, LS, LS2,OC, OC2 */
839
+ 0, 0, 0, 0, 2, 2062, 2,-895, 5,
840
+ -2, 0, 2, 0, 1, 46, 0,-24, 0,
841
+ 2, 0,-2, 0, 0, 11, 0, 0, 0,
842
+ -2, 0, 2, 0, 2,-3, 0, 1, 0,
843
+ 1,-1, 0,-1, 0,-3, 0, 0, 0,
844
+ 0,-2, 2,-2, 1,-2, 0, 1, 0,
845
+ 2, 0,-2, 0, 1, 1, 0, 0, 0,
846
+ 0, 0, 2,-2, 2,-13187,-16, 5736,-31,
847
+ 0, 1, 0, 0, 0, 1426,-34, 54,-1,
848
+ 0, 1, 2,-2, 2,-517, 12, 224,-6,
849
+ 0,-1, 2,-2, 2, 217,-5,-95, 3,
850
+ 0, 0, 2,-2, 1, 129, 1,-70, 0,
851
+ 2, 0, 0,-2, 0, 48, 0, 1, 0,
852
+ 0, 0, 2,-2, 0,-22, 0, 0, 0,
853
+ 0, 2, 0, 0, 0, 17,-1, 0, 0,
854
+ 0, 1, 0, 0, 1,-15, 0, 9, 0,
855
+ 0, 2, 2,-2, 2,-16, 1, 7, 0,
856
+ 0,-1, 0, 0, 1,-12, 0, 6, 0,
857
+ -2, 0, 0, 2, 1,-6, 0, 3, 0,
858
+ 0,-1, 2,-2, 1,-5, 0, 3, 0,
859
+ 2, 0, 0,-2, 1, 4, 0,-2, 0,
860
+ 0, 1, 2,-2, 1, 4, 0,-2, 0,
861
+ 1, 0, 0,-1, 0,-4, 0, 0, 0,
862
+ 2, 1, 0,-2, 0, 1, 0, 0, 0,
863
+ 0, 0,-2, 2, 1, 1, 0, 0, 0,
864
+ 0, 1,-2, 2, 0,-1, 0, 0, 0,
865
+ 0, 1, 0, 0, 2, 1, 0, 0, 0,
866
+ -1, 0, 0, 1, 1, 1, 0, 0, 0,
867
+ 0, 1, 2,-2, 0,-1, 0, 0, 0,
868
+ 0, 0, 2, 0, 2,-2274,-2, 977,-5,
869
+ 1, 0, 0, 0, 0, 712, 1,-7, 0,
870
+ 0, 0, 2, 0, 1,-386,-4, 200, 0,
871
+ 1, 0, 2, 0, 2,-301, 0, 129,-1,
872
+ 1, 0, 0,-2, 0,-158, 0,-1, 0,
873
+ -1, 0, 2, 0, 2, 123, 0,-53, 0,
874
+ 0, 0, 0, 2, 0, 63, 0,-2, 0,
875
+ 1, 0, 0, 0, 1, 63, 1,-33, 0,
876
+ -1, 0, 0, 0, 1,-58,-1, 32, 0,
877
+ -1, 0, 2, 2, 2,-59, 0, 26, 0,
878
+ 1, 0, 2, 0, 1,-51, 0, 27, 0,
879
+ 0, 0, 2, 2, 2,-38, 0, 16, 0,
880
+ 2, 0, 0, 0, 0, 29, 0,-1, 0,
881
+ 1, 0, 2,-2, 2, 29, 0,-12, 0,
882
+ 2, 0, 2, 0, 2,-31, 0, 13, 0,
883
+ 0, 0, 2, 0, 0, 26, 0,-1, 0,
884
+ -1, 0, 2, 0, 1, 21, 0,-10, 0,
885
+ -1, 0, 0, 2, 1, 16, 0,-8, 0,
886
+ 1, 0, 0,-2, 1,-13, 0, 7, 0,
887
+ -1, 0, 2, 2, 1,-10, 0, 5, 0,
888
+ 1, 1, 0,-2, 0,-7, 0, 0, 0,
889
+ 0, 1, 2, 0, 2, 7, 0,-3, 0,
890
+ 0,-1, 2, 0, 2,-7, 0, 3, 0,
891
+ 1, 0, 2, 2, 2,-8, 0, 3, 0,
892
+ 1, 0, 0, 2, 0, 6, 0, 0, 0,
893
+ 2, 0, 2,-2, 2, 6, 0,-3, 0,
894
+ 0, 0, 0, 2, 1,-6, 0, 3, 0,
895
+ 0, 0, 2, 2, 1,-7, 0, 3, 0,
896
+ 1, 0, 2,-2, 1, 6, 0,-3, 0,
897
+ 0, 0, 0,-2, 1,-5, 0, 3, 0,
898
+ 1,-1, 0, 0, 0, 5, 0, 0, 0,
899
+ 2, 0, 2, 0, 1,-5, 0, 3, 0,
900
+ 0, 1, 0,-2, 0,-4, 0, 0, 0,
901
+ 1, 0,-2, 0, 0, 4, 0, 0, 0,
902
+ 0, 0, 0, 1, 0,-4, 0, 0, 0,
903
+ 1, 1, 0, 0, 0,-3, 0, 0, 0,
904
+ 1, 0, 2, 0, 0, 3, 0, 0, 0,
905
+ 1,-1, 2, 0, 2,-3, 0, 1, 0,
906
+ -1,-1, 2, 2, 2,-3, 0, 1, 0,
907
+ -2, 0, 0, 0, 1,-2, 0, 1, 0,
908
+ 3, 0, 2, 0, 2,-3, 0, 1, 0,
909
+ 0,-1, 2, 2, 2,-3, 0, 1, 0,
910
+ 1, 1, 2, 0, 2, 2, 0,-1, 0,
911
+ -1, 0, 2,-2, 1,-2, 0, 1, 0,
912
+ 2, 0, 0, 0, 1, 2, 0,-1, 0,
913
+ 1, 0, 0, 0, 2,-2, 0, 1, 0,
914
+ 3, 0, 0, 0, 0, 2, 0, 0, 0,
915
+ 0, 0, 2, 1, 2, 2, 0,-1, 0,
916
+ -1, 0, 0, 0, 2, 1, 0,-1, 0,
917
+ 1, 0, 0,-4, 0,-1, 0, 0, 0,
918
+ -2, 0, 2, 2, 2, 1, 0,-1, 0,
919
+ -1, 0, 2, 4, 2,-2, 0, 1, 0,
920
+ 2, 0, 0,-4, 0,-1, 0, 0, 0,
921
+ 1, 1, 2,-2, 2, 1, 0,-1, 0,
922
+ 1, 0, 2, 2, 1,-1, 0, 1, 0,
923
+ -2, 0, 2, 4, 2,-1, 0, 1, 0,
924
+ -1, 0, 4, 0, 2, 1, 0, 0, 0,
925
+ 1,-1, 0,-2, 0, 1, 0, 0, 0,
926
+ 2, 0, 2,-2, 1, 1, 0,-1, 0,
927
+ 2, 0, 2, 2, 2,-1, 0, 0, 0,
928
+ 1, 0, 0, 2, 1,-1, 0, 0, 0,
929
+ 0, 0, 4,-2, 2, 1, 0, 0, 0,
930
+ 3, 0, 2,-2, 2, 1, 0, 0, 0,
931
+ 1, 0, 2,-2, 0,-1, 0, 0, 0,
932
+ 0, 1, 2, 0, 1, 1, 0, 0, 0,
933
+ -1,-1, 0, 2, 1, 1, 0, 0, 0,
934
+ 0, 0,-2, 0, 1,-1, 0, 0, 0,
935
+ 0, 0, 2,-1, 2,-1, 0, 0, 0,
936
+ 0, 1, 0, 2, 0,-1, 0, 0, 0,
937
+ 1, 0,-2,-2, 0,-1, 0, 0, 0,
938
+ 0,-1, 2, 0, 1,-1, 0, 0, 0,
939
+ 1, 1, 0,-2, 1,-1, 0, 0, 0,
940
+ 1, 0,-2, 2, 0,-1, 0, 0, 0,
941
+ 2, 0, 0, 2, 0, 1, 0, 0, 0,
942
+ 0, 0, 2, 4, 2,-1, 0, 0, 0,
943
+ 0, 1, 0, 1, 0, 1, 0, 0, 0,
944
+ #if NUT_CORR_1987
945
+ /* corrections to IAU 1980 nutation series by Herring 1987
946
+ * in 0.00001" !!!
947
+ * LS OC */
948
+ 101, 0, 0, 0, 1,-725, 0, 213, 0,
949
+ 101, 1, 0, 0, 0, 523, 0, 208, 0,
950
+ 101, 0, 2,-2, 2, 102, 0, -41, 0,
951
+ 101, 0, 2, 0, 2, -81, 0, 32, 0,
952
+ /* LC OS !!! */
953
+ 102, 0, 0, 0, 1, 417, 0, 224, 0,
954
+ 102, 1, 0, 0, 0, 61, 0, -24, 0,
955
+ 102, 0, 2,-2, 2,-118, 0, -47, 0,
956
+ #endif
957
+ ENDMARK,
958
+ };
959
+ #endif
960
+
961
+ #if NUT_IAU_1980
962
+ int swi_nutation(double J, double *nutlo)
963
+ {
964
+ /* arrays to hold sines and cosines of multiple angles */
965
+ double ss[5][8];
966
+ double cc[5][8];
967
+ double arg;
968
+ double args[5];
969
+ double f, g, T, T2;
970
+ double MM, MS, FF, DD, OM;
971
+ double cu, su, cv, sv, sw, s;
972
+ double C, D;
973
+ int i, j, k, k1, m, n;
974
+ int ns[5];
975
+ short *p;
976
+ /* Julian centuries from 2000 January 1.5,
977
+ * barycentric dynamical time
978
+ */
979
+ T = (J - 2451545.0) / 36525.0;
980
+ T2 = T * T;
981
+ /* Fundamental arguments in the FK5 reference system.
982
+ * The coefficients, originally given to 0.001",
983
+ * are converted here to degrees.
984
+ */
985
+ /* longitude of the mean ascending node of the lunar orbit
986
+ * on the ecliptic, measured from the mean equinox of date
987
+ */
988
+ OM = -6962890.539 * T + 450160.280 + (0.008 * T + 7.455) * T2;
989
+ OM = swe_degnorm(OM/3600) * DEGTORAD;
990
+ /* mean longitude of the Sun minus the
991
+ * mean longitude of the Sun's perigee
992
+ */
993
+ MS = 129596581.224 * T + 1287099.804 - (0.012 * T + 0.577) * T2;
994
+ MS = swe_degnorm(MS/3600) * DEGTORAD;
995
+ /* mean longitude of the Moon minus the
996
+ * mean longitude of the Moon's perigee
997
+ */
998
+ MM = 1717915922.633 * T + 485866.733 + (0.064 * T + 31.310) * T2;
999
+ MM = swe_degnorm(MM/3600) * DEGTORAD;
1000
+ /* mean longitude of the Moon minus the
1001
+ * mean longitude of the Moon's node
1002
+ */
1003
+ FF = 1739527263.137 * T + 335778.877 + (0.011 * T - 13.257) * T2;
1004
+ FF = swe_degnorm(FF/3600) * DEGTORAD;
1005
+ /* mean elongation of the Moon from the Sun.
1006
+ */
1007
+ DD = 1602961601.328 * T + 1072261.307 + (0.019 * T - 6.891) * T2;
1008
+ DD = swe_degnorm(DD/3600) * DEGTORAD;
1009
+ args[0] = MM;
1010
+ ns[0] = 3;
1011
+ args[1] = MS;
1012
+ ns[1] = 2;
1013
+ args[2] = FF;
1014
+ ns[2] = 4;
1015
+ args[3] = DD;
1016
+ ns[3] = 4;
1017
+ args[4] = OM;
1018
+ ns[4] = 2;
1019
+ /* Calculate sin( i*MM ), etc. for needed multiple angles
1020
+ */
1021
+ for (k = 0; k <= 4; k++) {
1022
+ arg = args[k];
1023
+ n = ns[k];
1024
+ su = sin(arg);
1025
+ cu = cos(arg);
1026
+ ss[k][0] = su; /* sin(L) */
1027
+ cc[k][0] = cu; /* cos(L) */
1028
+ sv = 2.0*su*cu;
1029
+ cv = cu*cu - su*su;
1030
+ ss[k][1] = sv; /* sin(2L) */
1031
+ cc[k][1] = cv;
1032
+ for( i=2; i<n; i++ ) {
1033
+ s = su*cv + cu*sv;
1034
+ cv = cu*cv - su*sv;
1035
+ sv = s;
1036
+ ss[k][i] = sv; /* sin( i+1 L ) */
1037
+ cc[k][i] = cv;
1038
+ }
1039
+ }
1040
+ /* first terms, not in table: */
1041
+ C = (-0.01742*T - 17.1996)*ss[4][0]; /* sin(OM) */
1042
+ D = ( 0.00089*T + 9.2025)*cc[4][0]; /* cos(OM) */
1043
+ for(p = &nt[0]; *p != ENDMARK; p += 9) {
1044
+ /* argument of sine and cosine */
1045
+ k1 = 0;
1046
+ cv = 0.0;
1047
+ sv = 0.0;
1048
+ for( m=0; m<5; m++ ) {
1049
+ j = p[m];
1050
+ if (j > 100)
1051
+ j = 0; /* p[0] is a flag */
1052
+ if( j ) {
1053
+ k = j;
1054
+ if( j < 0 )
1055
+ k = -k;
1056
+ su = ss[m][k-1]; /* sin(k*angle) */
1057
+ if( j < 0 )
1058
+ su = -su;
1059
+ cu = cc[m][k-1];
1060
+ if( k1 == 0 ) { /* set first angle */
1061
+ sv = su;
1062
+ cv = cu;
1063
+ k1 = 1;
1064
+ }
1065
+ else { /* combine angles */
1066
+ sw = su*cv + cu*sv;
1067
+ cv = cu*cv - su*sv;
1068
+ sv = sw;
1069
+ }
1070
+ }
1071
+ }
1072
+ /* longitude coefficient, in 0.0001" */
1073
+ f = p[5] * 0.0001;
1074
+ if( p[6] != 0 )
1075
+ f += 0.00001 * T * p[6];
1076
+ /* obliquity coefficient, in 0.0001" */
1077
+ g = p[7] * 0.0001;
1078
+ if( p[8] != 0 )
1079
+ g += 0.00001 * T * p[8];
1080
+ if (*p >= 100) { /* coefficients in 0.00001" */
1081
+ f *= 0.1;
1082
+ g *= 0.1;
1083
+ }
1084
+ /* accumulate the terms */
1085
+ if (*p != 102) {
1086
+ C += f * sv;
1087
+ D += g * cv;
1088
+ }
1089
+ else { /* cos for nutl and sin for nuto */
1090
+ C += f * cv;
1091
+ D += g * sv;
1092
+ }
1093
+ /*
1094
+ if (i >= 105) {
1095
+ printf("%4.10f, %4.10f\n",f*sv,g*cv);
1096
+ }
1097
+ */
1098
+ }
1099
+ /*
1100
+ printf("%4.10f, %4.10f, %4.10f, %4.10f\n",MS*RADTODEG,FF*RADTODEG,DD*RADTODEG,OM*RADTODEG);
1101
+ printf( "nutation: in longitude %.9f\", in obliquity %.9f\"\n", C, D );
1102
+ */
1103
+ /* Save answers, expressed in radians */
1104
+ nutlo[0] = DEGTORAD * C / 3600.0;
1105
+ nutlo[1] = DEGTORAD * D / 3600.0;
1106
+ return(0);
1107
+ }
1108
+ #endif
1109
+
1110
+ #if NUT_IAU_2000A || NUT_IAU_2000B
1111
+ /* Nutation IAU 2000A model
1112
+ * (MHB2000 luni-solar and planetary nutation, without free core nutation)
1113
+ *
1114
+ * Function returns nutation in longitude and obliquity in radians with
1115
+ * respect to the equinox of date. For the obliquity of the ecliptic
1116
+ * the calculation of Lieske & al. (1977) must be used.
1117
+ *
1118
+ * The precision in recent years is about 0.001 arc seconds.
1119
+ *
1120
+ * The calculation includes luni-solar and planetary nutation.
1121
+ * Free core nutation, which cannot be predicted, is omitted,
1122
+ * the error being of the order of a few 0.0001 arc seconds.
1123
+ *
1124
+ * References:
1125
+ *
1126
+ * Capitaine, N., Wallace, P.T., Chapront, J., A & A 432, 366 (2005).
1127
+ *
1128
+ * Chapront, J., Chapront-Touze, M. & Francou, G., A & A 387, 700 (2002).
1129
+ *
1130
+ * Lieske, J.H., Lederle, T., Fricke, W. & Morando, B., "Expressions
1131
+ * for the precession quantities based upon the IAU (1976) System of
1132
+ * Astronomical Constants", A & A 58, 1-16 (1977).
1133
+ *
1134
+ * Mathews, P.M., Herring, T.A., Buffet, B.A., "Modeling of nutation
1135
+ * and precession New nutation series for nonrigid Earth and
1136
+ * insights into the Earth's interior", J.Geophys.Res., 107, B4,
1137
+ * 2002.
1138
+ *
1139
+ * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M.,
1140
+ * Francou, G., Laskar, J., A & A 282, 663-683 (1994).
1141
+ *
1142
+ * Souchay, J., Loysel, B., Kinoshita, H., Folgueira, M., A & A Supp.
1143
+ * Ser. 135, 111 (1999).
1144
+ *
1145
+ * Wallace, P.T., "Software for Implementing the IAU 2000
1146
+ * Resolutions", in IERS Workshop 5.1 (2002).
1147
+ *
1148
+ * Nutation IAU 2000A series in:
1149
+ * Kaplan, G.H., United States Naval Observatory Circular No. 179 (Oct. 2005)
1150
+ * aa.usno.navy.mil/publications/docs/Circular_179.html
1151
+ *
1152
+ * MHB2000 code at
1153
+ * - ftp://maia.usno.navy.mil/conv2000/chapter5/IAU2000A.
1154
+ * - http://www.iau-sofa.rl.ac.uk/2005_0901/Downloads.html
1155
+ */
1156
+
1157
+ #include "swenut2000a.h"
1158
+ int swi_nutation(double J, double *nutlo)
1159
+ {
1160
+ int i, j, k, inls;
1161
+ double M, SM, F, D, OM;
1162
+ #if NUT_IAU_2000A
1163
+ double AL, ALSU, AF, AD, AOM, APA;
1164
+ double ALME, ALVE, ALEA, ALMA, ALJU, ALSA, ALUR, ALNE;
1165
+ #endif
1166
+ double darg, sinarg, cosarg;
1167
+ double dpsi = 0, deps = 0;
1168
+ double T = (J - J2000 ) / 36525.0;
1169
+ /* luni-solar nutation */
1170
+ /* Fundamental arguments, Simon & al. (1994) */
1171
+ /* Mean anomaly of the Moon. */
1172
+ M = swe_degnorm(( 485868.249036 +
1173
+ T*( 1717915923.2178 +
1174
+ T*( 31.8792 +
1175
+ T*( 0.051635 +
1176
+ T*( - 0.00024470 ))))) / 3600.0) * DEGTORAD;
1177
+ /* Mean anomaly of the Sun */
1178
+ SM = swe_degnorm((1287104.79305 +
1179
+ T*( 129596581.0481 +
1180
+ T*( - 0.5532 +
1181
+ T*( 0.000136 +
1182
+ T*( - 0.00001149 ))))) / 3600.0) * DEGTORAD;
1183
+ /* Mean argument of the latitude of the Moon. */
1184
+ F = swe_degnorm(( 335779.526232 +
1185
+ T*( 1739527262.8478 +
1186
+ T*( - 12.7512 +
1187
+ T*( - 0.001037 +
1188
+ T*( 0.00000417 ))))) / 3600.0) * DEGTORAD;
1189
+ /* Mean elongation of the Moon from the Sun. */
1190
+ D = swe_degnorm((1072260.70369 +
1191
+ T*( 1602961601.2090 +
1192
+ T*( - 6.3706 +
1193
+ T*( 0.006593 +
1194
+ T*( - 0.00003169 ))))) / 3600.0) * DEGTORAD;
1195
+ /* Mean longitude of the ascending node of the Moon. */
1196
+ OM = swe_degnorm(( 450160.398036 +
1197
+ T*( - 6962890.5431 +
1198
+ T*( 7.4722 +
1199
+ T*( 0.007702 +
1200
+ T*( - 0.00005939 ))))) / 3600.0) * DEGTORAD;
1201
+ /* luni-solar nutation series, in reverse order, starting with small terms */
1202
+ #if NUT_IAU_2000B
1203
+ inls = NLS_2000B;
1204
+ #else
1205
+ inls = NLS;
1206
+ #endif
1207
+ for (i = inls - 1; i >= 0; i--) {
1208
+ j = i * 5;
1209
+ darg = swe_radnorm((double) nls[j + 0] * M +
1210
+ (double) nls[j + 1] * SM +
1211
+ (double) nls[j + 2] * F +
1212
+ (double) nls[j + 3] * D +
1213
+ (double) nls[j + 4] * OM);
1214
+ sinarg = sin(darg);
1215
+ cosarg = cos(darg);
1216
+ k = i * 6;
1217
+ dpsi += (cls[k+0] + cls[k+1] * T) * sinarg + cls[k+2] * cosarg;
1218
+ deps += (cls[k+3] + cls[k+4] * T) * cosarg + cls[k+5] * sinarg;
1219
+ }
1220
+ nutlo[0] = dpsi * O1MAS2DEG;
1221
+ nutlo[1] = deps * O1MAS2DEG;
1222
+ #if NUT_IAU_2000A
1223
+ /* planetary nutation
1224
+ * note: The MHB2000 code computes the luni-solar and planetary nutation
1225
+ * in different routines, using slightly different Delaunay
1226
+ * arguments in the two cases. This behaviour is faithfully
1227
+ * reproduced here. Use of the Simon et al. expressions for both
1228
+ * cases leads to negligible changes, well below 0.1 microarcsecond.*/
1229
+ /* Mean anomaly of the Moon.*/
1230
+ AL = swe_radnorm(2.35555598 + 8328.6914269554 * T);
1231
+ /* Mean anomaly of the Sun.*/
1232
+ ALSU = swe_radnorm(6.24006013 + 628.301955 * T);
1233
+ /* Mean argument of the latitude of the Moon. */
1234
+ AF = swe_radnorm(1.627905234 + 8433.466158131 * T);
1235
+ /* Mean elongation of the Moon from the Sun. */
1236
+ AD = swe_radnorm(5.198466741 + 7771.3771468121 * T);
1237
+ /* Mean longitude of the ascending node of the Moon. */
1238
+ AOM = swe_radnorm(2.18243920 - 33.757045 * T);
1239
+ /* General accumulated precession in longitude. */
1240
+ APA = (0.02438175 + 0.00000538691 * T) * T;
1241
+ /* Planetary longitudes, Mercury through Neptune (Souchay et al. 1999). */
1242
+ ALME = swe_radnorm(4.402608842 + 2608.7903141574 * T);
1243
+ ALVE = swe_radnorm(3.176146697 + 1021.3285546211 * T);
1244
+ ALEA = swe_radnorm(1.753470314 + 628.3075849991 * T);
1245
+ ALMA = swe_radnorm(6.203480913 + 334.0612426700 * T);
1246
+ ALJU = swe_radnorm(0.599546497 + 52.9690962641 * T);
1247
+ ALSA = swe_radnorm(0.874016757 + 21.3299104960 * T);
1248
+ ALUR = swe_radnorm(5.481293871 + 7.4781598567 * T);
1249
+ ALNE = swe_radnorm(5.321159000 + 3.8127774000 * T);
1250
+ /* planetary nutation series (in reverse order).*/
1251
+ dpsi = 0;
1252
+ deps = 0;
1253
+ for (i = NPL - 1; i >= 0; i--) {
1254
+ j = i * 14;
1255
+ darg = swe_radnorm((double) npl[j + 0] * AL +
1256
+ (double) npl[j + 1] * ALSU +
1257
+ (double) npl[j + 2] * AF +
1258
+ (double) npl[j + 3] * AD +
1259
+ (double) npl[j + 4] * AOM +
1260
+ (double) npl[j + 5] * ALME +
1261
+ (double) npl[j + 6] * ALVE +
1262
+ (double) npl[j + 7] * ALEA +
1263
+ (double) npl[j + 8] * ALMA +
1264
+ (double) npl[j + 9] * ALJU +
1265
+ (double) npl[j +10] * ALSA +
1266
+ (double) npl[j +11] * ALUR +
1267
+ (double) npl[j +12] * ALNE +
1268
+ (double) npl[j +13] * APA);
1269
+ k = i * 4;
1270
+ sinarg = sin(darg);
1271
+ cosarg = cos(darg);
1272
+ dpsi += (double) icpl[k+0] * sinarg + (double) icpl[k+1] * cosarg;
1273
+ deps += (double) icpl[k+2] * sinarg + (double) icpl[k+3] * cosarg;
1274
+ }
1275
+ nutlo[0] += dpsi * O1MAS2DEG;
1276
+ nutlo[1] += deps * O1MAS2DEG;
1277
+ #if 1
1278
+ /* changes required by adoption of P03 precession
1279
+ * according to Capitaine et al. A & A 412, 366 (2005) */
1280
+ dpsi = -8.1 * sin(OM) - 0.6 * sin(2 * F - 2 * D + 2 * OM);
1281
+ 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));
1282
+ deps = T * (-25.6 * cos(OM) - 1.6 * cos(2 * F - 2 * D + 2 * OM));
1283
+ nutlo[0] += dpsi / (3600.0 * 1000000.0);
1284
+ nutlo[1] += deps / (3600.0 * 1000000.0);
1285
+ #endif
1286
+ #endif
1287
+ nutlo[0] *= DEGTORAD;
1288
+ nutlo[1] *= DEGTORAD;
1289
+ return 0;
1290
+ }
1291
+ #endif
1292
+
1293
+ /* GCRS to J2000 */
1294
+ void swi_bias(double *x, int32 iflag, AS_BOOL backward)
1295
+ {
1296
+ #if 0
1297
+ double DAS2R = 1.0 / 3600.0 * DEGTORAD;
1298
+ double dpsi_bias = -0.041775 * DAS2R;
1299
+ double deps_bias = -0.0068192 * DAS2R;
1300
+ double dra0 = -0.0146 * DAS2R;
1301
+ double deps2000 = 84381.448 * DAS2R;
1302
+ #endif
1303
+ double xx[6], rb[3][3];
1304
+ int i;
1305
+ rb[0][0] = +0.9999999999999942;
1306
+ rb[0][1] = +0.0000000707827948;
1307
+ rb[0][2] = -0.0000000805621738;
1308
+ rb[1][0] = -0.0000000707827974;
1309
+ rb[1][1] = +0.9999999999999969;
1310
+ rb[1][2] = -0.0000000330604088;
1311
+ rb[2][0] = +0.0000000805621715;
1312
+ rb[2][1] = +0.0000000330604145;
1313
+ rb[2][2] = +0.9999999999999962;
1314
+ if (backward) {
1315
+ for (i = 0; i <= 2; i++) {
1316
+ xx[i] = x[0] * rb[i][0] +
1317
+ x[1] * rb[i][1] +
1318
+ x[2] * rb[i][2];
1319
+ if (iflag & SEFLG_SPEED)
1320
+ xx[i+3] = x[3] * rb[i][0] +
1321
+ x[4] * rb[i][1] +
1322
+ x[5] * rb[i][2];
1323
+ }
1324
+ } else {
1325
+ for (i = 0; i <= 2; i++) {
1326
+ xx[i] = x[0] * rb[0][i] +
1327
+ x[1] * rb[1][i] +
1328
+ x[2] * rb[2][i];
1329
+ if (iflag & SEFLG_SPEED)
1330
+ xx[i+3] = x[3] * rb[0][i] +
1331
+ x[4] * rb[1][i] +
1332
+ x[5] * rb[2][i];
1333
+ }
1334
+ }
1335
+ for (i = 0; i <= 2; i++) x[i] = xx[i];
1336
+ if (iflag & SEFLG_SPEED)
1337
+ for (i = 3; i <= 5; i++) x[i] = xx[i];
1338
+ }
1339
+
1340
+
1341
+ /* GCRS to FK5 */
1342
+ void swi_icrs2fk5(double *x, int32 iflag, AS_BOOL backward)
1343
+ {
1344
+ #if 0
1345
+ double DAS2R = 1.0 / 3600.0 * DEGTORAD;
1346
+ double dra0 = -0.0229 * DAS2R;
1347
+ double dxi0 = 0.0091 * DAS2R;
1348
+ double det0 = -0.0199 * DAS2R;
1349
+ #endif
1350
+ double xx[6], rb[3][3];
1351
+ int i;
1352
+ rb[0][0] = +0.9999999999999928;
1353
+ rb[0][1] = +0.0000001110223287;
1354
+ rb[0][2] = +0.0000000441180557;
1355
+ rb[1][0] = -0.0000001110223330;
1356
+ rb[1][1] = +0.9999999999999891;
1357
+ rb[1][2] = +0.0000000964779176;
1358
+ rb[2][0] = -0.0000000441180450;
1359
+ rb[2][1] = -0.0000000964779225;
1360
+ rb[2][2] = +0.9999999999999943;
1361
+ if (backward) {
1362
+ for (i = 0; i <= 2; i++) {
1363
+ xx[i] = x[0] * rb[i][0] +
1364
+ x[1] * rb[i][1] +
1365
+ x[2] * rb[i][2];
1366
+ if (iflag & SEFLG_SPEED)
1367
+ xx[i+3] = x[3] * rb[i][0] +
1368
+ x[4] * rb[i][1] +
1369
+ x[5] * rb[i][2];
1370
+ }
1371
+ } else {
1372
+ for (i = 0; i <= 2; i++) {
1373
+ xx[i] = x[0] * rb[0][i] +
1374
+ x[1] * rb[1][i] +
1375
+ x[2] * rb[2][i];
1376
+ if (iflag & SEFLG_SPEED)
1377
+ xx[i+3] = x[3] * rb[0][i] +
1378
+ x[4] * rb[1][i] +
1379
+ x[5] * rb[2][i];
1380
+ }
1381
+ }
1382
+ for (i = 0; i <= 5; i++) x[i] = xx[i];
1383
+ }
1384
+
1385
+ /* DeltaT = Ephemeris Time - Universal Time, in days.
1386
+ *
1387
+ * 1620 - today + a couple of years:
1388
+ * ---------------------------------
1389
+ * The tabulated values of deltaT, in hundredths of a second,
1390
+ * were taken from The Astronomical Almanac 1997, page K8. The program
1391
+ * adjusts for a value of secular tidal acceleration ndot = -25.7376.
1392
+ * arcsec per century squared, the value used in JPL's DE403 ephemeris.
1393
+ * ELP2000 (and DE200) used the value -23.8946.
1394
+ * To change ndot, one can
1395
+ * either redefine SE_TIDAL_DEFAULT in swephexp.h
1396
+ * or use the routine swe_set_tid_acc() before calling Swiss
1397
+ * Ephemeris.
1398
+ * Bessel's interpolation formula is implemented to obtain fourth
1399
+ * order interpolated values at intermediate times.
1400
+ *
1401
+ * -1000 - 1620:
1402
+ * ---------------------------------
1403
+ * For dates between -500 and 1600, the table given by Morrison &
1404
+ * Stephenson (2004; p. 332) is used, with linear interpolation.
1405
+ * This table is based on an assumed value of ndot = -26.
1406
+ * The program adjusts for ndot = -25.7376.
1407
+ * For 1600 - 1620, a linear interpolation between the last value
1408
+ * of the latter and the first value of the former table is made.
1409
+ *
1410
+ * before -1000:
1411
+ * ---------------------------------
1412
+ * For times before -1100, a formula of Morrison & Stephenson (2004)
1413
+ * (p. 332) is used:
1414
+ * dt = 32 * t * t - 20 sec, where t is centuries from 1820 AD.
1415
+ * For -1100 to -1000, a transition from this formula to the Stephenson
1416
+ * table has been implemented in order to avoid a jump.
1417
+ *
1418
+ * future:
1419
+ * ---------------------------------
1420
+ * For the time after the last tabulated value, we use the formula
1421
+ * of Stephenson (1997; p. 507), with a modification that avoids a jump
1422
+ * at the end of the tabulated period. A linear term is added that
1423
+ * makes a slow transition from the table to the formula over a period
1424
+ * of 100 years. (Need not be updated, when table will be enlarged.)
1425
+ *
1426
+ * References:
1427
+ *
1428
+ * Stephenson, F. R., and L. V. Morrison, "Long-term changes
1429
+ * in the rotation of the Earth: 700 B.C. to A.D. 1980,"
1430
+ * Philosophical Transactions of the Royal Society of London
1431
+ * Series A 313, 47-70 (1984)
1432
+ *
1433
+ * Borkowski, K. M., "ELP2000-85 and the Dynamical Time
1434
+ * - Universal Time relation," Astronomy and Astrophysics
1435
+ * 205, L8-L10 (1988)
1436
+ * Borkowski's formula is derived from partly doubtful eclipses
1437
+ * going back to 2137 BC and uses lunar position based on tidal
1438
+ * coefficient of -23.9 arcsec/cy^2.
1439
+ *
1440
+ * Chapront-Touze, Michelle, and Jean Chapront, _Lunar Tables
1441
+ * and Programs from 4000 B.C. to A.D. 8000_, Willmann-Bell 1991
1442
+ * Their table agrees with the one here, but the entries are
1443
+ * rounded to the nearest whole second.
1444
+ *
1445
+ * Stephenson, F. R., and M. A. Houlden, _Atlas of Historical
1446
+ * Eclipse Maps_, Cambridge U. Press (1986)
1447
+ *
1448
+ * Stephenson, F.R. & Morrison, L.V., "Long-Term Fluctuations in
1449
+ * the Earth's Rotation: 700 BC to AD 1990", Philosophical
1450
+ * Transactions of the Royal Society of London,
1451
+ * Ser. A, 351 (1995), 165-202.
1452
+ *
1453
+ * Stephenson, F. Richard, _Historical Eclipses and Earth's
1454
+ * Rotation_, Cambridge U. Press (1997)
1455
+ *
1456
+ * Morrison, L. V., and F.R. Stephenson, "Historical Values of the Earth's
1457
+ * Clock Error DT and the Calculation of Eclipses", JHA xxxv (2004),
1458
+ * pp.327-336
1459
+ *
1460
+ * Table from AA for 1620 through today
1461
+ * Note, Stephenson and Morrison's table starts at the year 1630.
1462
+ * The Chapronts' table does not agree with the Almanac prior to 1630.
1463
+ * The actual accuracy decreases rapidly prior to 1780.
1464
+ *
1465
+ * Jean Meeus, Astronomical Algorithms, 2nd edition, 1998.
1466
+ *
1467
+ * For a comprehensive collection of publications and formulae, see:
1468
+ * http://www.phys.uu.nl/~vgent/deltat/deltat_modern.htm
1469
+ * http://www.phys.uu.nl/~vgent/deltat/deltat_old.htm
1470
+ *
1471
+ * For future values of delta t, the following data from the
1472
+ * Earth Orientation Department of the US Naval Observatory can be used:
1473
+ * (TAI-UTC) from: ftp://maia.usno.navy.mil/ser7/tai-utc.dat
1474
+ * (UT1-UTC) from: ftp://maia.usno.navy.mil/ser7/finals.all
1475
+ * file description in: ftp://maia.usno.navy.mil/ser7/readme.finals
1476
+ * Delta T = TAI-UT1 + 32.184 sec = (TAI-UTC) - (UT1-UTC) + 32.184 sec
1477
+ *
1478
+ * Also, there is the following file:
1479
+ * http://maia.usno.navy.mil/ser7/deltat.data, but it is about 3 months
1480
+ * behind (on 3 feb 2009)
1481
+ *
1482
+ * Last update of table dt[]: Dieter Koch, 27 april 2010.
1483
+ * ATTENTION: Whenever updating this table, do not forget to adjust
1484
+ * the macros TABEND and TABSIZ !
1485
+ */
1486
+ #define TABSTART 1620
1487
+ #define TABEND 2017
1488
+ #define TABSIZ (TABEND-TABSTART+1)
1489
+ /* we make the table greater for additional values read from external file */
1490
+ #define TABSIZ_SPACE (TABSIZ+100)
1491
+ static double FAR dt[TABSIZ_SPACE] = {
1492
+ /* 1620.0 thru 1659.0 */
1493
+ 124.00, 119.00, 115.00, 110.00, 106.00, 102.00, 98.00, 95.00, 91.00, 88.00,
1494
+ 85.00, 82.00, 79.00, 77.00, 74.00, 72.00, 70.00, 67.00, 65.00, 63.00,
1495
+ 62.00, 60.00, 58.00, 57.00, 55.00, 54.00, 53.00, 51.00, 50.00, 49.00,
1496
+ 48.00, 47.00, 46.00, 45.00, 44.00, 43.00, 42.00, 41.00, 40.00, 38.00,
1497
+ /* 1660.0 thru 1699.0 */
1498
+ 37.00, 36.00, 35.00, 34.00, 33.00, 32.00, 31.00, 30.00, 28.00, 27.00,
1499
+ 26.00, 25.00, 24.00, 23.00, 22.00, 21.00, 20.00, 19.00, 18.00, 17.00,
1500
+ 16.00, 15.00, 14.00, 14.00, 13.00, 12.00, 12.00, 11.00, 11.00, 10.00,
1501
+ 10.00, 10.00, 9.00, 9.00, 9.00, 9.00, 9.00, 9.00, 9.00, 9.00,
1502
+ /* 1700.0 thru 1739.0 */
1503
+ 9.00, 9.00, 9.00, 9.00, 9.00, 9.00, 9.00, 9.00, 10.00, 10.00,
1504
+ 10.00, 10.00, 10.00, 10.00, 10.00, 10.00, 10.00, 11.00, 11.00, 11.00,
1505
+ 11.00, 11.00, 11.00, 11.00, 11.00, 11.00, 11.00, 11.00, 11.00, 11.00,
1506
+ 11.00, 11.00, 11.00, 11.00, 12.00, 12.00, 12.00, 12.00, 12.00, 12.00,
1507
+ /* 1740.0 thru 1779.0 */
1508
+ 12.00, 12.00, 12.00, 12.00, 13.00, 13.00, 13.00, 13.00, 13.00, 13.00,
1509
+ 13.00, 14.00, 14.00, 14.00, 14.00, 14.00, 14.00, 14.00, 15.00, 15.00,
1510
+ 15.00, 15.00, 15.00, 15.00, 15.00, 16.00, 16.00, 16.00, 16.00, 16.00,
1511
+ 16.00, 16.00, 16.00, 16.00, 16.00, 17.00, 17.00, 17.00, 17.00, 17.00,
1512
+ /* 1780.0 thru 1799.0 */
1513
+ 17.00, 17.00, 17.00, 17.00, 17.00, 17.00, 17.00, 17.00, 17.00, 17.00,
1514
+ 17.00, 17.00, 16.00, 16.00, 16.00, 16.00, 15.00, 15.00, 14.00, 14.00,
1515
+ /* 1800.0 thru 1819.0 */
1516
+ 13.70, 13.40, 13.10, 12.90, 12.70, 12.60, 12.50, 12.50, 12.50, 12.50,
1517
+ 12.50, 12.50, 12.50, 12.50, 12.50, 12.50, 12.50, 12.40, 12.30, 12.20,
1518
+ /* 1820.0 thru 1859.0 */
1519
+ 12.00, 11.70, 11.40, 11.10, 10.60, 10.20, 9.60, 9.10, 8.60, 8.00,
1520
+ 7.50, 7.00, 6.60, 6.30, 6.00, 5.80, 5.70, 5.60, 5.60, 5.60,
1521
+ 5.70, 5.80, 5.90, 6.10, 6.20, 6.30, 6.50, 6.60, 6.80, 6.90,
1522
+ 7.10, 7.20, 7.30, 7.40, 7.50, 7.60, 7.70, 7.70, 7.80, 7.80,
1523
+ /* 1860.0 thru 1899.0 */
1524
+ 7.88, 7.82, 7.54, 6.97, 6.40, 6.02, 5.41, 4.10, 2.92, 1.82,
1525
+ 1.61, .10, -1.02, -1.28, -2.69, -3.24, -3.64, -4.54, -4.71, -5.11,
1526
+ -5.40, -5.42, -5.20, -5.46, -5.46, -5.79, -5.63, -5.64, -5.80, -5.66,
1527
+ -5.87, -6.01, -6.19, -6.64, -6.44, -6.47, -6.09, -5.76, -4.66, -3.74,
1528
+ /* 1900.0 thru 1939.0 */
1529
+ -2.72, -1.54, -.02, 1.24, 2.64, 3.86, 5.37, 6.14, 7.75, 9.13,
1530
+ 10.46, 11.53, 13.36, 14.65, 16.01, 17.20, 18.24, 19.06, 20.25, 20.95,
1531
+ 21.16, 22.25, 22.41, 23.03, 23.49, 23.62, 23.86, 24.49, 24.34, 24.08,
1532
+ 24.02, 24.00, 23.87, 23.95, 23.86, 23.93, 23.73, 23.92, 23.96, 24.02,
1533
+ /* 1940.0 thru 1979.0 */
1534
+ 24.33, 24.83, 25.30, 25.70, 26.24, 26.77, 27.28, 27.78, 28.25, 28.71,
1535
+ 29.15, 29.57, 29.97, 30.36, 30.72, 31.07, 31.35, 31.68, 32.18, 32.68,
1536
+ 33.15, 33.59, 34.00, 34.47, 35.03, 35.73, 36.54, 37.43, 38.29, 39.20,
1537
+ 40.18, 41.17, 42.23, 43.37, 44.49, 45.48, 46.46, 47.52, 48.53, 49.59,
1538
+ /* 1980.0 thru 1999.0 */
1539
+ 50.54, 51.38, 52.17, 52.96, 53.79, 54.34, 54.87, 55.32, 55.82, 56.30,
1540
+ 56.86, 57.57, 58.31, 59.12, 59.98, 60.78, 61.63, 62.30, 62.97, 63.47,
1541
+ /* 2000.0 thru 2009.0 */
1542
+ 63.83, 64.09, 64.30, 64.47, 64.57, 64.69, 64.85, 65.15, 65.46, 65.78,
1543
+ /* 2010.0 thru 2019.0 */
1544
+ 66.07, 66.32,
1545
+ /* Extrapolated values, 2011 - 2014 */
1546
+ 67.00, 67.50, 68.00, 68.50, 69.00, 69.50,
1547
+ };
1548
+ #define ESPENAK_MEEUS_2006 TRUE
1549
+ #define TAB2_SIZ 27
1550
+ #define TAB2_START (-1000)
1551
+ #define TAB2_END 1600
1552
+ #define TAB2_STEP 100
1553
+ #define LTERM_EQUATION_YSTART 1820
1554
+ #define LTERM_EQUATION_COEFF 32
1555
+ /* Table for -1000 through 1600, from Morrison & Stephenson (2004). */
1556
+ static short FAR dt2[TAB2_SIZ] = {
1557
+ /*-1000 -900 -800 -700 -600 -500 -400 -300 -200 -100*/
1558
+ 25400,23700,22000,21000,19040,17190,15530,14080,12790,11640,
1559
+ /* 0 100 200 300 400 500 600 700 800 900*/
1560
+ 10580, 9600, 8640, 7680, 6700, 5710, 4740, 3810, 2960, 2200,
1561
+ /* 1000 1100 1200 1300 1400 1500 1600, */
1562
+ 1570, 1090, 740, 490, 320, 200, 120,
1563
+ };
1564
+ /* returns DeltaT (ET - UT) in days
1565
+ * double tjd = julian day in UT
1566
+ */
1567
+ #define DEMO 0
1568
+ double FAR PASCAL_CONV swe_deltat(double tjd)
1569
+ {
1570
+ double ans = 0;
1571
+ double B, Y, Ygreg, dd;
1572
+ int iy;
1573
+ /* read additional values from swedelta.txt */
1574
+ AS_BOOL use_espenak_meeus = ESPENAK_MEEUS_2006;
1575
+ Y = 2000.0 + (tjd - J2000)/365.25;
1576
+ Ygreg = 2000.0 + (tjd - J2000)/365.2425;
1577
+ /* Before 1633 AD, if the macro ESPENAK_MEEUS_2006 is TRUE:
1578
+ * Polynomials by Espenak & Meeus 2006, derived from Stephenson & Morrison
1579
+ * 2004.
1580
+ * Note, Espenak & Meeus use their formulae only from 2000 BC on.
1581
+ * However, they use the long-term formula of Morrison & Stephenson,
1582
+ * which can be used even for the remoter past.
1583
+ */
1584
+ if (use_espenak_meeus && tjd < 2317746.13090277789) {
1585
+ return deltat_espenak_meeus_1620(tjd);
1586
+ }
1587
+ /* If the macro ESPENAK_MEEUS_2006 is FALSE:
1588
+ * Before 1620, we follow Stephenson & Morrsion 2004. For the tabulated
1589
+ * values 1000 BC through 1600 AD, we use linear interpolation.
1590
+ */
1591
+ if (Y < TABSTART) {
1592
+ if (Y < TAB2_END) {
1593
+ return deltat_stephenson_morrison_1600(tjd);
1594
+ } else {
1595
+ /* between 1600 and 1620:
1596
+ * linear interpolation between
1597
+ * end of table dt2 and start of table dt */
1598
+ if (Y >= TAB2_END) {
1599
+ B = TABSTART - TAB2_END;
1600
+ iy = (TAB2_END - TAB2_START) / TAB2_STEP;
1601
+ dd = (Y - TAB2_END) / B;
1602
+ /*ans = dt2[iy] + dd * (dt[0] / 100.0 - dt2[iy]);*/
1603
+ ans = dt2[iy] + dd * (dt[0] - dt2[iy]);
1604
+ ans = adjust_for_tidacc(ans, Ygreg);
1605
+ return ans / 86400.0;
1606
+ }
1607
+ }
1608
+ }
1609
+ /* 1620 - today + a few years (tabend):
1610
+ * Besselian interpolation from tabulated values in table dt.
1611
+ * See AA page K11.
1612
+ */
1613
+ if (Y >= TABSTART) {
1614
+ return deltat_aa(tjd);
1615
+ }
1616
+ #ifdef TRACE
1617
+ swi_open_trace(NULL);
1618
+ if (swi_trace_count < TRACE_COUNT_MAX) {
1619
+ if (swi_fp_trace_c != NULL) {
1620
+ fputs("\n/*SWE_DELTAT*/\n", swi_fp_trace_c);
1621
+ fprintf(swi_fp_trace_c, " tjd = %.9f;", tjd);
1622
+ fprintf(swi_fp_trace_c, " t = swe_deltat(tjd);\n");
1623
+ fputs(" printf(\"swe_deltat: %f\\t%f\\t\\n\", ", swi_fp_trace_c);
1624
+ fputs("tjd, t);\n", swi_fp_trace_c);
1625
+ fflush(swi_fp_trace_c);
1626
+ }
1627
+ if (swi_fp_trace_out != NULL) {
1628
+ fprintf(swi_fp_trace_out, "swe_deltat: %f\t%f\t\n", tjd, ans);
1629
+ fflush(swi_fp_trace_out);
1630
+ }
1631
+ }
1632
+ #endif
1633
+ return ans / 86400.0;
1634
+ }
1635
+
1636
+ static double deltat_aa(double tjd)
1637
+ {
1638
+ double ans = 0, ans2, ans3;
1639
+ double p, B, B2, Y, dd;
1640
+ double d[6];
1641
+ int i, iy, k;
1642
+ /* read additional values from swedelta.txt */
1643
+ int tabsiz = init_dt();
1644
+ int tabend = TABSTART + tabsiz - 1;
1645
+ /*Y = 2000.0 + (tjd - J2000)/365.25;*/
1646
+ Y = 2000.0 + (tjd - J2000)/365.2425;
1647
+ if (Y <= tabend) {
1648
+ /* Index into the table.
1649
+ */
1650
+ p = floor(Y);
1651
+ iy = (int) (p - TABSTART);
1652
+ /* Zeroth order estimate is value at start of year
1653
+ */
1654
+ ans = dt[iy];
1655
+ k = iy + 1;
1656
+ if( k >= tabsiz )
1657
+ goto done; /* No data, can't go on. */
1658
+ /* The fraction of tabulation interval
1659
+ */
1660
+ p = Y - p;
1661
+ /* First order interpolated value
1662
+ */
1663
+ ans += p*(dt[k] - dt[iy]);
1664
+ if( (iy-1 < 0) || (iy+2 >= tabsiz) )
1665
+ goto done; /* can't do second differences */
1666
+ /* Make table of first differences
1667
+ */
1668
+ k = iy - 2;
1669
+ for( i=0; i<5; i++ ) {
1670
+ if( (k < 0) || (k+1 >= tabsiz) )
1671
+ d[i] = 0;
1672
+ else
1673
+ d[i] = dt[k+1] - dt[k];
1674
+ k += 1;
1675
+ }
1676
+ /* Compute second differences
1677
+ */
1678
+ for( i=0; i<4; i++ )
1679
+ d[i] = d[i+1] - d[i];
1680
+ B = 0.25*p*(p-1.0);
1681
+ ans += B*(d[1] + d[2]);
1682
+ #if DEMO
1683
+ printf( "B %.4lf, ans %.4lf\n", B, ans );
1684
+ #endif
1685
+ if( iy+2 >= tabsiz )
1686
+ goto done;
1687
+ /* Compute third differences
1688
+ */
1689
+ for( i=0; i<3; i++ )
1690
+ d[i] = d[i+1] - d[i];
1691
+ B = 2.0*B/3.0;
1692
+ ans += (p-0.5)*B*d[1];
1693
+ #if DEMO
1694
+ printf( "B %.4lf, ans %.4lf\n", B*(p-0.5), ans );
1695
+ #endif
1696
+ if( (iy-2 < 0) || (iy+3 > tabsiz) )
1697
+ goto done;
1698
+ /* Compute fourth differences
1699
+ */
1700
+ for( i=0; i<2; i++ )
1701
+ d[i] = d[i+1] - d[i];
1702
+ B = 0.125*B*(p+1.0)*(p-2.0);
1703
+ ans += B*(d[0] + d[1]);
1704
+ #if DEMO
1705
+ printf( "B %.4lf, ans %.4lf\n", B, ans );
1706
+ #endif
1707
+ done:
1708
+ ans = adjust_for_tidacc(ans, Y);
1709
+ return ans / 86400.0;
1710
+ }
1711
+ /* today - :
1712
+ * Formula Stephenson (1997; p. 507),
1713
+ * with modification to avoid jump at end of AA table,
1714
+ * similar to what Meeus 1998 had suggested.
1715
+ * Slow transition within 100 years.
1716
+ */
1717
+ B = 0.01 * (Y - 1820);
1718
+ ans = -20 + 31 * B * B;
1719
+ /* slow transition from tabulated values to Stephenson formula: */
1720
+ if (Y <= tabend+100) {
1721
+ B2 = 0.01 * (tabend - 1820);
1722
+ ans2 = -20 + 31 * B2 * B2;
1723
+ ans3 = dt[tabsiz-1];
1724
+ dd = (ans2 - ans3);
1725
+ ans += dd * (Y - (tabend + 100)) * 0.01;
1726
+ }
1727
+ return ans / 86400.0;
1728
+ }
1729
+
1730
+ static double deltat_longterm_morrison_stephenson(double tjd)
1731
+ {
1732
+ double Ygreg = 2000.0 + (tjd - J2000)/365.2425;
1733
+ double u = (Ygreg - 1820) / 100.0;
1734
+ return (-20 + 32 * u * u);
1735
+ }
1736
+
1737
+ static double deltat_stephenson_morrison_1600(double tjd)
1738
+ {
1739
+ double ans = 0, ans2, ans3;
1740
+ double p, B, dd;
1741
+ double tjd0;
1742
+ int iy;
1743
+ /* read additional values from swedelta.txt */
1744
+ double Y = 2000.0 + (tjd - J2000)/365.2425;
1745
+ /* double Y = 2000.0 + (tjd - J2000)/365.25;*/
1746
+ /* before -1000:
1747
+ * formula by Stephenson&Morrison (2004; p. 335) but adjusted to fit the
1748
+ * starting point of table dt2. */
1749
+ if( Y < TAB2_START ) {
1750
+ /*B = (Y - LTERM_EQUATION_YSTART) * 0.01;
1751
+ ans = -20 + LTERM_EQUATION_COEFF * B * B;*/
1752
+ ans = deltat_longterm_morrison_stephenson(tjd);
1753
+ ans = adjust_for_tidacc(ans, Y);
1754
+ /* transition from formula to table over 100 years */
1755
+ if (Y >= TAB2_START - 100) {
1756
+ /* starting value of table dt2: */
1757
+ ans2 = adjust_for_tidacc(dt2[0], TAB2_START);
1758
+ /* value of formula at epoch TAB2_START */
1759
+ /* B = (TAB2_START - LTERM_EQUATION_YSTART) * 0.01;
1760
+ ans3 = -20 + LTERM_EQUATION_COEFF * B * B;*/
1761
+ tjd0 = (TAB2_START - 2000) * 365.2425 + J2000;
1762
+ ans3 = deltat_longterm_morrison_stephenson(tjd0);
1763
+ ans3 = adjust_for_tidacc(ans3, Y);
1764
+ dd = ans3 - ans2;
1765
+ B = (Y - (TAB2_START - 100)) * 0.01;
1766
+ /* fit to starting point of table dt2. */
1767
+ ans = ans - dd * B;
1768
+ }
1769
+ }
1770
+ /* between -1000 and 1600:
1771
+ * linear interpolation between values of table dt2 (Stephenson&Morrison 2004) */
1772
+ if (Y >= TAB2_START && Y < TAB2_END) {
1773
+ double Yjul = 2000 + (tjd - 2451557.5) / 365.25;
1774
+ p = floor(Yjul);
1775
+ iy = (int) ((p - TAB2_START) / TAB2_STEP);
1776
+ dd = (Yjul - (TAB2_START + TAB2_STEP * iy)) / TAB2_STEP;
1777
+ ans = dt2[iy] + (dt2[iy+1] - dt2[iy]) * dd;
1778
+ /* correction for tidal acceleration used by our ephemeris */
1779
+ ans = adjust_for_tidacc(ans, Y);
1780
+ }
1781
+ ans /= 86400.0;
1782
+ return ans;
1783
+ }
1784
+
1785
+ static double deltat_espenak_meeus_1620(double tjd)
1786
+ {
1787
+ double ans = 0;
1788
+ double Ygreg;
1789
+ double u;
1790
+ /* double Y = 2000.0 + (tjd - J2000)/365.25;*/
1791
+ Ygreg = 2000.0 + (tjd - J2000)/365.2425;
1792
+ if (Ygreg < -500) {
1793
+ ans = deltat_longterm_morrison_stephenson(tjd);
1794
+ } else if (Ygreg < 500) {
1795
+ u = Ygreg / 100.0;
1796
+ ans = (((((0.0090316521 * u + 0.022174192) * u - 0.1798452) * u - 5.952053) * u+ 33.78311) * u - 1014.41) * u + 10583.6;
1797
+ } else if (Ygreg < 1600) {
1798
+ u = (Ygreg - 1000) / 100.0;
1799
+ ans = (((((0.0083572073 * u - 0.005050998) * u - 0.8503463) * u + 0.319781) * u + 71.23472) * u - 556.01) * u + 1574.2;
1800
+ } else if (Ygreg < 1700) {
1801
+ u = Ygreg - 1600;
1802
+ ans = 120 - 0.9808 * u - 0.01532 * u * u + u * u * u / 7129.0;
1803
+ } else if (Ygreg < 1800) {
1804
+ u = Ygreg - 1700;
1805
+ ans = (((-u / 1174000.0 + 0.00013336) * u - 0.0059285) * u + 0.1603) * u + 8.83;
1806
+ } else if (Ygreg < 1860) {
1807
+ u = Ygreg - 1800;
1808
+ ans = ((((((0.000000000875 * u - 0.0000001699) * u + 0.0000121272) * u - 0.00037436) * u + 0.0041116) * u + 0.0068612) * u - 0.332447) * u + 13.72;
1809
+ } else if (Ygreg < 1900) {
1810
+ u = Ygreg - 1860;
1811
+ ans = ((((u / 233174.0 - 0.0004473624) * u + 0.01680668) * u - 0.251754) * u + 0.5737) * u + 7.62;
1812
+ } else if (Ygreg < 1920) {
1813
+ u = Ygreg - 1900;
1814
+ ans = (((-0.000197 * u + 0.0061966) * u - 0.0598939) * u + 1.494119) * u -2.79;
1815
+ } else if (Ygreg < 1941) {
1816
+ u = Ygreg - 1920;
1817
+ ans = 21.20 + 0.84493 * u - 0.076100 * u * u + 0.0020936 * u * u * u;
1818
+ } else if (Ygreg < 1961) {
1819
+ u = Ygreg - 1950;
1820
+ ans = 29.07 + 0.407 * u - u * u / 233.0 + u * u * u / 2547.0;
1821
+ } else if (Ygreg < 1986) {
1822
+ u = Ygreg - 1975;
1823
+ ans = 45.45 + 1.067 * u - u * u / 260.0 - u * u * u / 718.0;
1824
+ } else if (Ygreg < 2005) {
1825
+ u = Ygreg - 2000;
1826
+ ans = ((((0.00002373599 * u + 0.000651814) * u + 0.0017275) * u - 0.060374) * u + 0.3345) * u + 63.86;
1827
+ }
1828
+ ans = adjust_for_tidacc(ans, Ygreg);
1829
+ ans /= 86400.0;
1830
+ return ans;
1831
+ }
1832
+
1833
+ /* Read delta t values from external file.
1834
+ * record structure: year(whitespace)delta_t in 0.01 sec.
1835
+ */
1836
+ static int init_dt(void)
1837
+ {
1838
+ FILE *fp;
1839
+ int year;
1840
+ int tab_index;
1841
+ int tabsiz;
1842
+ int i;
1843
+ char s[AS_MAXCH];
1844
+ char *sp;
1845
+ if (!init_dt_done) {
1846
+ init_dt_done = TRUE;
1847
+ /* no error message if file is missing */
1848
+ if ((fp = swi_fopen(-1, "swe_deltat.txt", swed.ephepath, NULL)) == NULL
1849
+ && (fp = swi_fopen(-1, "sedeltat.txt", swed.ephepath, NULL)) == NULL)
1850
+ return TABSIZ;
1851
+ while(fgets(s, AS_MAXCH, fp) != NULL) {
1852
+ sp = s;
1853
+ while (strchr(" \t", *sp) != NULL && *sp != '\0')
1854
+ sp++; /* was *sp++ fixed by Alois 2-jul-2003 */
1855
+ if (*sp == '#' || *sp == '\n')
1856
+ continue;
1857
+ year = atoi(s);
1858
+ tab_index = year - TABSTART;
1859
+ /* table space is limited. no error msg, if exceeded */
1860
+ if (tab_index >= TABSIZ_SPACE)
1861
+ continue;
1862
+ sp += 4;
1863
+ while (strchr(" \t", *sp) != NULL && *sp != '\0')
1864
+ sp++; /* was *sp++ fixed by Alois 2-jul-2003 */
1865
+ /*dt[tab_index] = (short) (atof(sp) * 100 + 0.5);*/
1866
+ dt[tab_index] = atof(sp);
1867
+ }
1868
+ fclose(fp);
1869
+ }
1870
+ /* find table size */
1871
+ tabsiz = 2001 - TABSTART + 1;
1872
+ for (i = tabsiz - 1; i < TABSIZ_SPACE; i++) {
1873
+ if (dt[i] == 0)
1874
+ break;
1875
+ else
1876
+ tabsiz++;
1877
+ }
1878
+ tabsiz--;
1879
+ return tabsiz;
1880
+ }
1881
+
1882
+ /* Astronomical Almanac table is corrected by adding the expression
1883
+ * -0.000091 (ndot + 26)(year-1955)^2 seconds
1884
+ * to entries prior to 1955 (AA page K8), where ndot is the secular
1885
+ * tidal term in the mean motion of the Moon.
1886
+ *
1887
+ * Entries after 1955 are referred to atomic time standards and
1888
+ * are not affected by errors in Lunar or planetary theory.
1889
+ */
1890
+ static double adjust_for_tidacc(double ans, double Y)
1891
+ {
1892
+ double B;
1893
+ if( Y < 1955.0 ) {
1894
+ B = (Y - 1955.0);
1895
+ ans += -0.000091 * (tid_acc + 26.0) * B * B;
1896
+ }
1897
+ return ans;
1898
+ }
1899
+
1900
+ /* returns tidal acceleration used in swe_deltat() */
1901
+ double FAR PASCAL_CONV swe_get_tid_acc()
1902
+ {
1903
+ #if 0
1904
+ if (tid_acc == TID_ACC_DE403)
1905
+ return 403;
1906
+ if (tid_acc == TID_ACC_DE402)
1907
+ return 200;
1908
+ #endif
1909
+ return tid_acc;
1910
+ }
1911
+
1912
+ void FAR PASCAL_CONV swe_set_tid_acc(double t_acc)
1913
+ {
1914
+ tid_acc = t_acc;
1915
+ #if TRACE
1916
+ swi_open_trace(NULL);
1917
+ if (swi_trace_count < TRACE_COUNT_MAX) {
1918
+ if (swi_fp_trace_c != NULL) {
1919
+ fputs("\n/*SWE_SET_TID_ACC*/\n", swi_fp_trace_c);
1920
+ fprintf(swi_fp_trace_c, " t = %.9f;\n", t_acc);
1921
+ fprintf(swi_fp_trace_c, " swe_set_tid_acc(t);\n");
1922
+ fputs(" printf(\"swe_set_tid_acc: %f\\t\\n\", ", swi_fp_trace_c);
1923
+ fputs("t);\n", swi_fp_trace_c);
1924
+ fflush(swi_fp_trace_c);
1925
+ }
1926
+ if (swi_fp_trace_out != NULL) {
1927
+ fprintf(swi_fp_trace_out, "swe_set_tid_acc: %f\t\n", t_acc);
1928
+ fflush(swi_fp_trace_out);
1929
+ }
1930
+ }
1931
+ #endif
1932
+ }
1933
+
1934
+ /* Apparent Sidereal Time at Greenwich with equation of the equinoxes
1935
+ * AA page B6
1936
+ *
1937
+ * returns sidereal time in hours.
1938
+ *
1939
+ * Caution. At epoch J2000.0, the 16 decimal precision
1940
+ * of IEEE double precision numbers
1941
+ * limits time resolution measured by Julian date
1942
+ * to approximately 24 microseconds.
1943
+ *
1944
+ * program returns sidereal hours since sidereal midnight
1945
+ * tjd julian day UT
1946
+ * eps obliquity of ecliptic, degrees
1947
+ * nut nutation, degrees
1948
+ */
1949
+ double FAR PASCAL_CONV swe_sidtime0( double tjd, double eps, double nut )
1950
+ {
1951
+ double jd0; /* Julian day at midnight Universal Time */
1952
+ double secs; /* Time of day, UT seconds since UT midnight */
1953
+ double eqeq, jd, tu, tt, msday;
1954
+ double gmst;
1955
+ /* Julian day at given UT */
1956
+ jd = tjd;
1957
+ jd0 = floor(jd);
1958
+ secs = tjd - jd0;
1959
+ if( secs < 0.5 ) {
1960
+ jd0 -= 0.5;
1961
+ secs += 0.5;
1962
+ } else {
1963
+ jd0 += 0.5;
1964
+ secs -= 0.5;
1965
+ }
1966
+ secs *= 86400.0;
1967
+ tu = (jd0 - J2000)/36525.0; /* UT1 in centuries after J2000 */
1968
+ if (PREC_IAU_2003) {
1969
+ tt = (jd0 + swe_deltat(jd0) - J2000)/36525.0; /* TT in centuries after J2000 */
1970
+ gmst = (((-0.000000002454*tt - 0.00000199708)*tt - 0.0000002926)*tt + 0.092772110)*tt*tt + 307.4771013*(tt-tu) + 8640184.79447825*tu + 24110.5493771;
1971
+ /* mean solar days per sidereal day at date tu;
1972
+ * for the derivative of gmst, we can assume UT1 =~ TT */
1973
+ msday = 1 + ((((-0.000000012270*tt - 0.00000798832)*tt - 0.0000008778)*tt + 0.185544220)*tt + 8640184.79447825)/(86400.*36525.);
1974
+ } else {
1975
+ /* Greenwich Mean Sidereal Time at 0h UT of date */
1976
+ gmst = (( -6.2e-6*tu + 9.3104e-2)*tu + 8640184.812866)*tu + 24110.54841;
1977
+ /* mean solar days per sidereal day at date tu, = 1.00273790934 in 1986 */
1978
+ msday = 1.0 + ((-1.86e-5*tu + 0.186208)*tu + 8640184.812866)/(86400.*36525.);
1979
+ }
1980
+ /* Local apparent sidereal time at given UT at Greenwich */
1981
+ eqeq = 240.0 * nut * cos(eps * DEGTORAD);
1982
+ gmst = gmst + msday*secs + eqeq /* + 240.0*tlong */;
1983
+ /* Sidereal seconds modulo 1 sidereal day */
1984
+ gmst = gmst - 86400.0 * floor( gmst/86400.0 );
1985
+ /* return in hours */
1986
+ gmst /= 3600;
1987
+ #ifdef TRACE
1988
+ swi_open_trace(NULL);
1989
+ if (swi_trace_count < TRACE_COUNT_MAX) {
1990
+ if (swi_fp_trace_c != NULL) {
1991
+ fputs("\n/*SWE_SIDTIME0*/\n", swi_fp_trace_c);
1992
+ fprintf(swi_fp_trace_c, " tjd = %.9f;", tjd);
1993
+ fprintf(swi_fp_trace_c, " eps = %.9f;", eps);
1994
+ fprintf(swi_fp_trace_c, " nut = %.9f;\n", nut);
1995
+ fprintf(swi_fp_trace_c, " t = swe_sidtime0(tjd, eps, nut);\n");
1996
+ fputs(" printf(\"swe_sidtime0: %f\\tsidt = %f\\teps = %f\\tnut = %f\\t\\n\", ", swi_fp_trace_c);
1997
+ fputs("tjd, t, eps, nut);\n", swi_fp_trace_c);
1998
+ fflush(swi_fp_trace_c);
1999
+ }
2000
+ if (swi_fp_trace_out != NULL) {
2001
+ fprintf(swi_fp_trace_out, "swe_sidtime0: %f\tsidt = %f\teps = %f\tnut = %f\t\n", tjd, gmst, eps, nut);
2002
+ fflush(swi_fp_trace_out);
2003
+ }
2004
+ }
2005
+ #endif
2006
+ return gmst;
2007
+ }
2008
+
2009
+ /* sidereal time, without eps and nut as parameters.
2010
+ * tjd must be UT !!!
2011
+ * for more informsation, see comment with swe_sidtime0()
2012
+ */
2013
+ double FAR PASCAL_CONV swe_sidtime(double tjd_ut)
2014
+ {
2015
+ int i;
2016
+ double eps, nutlo[2], tsid;
2017
+ double tjde = tjd_ut + swe_deltat(tjd_ut);
2018
+ eps = swi_epsiln(tjde) * RADTODEG;
2019
+ swi_nutation(tjde, nutlo);
2020
+ for (i = 0; i < 2; i++)
2021
+ nutlo[i] *= RADTODEG;
2022
+ tsid = swe_sidtime0(tjd_ut, eps + nutlo[1], nutlo[0]);
2023
+ #ifdef TRACE
2024
+ swi_open_trace(NULL);
2025
+ if (swi_trace_count < TRACE_COUNT_MAX) {
2026
+ if (swi_fp_trace_c != NULL) {
2027
+ fputs("\n/*SWE_SIDTIME*/\n", swi_fp_trace_c);
2028
+ fprintf(swi_fp_trace_c, " tjd = %.9f;\n", tjd_ut);
2029
+ fprintf(swi_fp_trace_c, " t = swe_sidtime(tjd);\n");
2030
+ fputs(" printf(\"swe_sidtime: %f\\t%f\\t\\n\", ", swi_fp_trace_c);
2031
+ fputs("tjd, t);\n", swi_fp_trace_c);
2032
+ fflush(swi_fp_trace_c);
2033
+ }
2034
+ if (swi_fp_trace_out != NULL) {
2035
+ fprintf(swi_fp_trace_out, "swe_sidtime: %f\t%f\t\n", tjd_ut, tsid);
2036
+ fflush(swi_fp_trace_out);
2037
+ }
2038
+ }
2039
+ #endif
2040
+ return tsid;
2041
+ }
2042
+
2043
+ /* SWISSEPH
2044
+ * generates name of ephemeris file
2045
+ * file name looks as follows:
2046
+ * swephpl.m30, where
2047
+ *
2048
+ * "sweph" "swiss ephemeris"
2049
+ * "pl","mo","as" planet, moon, or asteroid
2050
+ * "m" or "_" BC or AD
2051
+ *
2052
+ * "30" start century
2053
+ * tjd = ephemeris file for which julian day
2054
+ * ipli = number of planet
2055
+ * fname = ephemeris file name
2056
+ */
2057
+ void swi_gen_filename(double tjd, int ipli, char *fname)
2058
+ {
2059
+ int icty;
2060
+ int ncties = (int) NCTIES;
2061
+ short gregflag;
2062
+ int jmon, jday, jyear, sgn;
2063
+ double jut;
2064
+ char *sform;
2065
+ switch(ipli) {
2066
+ case SEI_MOON:
2067
+ strcpy(fname, "semo");
2068
+ break;
2069
+ case SEI_EMB:
2070
+ case SEI_MERCURY:
2071
+ case SEI_VENUS:
2072
+ case SEI_MARS:
2073
+ case SEI_JUPITER:
2074
+ case SEI_SATURN:
2075
+ case SEI_URANUS:
2076
+ case SEI_NEPTUNE:
2077
+ case SEI_PLUTO:
2078
+ case SEI_SUNBARY:
2079
+ strcpy(fname, "sepl");
2080
+ break;
2081
+ case SEI_CERES:
2082
+ case SEI_PALLAS:
2083
+ case SEI_JUNO:
2084
+ case SEI_VESTA:
2085
+ case SEI_CHIRON:
2086
+ case SEI_PHOLUS:
2087
+ strcpy(fname, "seas");
2088
+ break;
2089
+ default: /* asteroid */
2090
+ sform = "ast%d%sse%05d.%s";
2091
+ if (ipli - SE_AST_OFFSET > 99999)
2092
+ sform = "ast%d%ss%06d.%s";
2093
+ sprintf(fname, sform,
2094
+ (ipli - SE_AST_OFFSET) / 1000, DIR_GLUE, ipli - SE_AST_OFFSET,
2095
+ SE_FILE_SUFFIX);
2096
+ return; /* asteroids: only one file 3000 bc - 3000 ad */
2097
+ /* break; */
2098
+ }
2099
+ /* century of tjd */
2100
+ /* if tjd > 1600 then gregorian calendar */
2101
+ if (tjd >= 2305447.5) {
2102
+ gregflag = TRUE;
2103
+ swe_revjul(tjd, gregflag, &jyear, &jmon, &jday, &jut);
2104
+ /* else julian calendar */
2105
+ } else {
2106
+ gregflag = FALSE;
2107
+ swe_revjul(tjd, gregflag, &jyear, &jmon, &jday, &jut);
2108
+ }
2109
+ /* start century of file containing tjd */
2110
+ if (jyear < 0)
2111
+ sgn = -1;
2112
+ else
2113
+ sgn = 1;
2114
+ icty = jyear / 100;
2115
+ if (sgn < 0 && jyear % 100 != 0)
2116
+ icty -=1;
2117
+ while(icty % ncties != 0)
2118
+ icty--;
2119
+ #if 0
2120
+ if (icty < BEG_YEAR / 100)
2121
+ icty = BEG_YEAR / 100;
2122
+ if (icty >= END_YEAR / 100)
2123
+ icty = END_YEAR / 100 - ncties;
2124
+ #endif
2125
+ /* B.C. or A.D. */
2126
+ if (icty < 0)
2127
+ strcat(fname, "m");
2128
+ else
2129
+ strcat(fname, "_");
2130
+ icty = abs(icty);
2131
+ sprintf(fname + strlen(fname), "%02d.%s", icty, SE_FILE_SUFFIX);
2132
+ #if 0
2133
+ printf("fname %s\n", fname);
2134
+ fflush(stdout);
2135
+ #endif
2136
+ }
2137
+
2138
+ /**************************************************************
2139
+ cut the string s at any char in cutlist; put pointers to partial strings
2140
+ into cpos[0..n-1], return number of partial strings;
2141
+ if less than nmax fields are found, the first empty pointer is
2142
+ set to NULL.
2143
+ More than one character of cutlist in direct sequence count as one
2144
+ separator only! cut_str_any("word,,,word2",","..) cuts only two parts,
2145
+ cpos[0] = "word" and cpos[1] = "word2".
2146
+ If more than nmax fields are found, nmax is returned and the
2147
+ last field nmax-1 rmains un-cut.
2148
+ **************************************************************/
2149
+ int swi_cutstr(char *s, char *cutlist, char *cpos[], int nmax)
2150
+ {
2151
+ int n = 1;
2152
+ cpos [0] = s;
2153
+ while (*s != '\0') {
2154
+ if ((strchr(cutlist, (int) *s) != NULL) && n < nmax) {
2155
+ *s = '\0';
2156
+ while (*(s + 1) != '\0' && strchr (cutlist, (int) *(s + 1)) != NULL) s++;
2157
+ cpos[n++] = s + 1;
2158
+ }
2159
+ if (*s == '\n' || *s == '\r') { /* treat nl or cr like end of string */
2160
+ *s = '\0';
2161
+ break;
2162
+ }
2163
+ s++;
2164
+ }
2165
+ if (n < nmax) cpos[n] = NULL;
2166
+ return (n);
2167
+ } /* cutstr */
2168
+
2169
+ char *swi_right_trim(char *s)
2170
+ {
2171
+ char *sp = s + strlen(s) - 1;
2172
+ while (isspace((int)(unsigned char) *sp) && sp >= s)
2173
+ *sp-- = '\0';
2174
+ return s;
2175
+ }
2176
+
2177
+ /*
2178
+ * The following C code (by Rob Warnock rpw3@sgi.com) does CRC-32 in
2179
+ * BigEndian/BigEndian byte/bit order. That is, the data is sent most
2180
+ * significant byte first, and each of the bits within a byte is sent most
2181
+ * significant bit first, as in FDDI. You will need to twiddle with it to do
2182
+ * Ethernet CRC, i.e., BigEndian/LittleEndian byte/bit order.
2183
+ *
2184
+ * The CRCs this code generates agree with the vendor-supplied Verilog models
2185
+ * of several of the popular FDDI "MAC" chips.
2186
+ */
2187
+ static uint32 crc32_table[256];
2188
+ /* Initialized first time "crc32()" is called. If you prefer, you can
2189
+ * statically initialize it at compile time. [Another exercise.]
2190
+ */
2191
+
2192
+ uint32 swi_crc32(unsigned char *buf, int len)
2193
+ {
2194
+ unsigned char *p;
2195
+ uint32 crc;
2196
+ if (!crc32_table[1]) /* if not already done, */
2197
+ init_crc32(); /* build table */
2198
+ crc = 0xffffffff; /* preload shift register, per CRC-32 spec */
2199
+ for (p = buf; len > 0; ++p, --len)
2200
+ crc = (crc << 8) ^ crc32_table[(crc >> 24) ^ *p];
2201
+ return ~crc; /* transmit complement, per CRC-32 spec */
2202
+ }
2203
+
2204
+ /*
2205
+ * Build auxiliary table for parallel byte-at-a-time CRC-32.
2206
+ */
2207
+ #define CRC32_POLY 0x04c11db7 /* AUTODIN II, Ethernet, & FDDI */
2208
+
2209
+ static void init_crc32(void)
2210
+ {
2211
+ int32 i, j;
2212
+ uint32 c;
2213
+ for (i = 0; i < 256; ++i) {
2214
+ for (c = i << 24, j = 8; j > 0; --j)
2215
+ c = c & 0x80000000 ? (c << 1) ^ CRC32_POLY : (c << 1);
2216
+ crc32_table[i] = c;
2217
+ }
2218
+ }
2219
+
2220
+ /*******************************************************
2221
+ * other functions from swephlib.c;
2222
+ * they are not needed for Swiss Ephemeris,
2223
+ * but may be useful to former Placalc users.
2224
+ ********************************************************/
2225
+
2226
+ /************************************
2227
+ normalize argument into interval [0..DEG360]
2228
+ *************************************/
2229
+ centisec FAR PASCAL_CONV swe_csnorm(centisec p)
2230
+ {
2231
+ if (p < 0)
2232
+ do { p += DEG360; } while (p < 0);
2233
+ else if (p >= DEG360)
2234
+ do { p -= DEG360; } while (p >= DEG360);
2235
+ return (p);
2236
+ }
2237
+
2238
+ /************************************
2239
+ distance in centisecs p1 - p2
2240
+ normalized to [0..360[
2241
+ **************************************/
2242
+ centisec FAR PASCAL_CONV swe_difcsn (centisec p1, centisec p2)
2243
+ {
2244
+ return (swe_csnorm(p1 - p2));
2245
+ }
2246
+
2247
+ double FAR PASCAL_CONV swe_difdegn (double p1, double p2)
2248
+ {
2249
+ return (swe_degnorm(p1 - p2));
2250
+ }
2251
+
2252
+ /************************************
2253
+ distance in centisecs p1 - p2
2254
+ normalized to [-180..180[
2255
+ **************************************/
2256
+ centisec FAR PASCAL_CONV swe_difcs2n(centisec p1, centisec p2)
2257
+ { centisec dif;
2258
+ dif = swe_csnorm(p1 - p2);
2259
+ if (dif >= DEG180) return (dif - DEG360);
2260
+ return (dif);
2261
+ }
2262
+
2263
+ double FAR PASCAL_CONV swe_difdeg2n(double p1, double p2)
2264
+ { double dif;
2265
+ dif = swe_degnorm(p1 - p2);
2266
+ if (dif >= 180.0) return (dif - 360.0);
2267
+ return (dif);
2268
+ }
2269
+
2270
+ double FAR PASCAL_CONV swe_difrad2n(double p1, double p2)
2271
+ { double dif;
2272
+ dif = swe_radnorm(p1 - p2);
2273
+ if (dif >= TWOPI / 2) return (dif - TWOPI);
2274
+ return (dif);
2275
+ }
2276
+
2277
+ /*************************************
2278
+ round second, but at 29.5959 always down
2279
+ *************************************/
2280
+ centisec FAR PASCAL_CONV swe_csroundsec(centisec x)
2281
+ {
2282
+ centisec t;
2283
+ t = (x + 50) / 100 *100L; /* round to seconds */
2284
+ if (t > x && t % DEG30 == 0) /* was rounded up to next sign */
2285
+ t = x / 100 * 100L; /* round last second of sign downwards */
2286
+ return (t);
2287
+ }
2288
+
2289
+ /*************************************
2290
+ double to int32 with rounding, no overflow check
2291
+ *************************************/
2292
+ int32 FAR PASCAL_CONV swe_d2l(double x)
2293
+ {
2294
+ if (x >=0)
2295
+ return ((int32) (x + 0.5));
2296
+ else
2297
+ return (- (int32) (0.5 - x));
2298
+ }
2299
+
2300
+ /*
2301
+ * monday = 0, ... sunday = 6
2302
+ */
2303
+ int FAR PASCAL_CONV swe_day_of_week(double jd)
2304
+ {
2305
+ return (((int) floor (jd - 2433282 - 1.5) %7) + 7) % 7;
2306
+ }
2307
+
2308
+ char *FAR PASCAL_CONV swe_cs2timestr(CSEC t, int sep, AS_BOOL suppressZero, char *a)
2309
+ /* does not suppress zeros in hours or minutes */
2310
+ {
2311
+ /* static char a[9];*/
2312
+ centisec h,m,s;
2313
+ strcpy (a, " ");
2314
+ a[2] = a [5] = sep;
2315
+ t = ((t + 50) / 100) % (24L *3600L); /* round to seconds */
2316
+ s = t % 60L;
2317
+ m = (t / 60) % 60L;
2318
+ h = t / 3600 % 100L;
2319
+ if (s == 0 && suppressZero)
2320
+ a[5] = '\0';
2321
+ else {
2322
+ a [6] = (char) (s / 10 + '0');
2323
+ a [7] = (char) (s % 10 + '0');
2324
+ };
2325
+ a [0] = (char) (h / 10 + '0');
2326
+ a [1] = (char) (h % 10 + '0');
2327
+ a [3] = (char) (m / 10 + '0');
2328
+ a [4] = (char) (m % 10 + '0');
2329
+ return (a);
2330
+ } /* swe_cs2timestr() */
2331
+
2332
+ char *FAR PASCAL_CONV swe_cs2lonlatstr(CSEC t, char pchar, char mchar, char *sp)
2333
+ {
2334
+ char a[10]; /* must be initialized at each call */
2335
+ char *aa;
2336
+ centisec h,m,s;
2337
+ strcpy (a, " ' ");
2338
+ /* mask dddEmm'ss" */
2339
+ if (t < 0 ) pchar = mchar;
2340
+ t = (ABS4 (t) + 50) / 100; /* round to seconds */
2341
+ s = t % 60L;
2342
+ m = t / 60 % 60L;
2343
+ h = t / 3600 % 1000L;
2344
+ if (s == 0)
2345
+ a[6] = '\0'; /* cut off seconds */
2346
+ else {
2347
+ a [7] = (char) (s / 10 + '0');
2348
+ a [8] = (char) (s % 10 + '0');
2349
+ }
2350
+ a [3] = pchar;
2351
+ if (h > 99) a [0] = (char) (h / 100 + '0');
2352
+ if (h > 9) a [1] = (char) (h % 100 / 10 + '0');
2353
+ a [2] = (char) (h % 10 + '0');
2354
+ a [4] = (char) (m / 10 + '0');
2355
+ a [5] = (char) (m % 10 + '0');
2356
+ aa = a;
2357
+ while (*aa == ' ') aa++;
2358
+ strcpy(sp, aa);
2359
+ return (sp);
2360
+ } /* swe_cs2lonlatstr() */
2361
+
2362
+ char *FAR PASCAL_CONV swe_cs2degstr(CSEC t, char *a)
2363
+ /* does suppress leading zeros in degrees */
2364
+ {
2365
+ /* char a[9]; must be initialized at each call */
2366
+ centisec h,m,s;
2367
+ t = t / 100 % (30L*3600L); /* truncate to seconds */
2368
+ s = t % 60L;
2369
+ m = t / 60 % 60L;
2370
+ h = t / 3600 % 100L; /* only 0..99 degrees */
2371
+ sprintf(a, "%2d%s%02d'%02d", h, ODEGREE_STRING, m, s);
2372
+ return (a);
2373
+ } /* swe_cs2degstr() */
2374
+
2375
+ /*********************************************************
2376
+ * function for splitting centiseconds into *
2377
+ * ideg degrees,
2378
+ * imin minutes,
2379
+ * isec seconds,
2380
+ * dsecfr fraction of seconds
2381
+ * isgn zodiac sign number;
2382
+ * or +/- sign
2383
+ *
2384
+ *********************************************************/
2385
+ void FAR PASCAL_CONV swe_split_deg(double ddeg, int32 roundflag, int32 *ideg, int32 *imin, int32 *isec, double *dsecfr, int32 *isgn)
2386
+ {
2387
+ double dadd = 0;
2388
+ *isgn = 1;
2389
+ if (ddeg < 0) {
2390
+ *isgn = -1;
2391
+ ddeg = -ddeg;
2392
+ }
2393
+ if (roundflag & SE_SPLIT_DEG_ROUND_DEG) {
2394
+ dadd = 0.5;
2395
+ } else if (roundflag & SE_SPLIT_DEG_ROUND_MIN) {
2396
+ dadd = 0.5 / 60;
2397
+ } else if (roundflag & SE_SPLIT_DEG_ROUND_SEC) {
2398
+ dadd = 0.5 / 3600;
2399
+ }
2400
+ if (roundflag & SE_SPLIT_DEG_KEEP_DEG) {
2401
+ if ((int32) (ddeg + dadd) - (int32) ddeg > 0)
2402
+ dadd = 0;
2403
+ } else if (roundflag & SE_SPLIT_DEG_KEEP_SIGN) {
2404
+ if (fmod(ddeg, 30) + dadd >= 30)
2405
+ dadd = 0;
2406
+ }
2407
+ ddeg += dadd;
2408
+ if (roundflag & SE_SPLIT_DEG_ZODIACAL) {
2409
+ *isgn = (int32) (ddeg / 30);
2410
+ ddeg = fmod(ddeg, 30);
2411
+ }
2412
+ *ideg = (int32) ddeg;
2413
+ ddeg -= *ideg;
2414
+ *imin = (int32) (ddeg * 60);
2415
+ ddeg -= *imin / 60.0;
2416
+ *isec = (int32) (ddeg * 3600);
2417
+ if (!(roundflag & (SE_SPLIT_DEG_ROUND_DEG | SE_SPLIT_DEG_ROUND_MIN | SE_SPLIT_DEG_ROUND_SEC))) {
2418
+ *dsecfr = ddeg * 3600 - *isec;
2419
+ }
2420
+ } /* end split_deg */
2421
+
2422
+ double swi_kepler(double E, double M, double ecce)
2423
+ {
2424
+ double dE = 1, E0;
2425
+ double x;
2426
+ /* simple formula for small eccentricities */
2427
+ if (ecce < 0.4) {
2428
+ while(dE > 1e-12) {
2429
+ E0 = E;
2430
+ E = M + ecce * sin(E0);
2431
+ dE = fabs(E - E0);
2432
+ }
2433
+ /* complicated formula for high eccentricities */
2434
+ } else {
2435
+ while(dE > 1e-12) {
2436
+ E0 = E;
2437
+ /*
2438
+ * Alois 21-jul-2000: workaround an optimizer problem in gcc
2439
+ * swi_mod2PI sees very small negative argument e-322 and returns +2PI;
2440
+ * we avoid swi_mod2PI for small x.
2441
+ */
2442
+ x = (M + ecce * sin(E0) - E0) / (1 - ecce * cos(E0));
2443
+ dE = fabs(x);
2444
+ if (dE < 1e-2) {
2445
+ E = E0 + x;
2446
+ } else {
2447
+ E = swi_mod2PI(E0 + x);
2448
+ dE = fabs(E - E0);
2449
+ }
2450
+ }
2451
+ }
2452
+ return E;
2453
+ }
2454
+
2455
+ void swi_FK4_FK5(double *xp, double tjd)
2456
+ {
2457
+ if (xp[0] == 0 && xp[1] == 0 && xp[2] == 0)
2458
+ return;
2459
+ swi_cartpol(xp, xp);
2460
+ /* according to Expl.Suppl., p. 167f. */
2461
+ xp[0] += (0.035 + 0.085 * (tjd - B1950) / 36524.2198782) / 3600 * 15 * DEGTORAD;
2462
+ xp[3] += (0.085 / 36524.2198782) / 3600 * 15 * DEGTORAD;
2463
+ swi_polcart(xp, xp);
2464
+ }
2465
+
2466
+ void swi_FK5_FK4(double *xp, double tjd)
2467
+ {
2468
+ if (xp[0] == 0 && xp[1] == 0 && xp[2] == 0)
2469
+ return;
2470
+ swi_cartpol(xp, xp);
2471
+ /* according to Expl.Suppl., p. 167f. */
2472
+ xp[0] -= (0.035 + 0.085 * (tjd - B1950) / 36524.2198782) / 3600 * 15 * DEGTORAD;
2473
+ xp[3] -= (0.085 / 36524.2198782) / 3600 * 15 * DEGTORAD;
2474
+ swi_polcart(xp, xp);
2475
+ }
2476
+
2477
+ char *swi_strcpy(char *to, char *from)
2478
+ {
2479
+ char *s;
2480
+ if (*from == '\0') {
2481
+ *to = '\0';
2482
+ return to;
2483
+ }
2484
+ s = strdup(from);
2485
+ if (s == NULL) {
2486
+ strcpy(to, from);
2487
+ return to;
2488
+ }
2489
+ strcpy(to, s);
2490
+ free(s);
2491
+ return to;
2492
+ }
2493
+
2494
+ char *swi_strncpy(char *to, char *from, size_t n)
2495
+ {
2496
+ char *s;
2497
+ if (*from == '\0') {
2498
+ return to;
2499
+ }
2500
+ s = strdup(from);
2501
+ if (s == NULL) {
2502
+ strncpy(to, from, n);
2503
+ return to;
2504
+ }
2505
+ strncpy(to, s, n);
2506
+ free(s);
2507
+ return to;
2508
+ }
2509
+
2510
+ #ifdef TRACE
2511
+ void swi_open_trace(char *serr)
2512
+ {
2513
+ swi_trace_count++;
2514
+ if (swi_trace_count >= TRACE_COUNT_MAX) {
2515
+ if (swi_trace_count == TRACE_COUNT_MAX) {
2516
+ if (serr != NULL)
2517
+ sprintf(serr, "trace stopped, %d calls exceeded.", TRACE_COUNT_MAX);
2518
+ if (swi_fp_trace_out != NULL)
2519
+ fprintf(swi_fp_trace_out, "trace stopped, %d calls exceeded.\n", TRACE_COUNT_MAX);
2520
+ if (swi_fp_trace_c != NULL)
2521
+ fprintf(swi_fp_trace_c, "/* trace stopped, %d calls exceeded. */\n", TRACE_COUNT_MAX);
2522
+ }
2523
+ return;
2524
+ }
2525
+ if (swi_fp_trace_c == NULL) {
2526
+ char fname[AS_MAXCH];
2527
+ #if TRACE == 2
2528
+ char *sp, *sp1;
2529
+ int ipid;
2530
+ #endif
2531
+ /* remove(fname_trace_c); */
2532
+ strcpy(fname, fname_trace_c);
2533
+ #if TRACE == 2
2534
+ sp = strchr(fname_trace_c, '.');
2535
+ sp1 = strchr(fname, '.');
2536
+ # if MSDOS
2537
+ ipid = _getpid();
2538
+ # else
2539
+ ipid = getpid();
2540
+ # endif
2541
+ sprintf(sp1, "_%d%s", ipid, sp);
2542
+ #endif
2543
+ if ((swi_fp_trace_c = fopen(fname, FILE_A_ACCESS)) == NULL) {
2544
+ if (serr != NULL)
2545
+ sprintf(serr, "could not open trace output file '%s'", fname);
2546
+ } else {
2547
+ fputs("#include \"sweodef.h\"\n", swi_fp_trace_c);
2548
+ fputs("#include \"swephexp.h\"\n\n", swi_fp_trace_c);
2549
+ fputs("void main()\n{\n", swi_fp_trace_c);
2550
+ fputs(" double tjd, t, nut, eps; int i, ipl, retc; int32 iflag;\n", swi_fp_trace_c);
2551
+ fputs(" double armc, geolat, cusp[12], ascmc[10]; int hsys;\n", swi_fp_trace_c);
2552
+ fputs(" double xx[6]; int32 iflgret;\n", swi_fp_trace_c);
2553
+ fputs(" char s[AS_MAXCH], star[AS_MAXCH], serr[AS_MAXCH];\n", swi_fp_trace_c);
2554
+ fflush(swi_fp_trace_c);
2555
+ }
2556
+ }
2557
+ if (swi_fp_trace_out == NULL) {
2558
+ char fname[AS_MAXCH];
2559
+ #if TRACE == 2
2560
+ char *sp, *sp1;
2561
+ int ipid;
2562
+ #endif
2563
+ /* remove(fname_trace_out); */
2564
+ strcpy(fname, fname_trace_out);
2565
+ #if TRACE == 2
2566
+ sp = strchr(fname_trace_out, '.');
2567
+ sp1 = strchr(fname, '.');
2568
+ # if MSDOS
2569
+ ipid = _getpid();
2570
+ # else
2571
+ ipid = getpid();
2572
+ # endif
2573
+ sprintf(sp1, "_%d%s", ipid, sp);
2574
+ #endif
2575
+ if ((swi_fp_trace_out = fopen(fname, FILE_A_ACCESS)) == NULL) {
2576
+ if (serr != NULL)
2577
+ sprintf(serr, "could not open trace output file '%s'", fname);
2578
+ }
2579
+ }
2580
+ }
2581
+ #endif