1 /* SWISSEPH
2
3 Ephemeris computations
4
5 Authors: Dieter Koch and Alois Treindl, Astrodienst Zurich
6
7 **************************************************************/
8 /* Copyright (C) 1997 - 2021 Astrodienst AG, Switzerland. All rights reserved.
9
10 License conditions
11 ------------------
12
13 This file is part of Swiss Ephemeris.
14
15 Swiss Ephemeris is distributed with NO WARRANTY OF ANY KIND. No author
16 or distributor accepts any responsibility for the consequences of using it,
17 or for whether it serves any particular purpose or works at all, unless he
18 or she says so in writing.
19
20 Swiss Ephemeris is made available by its authors under a dual licensing
21 system. The software developer, who uses any part of Swiss Ephemeris
22 in his or her software, must choose between one of the two license models,
23 which are
24 a) GNU Affero General Public License (AGPL)
25 b) Swiss Ephemeris Professional License
26
27 The choice must be made before the software developer distributes software
28 containing parts of Swiss Ephemeris to others, and before any public
29 service using the developed software is activated.
30
31 If the developer choses the AGPL software license, he or she must fulfill
32 the conditions of that license, which includes the obligation to place his
33 or her whole software project under the AGPL or a compatible license.
34 See https://www.gnu.org/licenses/agpl-3.0.html
35
36 If the developer choses the Swiss Ephemeris Professional license,
37 he must follow the instructions as found in http://www.astro.com/swisseph/
38 and purchase the Swiss Ephemeris Professional Edition from Astrodienst
39 and sign the corresponding license contract.
40
41 The License grants you the right to use, copy, modify and redistribute
42 Swiss Ephemeris, but only under certain conditions described in the License.
43 Among other things, the License requires that the copyright notices and
44 this notice be preserved on all copies.
45
46 Authors of the Swiss Ephemeris: Dieter Koch and Alois Treindl
47
48 The authors of Swiss Ephemeris have no control or influence over any of
49 the derived works, i.e. over software or services created by other
50 programmers which use Swiss Ephemeris functions.
51
52 The names of the authors or of the copyright holder (Astrodienst) must not
53 be used for promoting any software, product or service which uses or contains
54 the Swiss Ephemeris. This copyright notice is the ONLY place where the
55 names of the authors can legally appear, except in cases where they have
56 given special permission in writing.
57
58 The trademarks 'Swiss Ephemeris' and 'Swiss Ephemeris inside' may be used
59 for promoting such software, products or services.
60 */
61
62
63 #include <string.h>
64 #include <ctype.h>
65 #if MSDOS
66 #include <tchar.h>
67 #include <windows.h>
68 #endif
69 #include "swejpl.h"
70 #include "swephexp.h"
71 #include "sweph.h"
72 #include "swephlib.h"
73
74 #ifdef _MSC_VER
75 #define CMP_CALL_CONV __cdecl
76 #else
77 #define CMP_CALL_CONV
78 #endif
79
80 #define IS_PLANET 0
81 #define IS_MOON 1
82 #define IS_ANY_BODY 2
83 #define IS_MAIN_ASTEROID 3
84
85 #define DO_SAVE TRUE
86 #define NO_SAVE FALSE
87
88 #define SEFLG_EPHMASK (SEFLG_JPLEPH|SEFLG_SWIEPH|SEFLG_MOSEPH)
89 #define SEFLG_COORDSYS (SEFLG_EQUATORIAL | SEFLG_XYZ | SEFLG_RADIANS)
90
91 struct meff_ele {double r,m;};
92
93 /****************
94 * global stuff *
95 ****************/
96 TLS struct swe_data swed = {FALSE, /* ephe_path_is_set = FALSE */
97 FALSE, /* jpl_file_is_open = FALSE */
98 NULL, /* fixfp, fixed stars file pointer */
99 #if 0
100 SE_EPHE_PATH, /* ephepath, ephemeris path */
101 SE_FNAME_DFT, /* jplfnam, JPL file name, default */
102 #else
103 "", /* ephepath, ephemeris path */
104 "", /* jplfnam, JPL file name, default */
105 #endif
106 0, /* jpldenum */
107 0, /* last_epheflag */
108 FALSE, /* geopos_is_set, for topocentric */
109 FALSE, /* ayana_is_set, ayanamsa is set */
110 FALSE, /* is_old_starfile, fixstars.cat is used (default is sefstars.txt) */
111 0.0, 0.0, 0.0, 0.0, /* eop_tjd_... */
112 0, /* eop_dpsi_loaded */
113 0.0, /* tid_acc */
114 FALSE, /* is_tid_acc_manual */
115 FALSE, /* init_dt_done */
116 FALSE, /* swed_is_initialised */
117 FALSE, /* delta_t_userdef_is_set */
118 0.0, /* delta_t_userdef */
119 0.0, /* ast_G */
120 0.0, /* ast_H */
121 0.0, /* ast_diam */
122 "", /* astelem[] */
123 0, /* i_saved_planet_name */
124 "", /* saved_planet_name[] */
125 NULL, /* dpsi */
126 NULL, /* deps */
127 0, /* timeout */
128 {0,0,0,0,0,0,0,0,}, /* astro_models */
129 };
130
131 /*************
132 * constants *
133 *************/
134
135 static const char *ayanamsa_name[] = {
136 "Fagan/Bradley", /* 0 SE_SIDM_FAGAN_BRADLEY */
137 "Lahiri", /* 1 SE_SIDM_LAHIRI */
138 "De Luce", /* 2 SE_SIDM_DELUCE */
139 "Raman", /* 3 SE_SIDM_RAMAN */
140 "Usha/Shashi", /* 4 SE_SIDM_USHASHASHI */
141 "Krishnamurti", /* 5 SE_SIDM_KRISHNAMURTI */
142 "Djwhal Khul", /* 6 SE_SIDM_DJWHAL_KHUL */
143 "Yukteshwar", /* 7 SE_SIDM_YUKTESHWAR */
144 "J.N. Bhasin", /* 8 SE_SIDM_JN_BHASIN */
145 "Babylonian/Kugler 1", /* 9 SE_SIDM_BABYL_KUGLER1 */
146 "Babylonian/Kugler 2", /* 10 SE_SIDM_BABYL_KUGLER2 */
147 "Babylonian/Kugler 3", /* 11 SE_SIDM_BABYL_KUGLER3 */
148 "Babylonian/Huber", /* 12 SE_SIDM_BABYL_HUBER */
149 "Babylonian/Eta Piscium", /* 13 SE_SIDM_BABYL_ETPSC */
150 "Babylonian/Aldebaran = 15 Tau", /* 14 SE_SIDM_ALDEBARAN_15TAU */
151 "Hipparchos", /* 15 SE_SIDM_HIPPARCHOS */
152 "Sassanian", /* 16 SE_SIDM_SASSANIAN */
153 "Galact. Center = 0 Sag", /* 17 SE_SIDM_GALCENT_0SAG */
154 "J2000", /* 18 SE_SIDM_J2000 */
155 "J1900", /* 19 SE_SIDM_J1900 */
156 "B1950", /* 20 SE_SIDM_B1950 */
157 "Suryasiddhanta", /* 21 SE_SIDM_SURYASIDDHANTA */
158 "Suryasiddhanta, mean Sun", /* 22 SE_SIDM_SURYASIDDHANTA_MSUN */
159 "Aryabhata", /* 23 SE_SIDM_ARYABHATA */
160 "Aryabhata, mean Sun", /* 24 SE_SIDM_ARYABHATA_MSUN */
161 "SS Revati", /* 25 SE_SIDM_SS_REVATI */
162 "SS Citra", /* 26 SE_SIDM_SS_CITRA */
163 "True Citra", /* 27 SE_SIDM_TRUE_CITRA */
164 "True Revati", /* 28 SE_SIDM_TRUE_REVATI */
165 "True Pushya (PVRN Rao)", /* 29 SE_SIDM_TRUE_PUSHYA */
166 "Galactic Center (Gil Brand)", /* 30 SE_SIDM_GALCENT_RGILBRAND */
167 "Galactic Equator (IAU1958)", /* 31 SE_SIDM_GALEQU_IAU1958 */
168 "Galactic Equator", /* 32 SE_SIDM_GALEQU_TRUE */
169 "Galactic Equator mid-Mula", /* 33 SE_SIDM_GALEQU_MULA */
170 "Skydram (Mardyks)", /* 34 SE_SIDM_GALALIGN_MARDYKS */
171 "True Mula (Chandra Hari)", /* 35 SE_SIDM_TRUE_MULA */
172 "Dhruva/Gal.Center/Mula (Wilhelm)", /* 36 SE_SIDM_GALCENT_MULA_WILHELM */
173 "Aryabhata 522", /* 37 SE_SIDM_ARYABHATA_522 */
174 "Babylonian/Britton", /* 38 SE_SIDM_BABYL_BRITTON */
175 "\"Vedic\"/Sheoran", /* 39 SE_SIDM_TRUE_SHEORAN */
176 "Cochrane (Gal.Center = 0 Cap)", /* 40 SE_SIDM_GALCENT_COCHRANE */
177 "Galactic Equator (Fiorenza)", /* 41 SE_SIDM_GALEQU_FIORENZA */
178 "Vettius Valens", /* 42 SE_SIDM_VALENS_MOON */
179 "Lahiri 1940", /* 43 SE_SIDM_LAHIRI_1940 */
180 "Lahiri VP285", /* 44 SE_SIDM_LAHIRI_VP285 */
181 "Krishnamurti-Senthilathiban", /* 45 SE_SIDM_KRISHNAMURTI_VP291 */
182 "Lahiri ICRC", /* 46 SE_SIDM_LAHIRI_ICRC */
183 /*"Manjula/Laghumanasa",*/
184 };
185 static const int pnoint2jpl[] = PNOINT2JPL;
186
187 static const int pnoext2int[] = {SEI_SUN, SEI_MOON, SEI_MERCURY, SEI_VENUS, SEI_MARS, SEI_JUPITER, SEI_SATURN, SEI_URANUS, SEI_NEPTUNE, SEI_PLUTO, 0, 0, 0, 0, SEI_EARTH, SEI_CHIRON, SEI_PHOLUS, SEI_CERES, SEI_PALLAS, SEI_JUNO, SEI_VESTA, };
188
189 static int32 swecalc(double tjd, int ipl, int iplmoon, int32 iflag, double *x, char *serr);
190 static int do_fread(void *targ, int size, int count, int corrsize,
191 FILE *fp, int32 fpos, int freord, int fendian, int ifno,
192 char *serr);
193 static int get_new_segment(double tjd, int ipli, int ifno, char *serr);
194 static int main_planet(double tjd, int ipli, int iplmoon, int32 epheflag, int32 iflag,
195 char *serr);
196 static int main_planet_bary(double tjd, int ipli, int32 epheflag, int32 iflag,
197 AS_BOOL do_save,
198 double *xp, double *xe, double *xs, double *xm,
199 char *serr);
200 static int sweplan(double tjd, int ipli, int ifno, int32 iflag, AS_BOOL do_save,
201 double *xp, double *xpe, double *xps, double *xpm,
202 char *serr);
203 static int swemoon(double tjd, int32 iflag, AS_BOOL do_save, double *xp, char *serr);
204 static int sweph(double tjd, int ipli, int ifno, int32 iflag, double *xsunb, AS_BOOL do_save,
205 double *xp, char *serr);
206 static int jplplan(double tjd, int ipli, int32 iflag, AS_BOOL do_save,
207 double *xp, double *xpe, double *xps, char *serr);
208 static void rot_back(int ipl);
209 static int read_const(int ifno, char *serr);
210 static void embofs(double *xemb, double *xmoon);
211 static int app_pos_etc_plan(int ipli, int iplmoon, int32 iflag, char *serr);
212 static int app_pos_etc_plan_osc(int ipl, int ipli, int32 iflag, char *serr);
213 static int app_pos_etc_sun(int32 iflag, char *serr);
214 static int app_pos_etc_moon(int32 iflag, char *serr);
215 static int app_pos_etc_sbar(int32 iflag, char *serr);
216 extern int swi_plan_for_osc_elem(int32 iflag, double tjd, double *xx);
217 static void swi_close_keep_topo_etc(void);
218 static int app_pos_etc_mean(int ipl, int32 iflag, char *serr);
219 static void nut_matrix(struct nut *nu, struct epsilon *oec);
220 static void calc_epsilon(double tjd, int32 iflag, struct epsilon *e);
221 static int lunar_osc_elem(double tjd, int ipl, int32 iflag, char *serr);
222 static int intp_apsides(double tjd, int ipl, int32 iflag, char *serr);
223 static double meff(double r);
224 static void denormalize_positions(double *x0, double *x1, double *x2);
225 static void calc_speed(double *x0, double *x1, double *x2, double dt);
226 static int32 plaus_iflag(int32 iflag, int32 ipl, double tjd, char *serr);
227 static int app_pos_rest(struct plan_data *pdp, int32 iflag,
228 double *xx, double *x2000, struct epsilon *oe, char *serr);
229 static int open_jpl_file(double *ss, char *fname, char *fpath, char *serr);
230 static void free_planets(void);
231
232 #ifdef TRACE
233 static void trace_swe_calc(int param, double tjd, int ipl, int32 iflag, double *xx, char *serr);
234 static void trace_swe_fixstar(int swtch, char *star, double tjd, int32 iflag, double *xx, char *serr);
235 static void trace_swe_get_planet_name(int swtch, int ipl, char *s);
236 #endif
237
238
swe_version(char * s)239 char *CALL_CONV swe_version(char *s)
240 {
241 strcpy(s, SE_VERSION);
242 return s;
243 }
244
245 #ifndef NO_SWE_GLP // -DNO_SWE_GLP to suppress this function
246 #if MSDOS
247 HANDLE dllhandle = NULL; // global used in swe_version
248 // if DLL, set by DllMain()
249 #else
250 #ifdef __GNUC__
251 // The following define is actually forbidden.
252 // It would be better to compile with -D_GNU_SOURCE.
253 #ifndef __USE_GNU
254 #define __USE_GNU
255 #endif
256 #include <dlfcn.h> // must be linked with -ldl
257 static Dl_info dli;
258 #endif
259 #endif // MSDOS
260
swe_get_library_path(char * s)261 char *CALL_CONV swe_get_library_path(char *s)
262 {
263 size_t bytes;
264 size_t len;
265 *s = '\0';
266 #if !defined(__APPLE)
267 len = AS_MAXCH;
268 bytes = 0;
269 #if MSDOS
270 bytes = GetModuleFileName((HMODULE) dllhandle, (TCHAR*) s, (DWORD) len);
271 #else
272 #ifdef __GNUC__
273 if (dladdr((void *)swe_version, &dli) != 0) {
274 if (strlen(dli.dli_fname) >= len) {
275 strncpy(s, dli.dli_fname, len);
276 s[len] = '\0';
277 } else{
278 strcpy(s, dli.dli_fname);
279 }
280 bytes = strlen(s);
281 } else {
282 bytes = readlink("/proc/self/exe", s, len);
283 }
284 #else
285 bytes = readlink("/proc/self/exe", s, len);
286 #endif
287 #endif
288 s[bytes] = '\0';
289 #endif
290 return s;
291 }
292 #else // NO_SWE_GLP
293 // we need this function because swetest requires it
swe_get_library_path(char * s)294 char *CALL_CONV swe_get_library_path(char *s)
295 {
296 *s = '\0';
297 return s;
298 }
299 #endif // NO_SWE_GLP
300
301 /* The routine called by the user.
302 * It checks whether a position for the same planet, the same t, and the
303 * same flag bits has already been computed.
304 * If yes, this position is returned. Otherwise it is computed.
305 * -> If the SEFLG_SPEED flag has been specified, the speed will be returned
306 * at offset 3 of position array x[]. Its precision is probably better
307 * than 0.002"/day.
308 * -> If the SEFLG_SPEED3 flag has been specified, the speed will be computed
309 * from three positions. This speed is less accurate than SEFLG_SPEED,
310 * i.e. better than 0.1"/day. And it is much slower. It is used for
311 * program tests only.
312 * -> If no speed flag has been specified, no speed will be returned.
313 */
swe_calc(double tjd,int ipl,int32 iflag,double * xx,char * serr)314 int32 CALL_CONV swe_calc(double tjd, int ipl, int32 iflag,
315 double *xx, char *serr)
316 {
317 int i, j;
318 int32 iplmoon = 0, iflgsave = iflag;
319 int32 epheflag;
320 AS_BOOL use_speed3 = FALSE;
321 struct save_positions *sd;
322 double x[6], *xs, x0[24], x2[24];
323 double dt;
324 if (serr != NULL)
325 *serr = '\0';
326 #ifdef TRACE
327 #ifdef FORCE_IFLAG
328 /*
329 * If this source file is compiled with /DFORCE_IFLAG or -DFORCE_IFLAG
330 * and also with TRACE, then the actual value of iflag used in swe_calc()
331 * can be manipulated from the outside of an application:
332 * Create a text file 'force.flg' and put one text line into it
333 * containing a number, e.g. 1024
334 * This number will be or'ed into the iflag used by the caller of swe_calc()
335 *
336 * See the code below for the details.
337 * This is not an important mechanism. We used it to debug an application
338 * which showed strange behaviour, by compiling a special DLL with TRACE and
339 * FORCE_IFLAG and then running the application with this DLL (we had no
340 * source code of the application itself).
341 */
342 static TLS int force_flag = 0;
343 static TLS int32 iflag_forced = 0;
344 static TLS int force_flag_checked = 0;
345 FILE *fp;
346 char s[AS_MAXCH], *sp;
347 memset(x, 0, sizeof(double) * 6);
348 /* if the following file exists, flag is read from it and or'ed into iflag */
349 if (!force_flag_checked) {
350 if ((fp = fopen(fname_force_flg, BFILE_R_ACCESS)) != NULL) {
351 force_flag = 1;
352 fgets(s, AS_MAXCH, fp);
353 if ((sp = strchr(s, '\n')) != NULL)
354 *sp = '\0';
355 iflag_forced = atol(s);
356 fclose(fp);
357 }
358 force_flag_checked = 1;
359 }
360 if (force_flag)
361 iflag |= iflag_forced;
362 #endif
363 swi_open_trace(serr);
364 trace_swe_calc(1, tjd, ipl, iflag, xx, NULL);
365 #endif /* TRACE */
366 /* function calls for Pluto with asteroid number 134340
367 * are treated as calls for Pluto as main body SE_PLUTO.
368 * Reason: Our numerical integrator takes into account Pluto
369 * perturbation and therefore crashes with body 134340 Pluto. */
370 if (ipl == SE_AST_OFFSET + 134340)
371 ipl = SE_PLUTO;
372 /* if ephemeris flag != ephemeris flag of last call,
373 * we clear the save area, to prevent swecalc() using
374 * previously computed data for current calculation.
375 * except with ipl = SE_ECL_NUT which is not dependent
376 * on ephemeris, and except if change is from
377 * ephemeris = 0 to ephemeris = SEFLG_DEFAULTEPH
378 * or vice-versa.
379 */
380 epheflag = iflag & SEFLG_EPHMASK;
381 if (epheflag & SEFLG_MOSEPH)
382 epheflag = SEFLG_MOSEPH;
383 else if (epheflag & SEFLG_JPLEPH)
384 epheflag = SEFLG_JPLEPH;
385 else
386 epheflag = SEFLG_SWIEPH;
387 if (swi_init_swed_if_start() == 1 && !(epheflag & SEFLG_MOSEPH) && serr != NULL) {
388 strcpy(serr, "Please call swe_set_ephe_path() or swe_set_jplfile() before calling swe_calc() or swe_calc_ut()");
389 }
390 if (swed.last_epheflag != epheflag) {
391 free_planets();
392 /* close and free ephemeris files */
393 if (ipl != SE_ECL_NUT) { /* because file will not be reopened with this ipl */
394 if (swed.jpl_file_is_open) {
395 swi_close_jpl_file();
396 swed.jpl_file_is_open = FALSE;
397 }
398 for (i = 0; i < SEI_NEPHFILES; i ++) {
399 if (swed.fidat[i].fptr != NULL)
400 fclose(swed.fidat[i].fptr);
401 memset((void *) &swed.fidat[i], 0, sizeof(struct file_data));
402 }
403 swed.last_epheflag = epheflag;
404 }
405 }
406 /* high precision speed prevails fast speed */
407 if ((iflag & SEFLG_SPEED3) && (iflag & SEFLG_SPEED))
408 iflag = iflag & ~SEFLG_SPEED3;
409 if (iflag & SEFLG_SPEED3)
410 use_speed3 = TRUE;
411 /* topocentric with SEFLG_SPEED is not good if aberration is included.
412 * in such cases we calculate speed from three positions */
413 if ((iflag & SEFLG_SPEED) && (iflag & SEFLG_TOPOCTR) && !(iflag & SEFLG_NOABERR))
414 use_speed3 = TRUE;
415 /* cartesian flag excludes radians flag */
416 if ((iflag & SEFLG_XYZ) && (iflag & SEFLG_RADIANS))
417 iflag = iflag & ~SEFLG_RADIANS;
418 /* if (iflag & SEFLG_ICRS)
419 iflag |= SEFLG_J2000;*/
420 /* planetary center of body or planetary moon: either planet is called
421 * with SEFLG_CENTER_BODY or center of body with ipl = 9n99 is called.
422 * we want to handle both cases the same way. */
423 // planet is called with SE_PLUTO etc. and SEFLG_CENTER_BODY:
424 // get number of center of body
425 if ((iflag & SEFLG_CENTER_BODY) && ipl <= SE_PLUTO && (iflag & SEFLG_TEST_PLMOON) != SEFLG_TEST_PLMOON) {
426 iplmoon = ipl * 100 + 9099; // planetary center of body
427 }
428 // planet center of body or planetary moon is called using 9... number:
429 // moon number and planet number
430 if (ipl >= SE_PLMOON_OFFSET && ipl < SE_AST_OFFSET && (iflag & SEFLG_TEST_PLMOON) != SEFLG_TEST_PLMOON) {
431 iplmoon = ipl; // planetary center of body or planetary moon
432 ipl = (int) ((ipl - 9000) / 100);
433 iflag |= SEFLG_CENTER_BODY;
434 }
435 // with Mercury to Mars, we do not have center of body different from barycenter
436 if ((iflag & SEFLG_CENTER_BODY) && ipl <= SE_MARS && (iplmoon % 100) == 99) {
437 iplmoon = 0;
438 iflag &= ~SEFLG_CENTER_BODY;
439 }
440 if ((iflag & SEFLG_CENTER_BODY) || iplmoon > 0)
441 swi_force_app_pos_etc();
442 /* pointer to save area */
443 if (ipl < SE_NPLANETS && ipl >= SE_SUN) {
444 sd = &swed.savedat[ipl];
445 // if (iflag & SEFLG_CENTER_BODY)
446 // sd = &swed.savedat[SE_NPLANETS];
447 } else {
448 /* other bodies, e.g. asteroids called with ipl = SE_AST_OFFSET + MPC# */
449 sd = &swed.savedat[SE_NPLANETS];
450 }
451 /*
452 * if position is available in save area, it is returned.
453 * this is the case, if tjd = tsave and iflag = iflgsave.
454 * coordinate flags can be neglected, because save area
455 * provides all coordinate types.
456 * if ipl > SE_AST(EROID)_OFFSET, ipl must be checked,
457 * because all asteroids called by MPC number share the same
458 * save area.
459 */
460 if (sd->tsave == tjd && tjd != 0 && ipl == sd->ipl && iplmoon == 0) {
461 if ((sd->iflgsave & ~SEFLG_COORDSYS) == (iflag & ~SEFLG_COORDSYS))
462 goto end_swe_calc;
463 }
464 /*
465 * otherwise, new position must be computed
466 */
467 if (!use_speed3) {
468 /*
469 * with high precision speed from one call of swecalc()
470 * (FAST speed)
471 */
472 sd->tsave = tjd;
473 sd->ipl = ipl;
474 if ((sd->iflgsave = swecalc(tjd, ipl, iplmoon, iflag, sd->xsaves, serr)) == ERR)
475 goto return_error;
476 } else {
477 /*
478 * with speed from three calls of swecalc(), slower and less accurate.
479 * (SLOW speed, for test only)
480 */
481 sd->tsave = tjd;
482 sd->ipl = ipl;
483 switch(ipl) {
484 case SE_MOON:
485 dt = MOON_SPEED_INTV;
486 break;
487 case SE_OSCU_APOG:
488 case SE_TRUE_NODE:
489 /* this is the optimum dt with Moshier ephemeris, but not with
490 * JPL ephemeris or SWISSEPH. To avoid completely false speed
491 * in case that JPL is wanted but the program returns Moshier,
492 * we use Moshier optimum.
493 * For precise speed, use JPL and FAST speed computation,
494 */
495 dt = NODE_CALC_INTV_MOSH;
496 break;
497 default:
498 dt = PLAN_SPEED_INTV;
499 break;
500 }
501 if ((sd->iflgsave = swecalc(tjd-dt, ipl, iplmoon, iflag, x0, serr)) == ERR)
502 goto return_error;
503 if ((sd->iflgsave = swecalc(tjd+dt, ipl, iplmoon, iflag, x2, serr)) == ERR)
504 goto return_error;
505 if ((sd->iflgsave = swecalc(tjd, ipl, iplmoon, iflag, sd->xsaves, serr)) == ERR)
506 goto return_error;
507 denormalize_positions(x0, sd->xsaves, x2);
508 calc_speed(x0, sd->xsaves, x2, dt);
509 }
510 end_swe_calc:
511 if (iflag & SEFLG_EQUATORIAL) {
512 xs = sd->xsaves+12; /* equatorial coordinates */
513 } else {
514 xs = sd->xsaves; /* ecliptic coordinates */
515 }
516 if (iflag & SEFLG_XYZ)
517 xs = xs+6; /* cartesian coordinates */
518 if (ipl == SE_ECL_NUT)
519 i = 4;
520 else
521 i = 3;
522 for (j = 0; j < i; j++)
523 x[j] = *(xs + j);
524 for (j = i; j < 6; j++)
525 x[j] = 0;
526 if (iflag & (SEFLG_SPEED3 | SEFLG_SPEED)) {
527 for (j = 3; j < 6; j++)
528 x[j] = *(xs + j);
529 }
530 #if 1
531 if (iflag & SEFLG_RADIANS) {
532 if (ipl == SE_ECL_NUT) {
533 for (j = 0; j < 4; j++)
534 x[j] *= DEGTORAD;
535 } else {
536 for (j = 0; j < 2; j++)
537 x[j] *= DEGTORAD;
538 if (iflag & (SEFLG_SPEED3 | SEFLG_SPEED)) {
539 for (j = 3; j < 5; j++)
540 x[j] *= DEGTORAD;
541 }
542 }
543 }
544 #endif
545 for (i = 0; i <= 5; i++)
546 xx[i] = x[i];
547 //iflag = sd->iflgsave | (iflag & SEFLG_COORDSYS);
548 // iflag from previous call of swe_calc(), without coordinate system flags
549 iflag = sd->iflgsave & ~SEFLG_COORDSYS;
550 // add correct coordinate system flags
551 iflag |= (iflgsave & SEFLG_COORDSYS);
552 /* if no ephemeris has been specified, do not return chosen ephemeris */
553 if ((iflgsave & SEFLG_EPHMASK) == 0)
554 iflag = iflag & ~SEFLG_DEFAULTEPH;
555 #ifdef TRACE
556 trace_swe_calc(2, tjd, ipl, iflag, xx, serr);
557 #endif
558 return iflag;
559 return_error:
560 for (i = 0; i <= 5; i++)
561 xx[i] = 0;
562 #ifdef TRACE
563 trace_swe_calc(2, tjd, ipl, iflag, xx, serr);
564 #endif
565 return ERR;
566 }
567
swe_calc_ut(double tjd_ut,int32 ipl,int32 iflag,double * xx,char * serr)568 int32 CALL_CONV swe_calc_ut(double tjd_ut, int32 ipl, int32 iflag,
569 double *xx, char *serr)
570 {
571 double deltat;
572 int32 retval = OK;
573 int32 epheflag = 0;
574 iflag = plaus_iflag(iflag, ipl, tjd_ut, serr);
575 epheflag = iflag & SEFLG_EPHMASK;
576 if (epheflag == 0) {
577 epheflag = SEFLG_SWIEPH;
578 iflag |= SEFLG_SWIEPH;
579 }
580 deltat = swe_deltat_ex(tjd_ut, iflag, serr);
581 retval = swe_calc(tjd_ut + deltat, ipl, iflag, xx, serr);
582 /* if ephe required is not ephe returned, adjust delta t: */
583 if ((retval & SEFLG_EPHMASK) != epheflag) {
584 deltat = swe_deltat_ex(tjd_ut, retval, NULL);
585 retval = swe_calc(tjd_ut + deltat, ipl, iflag, xx, NULL);
586 }
587 return retval;
588 }
589
swecalc(double tjd,int ipl,int32 iplmoon,int32 iflag,double * x,char * serr)590 static int32 swecalc(double tjd, int ipl, int32 iplmoon, int32 iflag, double *x, char *serr)
591 {
592 int i;
593 int ipli, ipli_ast, ifno;
594 int retc;
595 int32 epheflag = SEFLG_DEFAULTEPH;
596 struct plan_data *pdp;
597 struct plan_data *pedp = &swed.pldat[SEI_EARTH];
598 struct plan_data *psdp = &swed.pldat[SEI_SUNBARY];
599 #if 0
600 struct node_data *ndp;
601 #else
602 struct plan_data *ndp;
603 #endif
604 double *xp, *xp2;
605 double ss[3];
606 char serr2[AS_MAXCH];
607 //if (serr != NULL)
608 // *serr = '\0'; // is done in calling function
609 serr2[0] = '\0';
610 /******************************************
611 * iflag plausible? *
612 ******************************************/
613 iflag = plaus_iflag(iflag, ipl, tjd, serr);
614 /******************************************
615 * which ephemeris is wanted, which is used?
616 * Three ephemerides are possible: MOSEPH, SWIEPH, JPLEPH.
617 * JPLEPH is best, SWIEPH is nearly as good, MOSEPH is least precise.
618 * The availability of the various ephemerides depends on the installed
619 * ephemeris files in the users ephemeris directory. This can change at
620 * any time.
621 * Swisseph should try to fulfil the wish of the user for a specific
622 * ephemeris, but use a less precise one if the desired ephemeris is not
623 * available for the given date and body.
624 * If internal ephemeris errors are detected (data error, file length error)
625 * an error is returned.
626 * If the time range is bad but another ephemeris can deliver this range,
627 * the other ephemeris is used.
628 * If no ephemeris is specified, DEFAULTEPH is assumed as desired.
629 * DEFAULTEPH is defined at compile time, usually as JPLEPH.
630 * The caller learns from the return flag which ephemeris was used.
631 * ephe_flag is extracted from iflag, but can change later if the
632 * desired ephe is not available.
633 ******************************************/
634 if (iflag & SEFLG_MOSEPH)
635 epheflag = SEFLG_MOSEPH;
636 if (iflag & SEFLG_SWIEPH)
637 epheflag = SEFLG_SWIEPH;
638 if (iflag & SEFLG_JPLEPH)
639 epheflag = SEFLG_JPLEPH;
640 /* no barycentric calculations with Moshier ephemeris */
641 if ((iflag & SEFLG_BARYCTR) && (iflag & SEFLG_MOSEPH)) {
642 if (serr != NULL)
643 strcpy(serr, "barycentric Moshier positions are not supported.");
644 return ERR;
645 }
646 if (epheflag != SEFLG_MOSEPH && !swed.ephe_path_is_set && !swed.jpl_file_is_open)
647 swe_set_ephe_path(NULL);
648 if ((iflag & SEFLG_SIDEREAL) && !swed.ayana_is_set)
649 swe_set_sid_mode(SE_SIDM_FAGAN_BRADLEY, 0, 0);
650 /******************************************
651 * obliquity of ecliptic 2000 and of date *
652 ******************************************/
653 swi_check_ecliptic(tjd, iflag);
654 /******************************************
655 * nutation *
656 ******************************************/
657 swi_check_nutation(tjd, iflag);
658 /******************************************
659 * select planet and ephemeris *
660 * *
661 * ecliptic and nutation *
662 ******************************************/
663 if (ipl == SE_ECL_NUT) {
664 x[0] = swed.oec.eps + swed.nut.nutlo[1]; /* true ecliptic */
665 x[1] = swed.oec.eps; /* mean ecliptic */
666 x[2] = swed.nut.nutlo[0]; /* nutation in longitude */
667 x[3] = swed.nut.nutlo[1]; /* nutation in obliquity */
668 /*if ((iflag & SEFLG_RADIANS) == 0)*/
669 for (i = 0; i <= 3; i++)
670 x[i] *= RADTODEG;
671 return(iflag);
672 /******************************************
673 * moon *
674 ******************************************/
675 } else if (ipl == SE_MOON) {
676 /* internal planet number */
677 ipli = SEI_MOON;
678 pdp = &swed.pldat[ipli];
679 xp = pdp->xreturn;
680 switch(epheflag) {
681 case SEFLG_JPLEPH:
682 retc = jplplan(tjd, ipli, iflag, DO_SAVE, NULL, NULL, NULL, serr);
683 /* read error or corrupt file */
684 if (retc == ERR)
685 goto return_error;
686 /* jpl ephemeris not on disk or date beyond ephemeris range
687 * or file corrupt */
688 if (retc == NOT_AVAILABLE) {
689 iflag = (iflag & ~SEFLG_JPLEPH) | SEFLG_SWIEPH;
690 if (serr != NULL && strlen(serr) + 30 < AS_MAXCH)
691 strcat(serr, " \ntrying Swiss Eph; ");
692 goto sweph_moon;
693 } else if (retc == BEYOND_EPH_LIMITS) {
694 if (tjd > MOSHLUEPH_START && tjd < MOSHLUEPH_END) {
695 iflag = (iflag & ~SEFLG_JPLEPH) | SEFLG_MOSEPH;
696 if (serr != NULL && strlen(serr) + 30 < AS_MAXCH)
697 strcat(serr, " \nusing Moshier Eph; ");
698 goto moshier_moon;
699 } else
700 goto return_error;
701 }
702 break;
703 case SEFLG_SWIEPH:
704 sweph_moon:
705 #if 0
706 /* for hel. or bary. position, we need earth and sun as well;
707 * this is done by sweplan(), but not by swemoon() */
708 if (iflag & (SEFLG_HELCTR | SEFLG_BARYCTR | SEFLG_NOABERR))
709 retc = sweplan(tjd, ipli, SEI_FILE_MOON, iflag, DO_SAVE,
710 NULL, NULL, NULL, NULL, serr);
711 else
712 retc = swemoon(tjd, iflag, DO_SAVE, pdp->x, serr);/**/
713 #else
714 retc = sweplan(tjd, ipli, SEI_FILE_MOON, iflag, DO_SAVE,
715 NULL, NULL, NULL, NULL, serr);
716 #endif
717 if (retc == ERR)
718 goto return_error;
719 /* if sweph file not found, switch to moshier */
720 if (retc == NOT_AVAILABLE) {
721 if (tjd > MOSHLUEPH_START && tjd < MOSHLUEPH_END) {
722 iflag = (iflag & ~SEFLG_SWIEPH) | SEFLG_MOSEPH;
723 if (serr != NULL && strlen(serr) + 30 < AS_MAXCH)
724 strcat(serr, " \nusing Moshier eph.; ");
725 goto moshier_moon;
726 } else
727 goto return_error;
728 }
729 break;
730 case SEFLG_MOSEPH:
731 moshier_moon:
732 retc = swi_moshmoon(tjd, DO_SAVE, NULL, serr);/**/
733 if (retc == ERR)
734 goto return_error;
735 /* for hel. position, we need earth as well */
736 retc = swi_moshplan(tjd, SEI_EARTH, DO_SAVE, NULL, NULL, serr);/**/
737 if (retc == ERR)
738 goto return_error;
739 break;
740 default:
741 break;
742 }
743 /* heliocentric, lighttime etc. */
744 if ((retc = app_pos_etc_moon(iflag, serr)) != OK)
745 goto return_error; /* retc may be wrong with sidereal calculation */
746 /**********************************************
747 * barycentric sun *
748 * (only JPL and SWISSEPH ephemerises) *
749 **********************************************/
750 } else if (ipl == SE_SUN && (iflag & SEFLG_BARYCTR)) {
751 /* barycentric sun must be handled separately because of
752 * the following reasons:
753 * ordinary planetary computations use the function
754 * main_planet() and its subfunction jplplan(),
755 * see further below.
756 * now, these functions need the swisseph internal
757 * planetary indices, where SEI_EARTH = SEI_SUN = 0.
758 * therefore they don't know the difference between
759 * a barycentric sun and a barycentric earth and
760 * always return barycentric earth.
761 * to avoid this problem, many functions would have to
762 * be changed. as an alternative, we choose a more
763 * separate handling. */
764 ipli = SEI_SUN; /* = SEI_EARTH ! */
765 xp = pedp->xreturn;
766 switch(epheflag) {
767 case SEFLG_JPLEPH:
768 /* open ephemeris, if still closed */
769 if (!swed.jpl_file_is_open) {
770 retc = open_jpl_file(ss, swed.jplfnam, swed.ephepath, serr);
771 if (retc != OK)
772 goto sweph_sbar;
773 }
774 retc = swi_pleph(tjd, J_SUN, J_SBARY, psdp->x, serr);
775 if (retc == ERR || retc == BEYOND_EPH_LIMITS) {
776 swi_close_jpl_file();
777 swed.jpl_file_is_open = FALSE;
778 goto return_error;
779 }
780 /* jpl ephemeris not on disk or date beyond ephemeris range
781 * or file corrupt */
782 if (retc == NOT_AVAILABLE) {
783 iflag = (iflag & ~SEFLG_JPLEPH) | SEFLG_SWIEPH;
784 if (serr != NULL && strlen(serr) + 30 < AS_MAXCH)
785 strcat(serr, " \ntrying Swiss Eph; ");
786 goto sweph_sbar;
787 }
788 psdp->teval = tjd;
789 break;
790 case SEFLG_SWIEPH:
791 sweph_sbar:
792 /* sweplan() provides barycentric sun as a by-product in save area;
793 * it is saved in swed.pldat[SEI_SUNBARY].x */
794 retc = sweplan(tjd, SEI_EARTH, SEI_FILE_PLANET, iflag, DO_SAVE, NULL, NULL, NULL, NULL, serr);
795 #if 1
796 if (retc == ERR || retc == NOT_AVAILABLE)
797 goto return_error;
798 #else /* this code would be needed if barycentric moshier calculation
799 * were implemented */
800 if (retc == ERR)
801 goto return_error;
802 /* if sweph file not found, switch to moshier */
803 if (retc == NOT_AVAILABLE) {
804 if (tjd > MOSHLUEPH_START && tjd < MOSHLUEPH_END) {
805 iflag = (iflag & ~SEFLG_SWIEPH) | SEFLG_MOSEPH;
806 if (serr != NULL && strlen(serr) + 30 < AS_MAXCH)
807 strcat(serr, " \nusing Moshier; ");
808 goto moshier_sbar;
809 } else
810 goto return_error;
811 }
812 #endif
813 psdp->teval = tjd;
814 /* pedp->teval = tjd; */
815 break;
816 default:
817 #if 0
818 moshier_sbar:
819 #endif
820 return ERR;
821 break;
822 }
823 /* flags */
824 if ((retc = app_pos_etc_sbar(iflag, serr)) != OK)
825 goto return_error;
826 /* iflag has possibly changed */
827 iflag = pedp->xflgs;
828 /* barycentric sun is now in save area of barycentric earth.
829 * (pedp->xreturn = swed.pldat[SEI_EARTH].xreturn).
830 * in case a barycentric earth computation follows for the same
831 * date, the planetary functions will return the barycentric
832 * SUN unless we force a new computation of pedp->xreturn.
833 * this can be done by initializing the save of iflag.
834 */
835 pedp->xflgs = -1;
836 /******************************************
837 * mercury - pluto *
838 ******************************************/
839 } else if (ipl == SE_SUN /* main planet */
840 || ipl == SE_MERCURY
841 || ipl == SE_VENUS
842 || ipl == SE_MARS
843 || ipl == SE_JUPITER
844 || ipl == SE_SATURN
845 || ipl == SE_URANUS
846 || ipl == SE_NEPTUNE
847 || ipl == SE_PLUTO
848 || ipl == SE_EARTH) {
849 if (iflag & SEFLG_HELCTR) {
850 if (ipl == SE_SUN) {
851 /* heliocentric position of Sun does not exist */
852 for (i = 0; i < 24; i++)
853 x[i] = 0;
854 return iflag;
855 }
856 } else if (iflag & SEFLG_BARYCTR) {
857 ;
858 } else { /* geocentric */
859 if (ipl == SE_EARTH) {
860 /* geocentric position of Earth does not exist */
861 for (i = 0; i < 24; i++)
862 x[i] = 0;
863 return iflag;
864 }
865 }
866 /* internal planet number */
867 ipli = pnoext2int[ipl];
868 pdp = &swed.pldat[ipli];
869 xp = pdp->xreturn;
870 retc = main_planet(tjd, ipli, iplmoon, epheflag, iflag, serr);
871 if (retc == ERR)
872 goto return_error;
873 /* iflag has possibly changed in main_planet() */
874 iflag = pdp->xflgs;
875 /*********************i************************
876 * mean lunar node *
877 * for comment s. moshmoon.c, swi_mean_node() *
878 **********************************************/
879 } else if (ipl == SE_MEAN_NODE) {
880 if ((iflag & SEFLG_HELCTR) || (iflag & SEFLG_BARYCTR)) {
881 /* heliocentric/barycentric lunar node not allowed */
882 for (i = 0; i < 24; i++)
883 x[i] = 0;
884 return iflag;
885 }
886 ndp = &swed.nddat[SEI_MEAN_NODE];
887 xp = ndp->xreturn;
888 xp2 = ndp->x;
889 retc = swi_mean_node(tjd, xp2, serr);
890 if (retc == ERR)
891 goto return_error;
892 /* speed (is almost constant; variation < 0.001 arcsec) */
893 retc = swi_mean_node(tjd - MEAN_NODE_SPEED_INTV, xp2+3, serr);
894 if (retc == ERR)
895 goto return_error;
896 xp2[3] = swe_difrad2n(xp2[0], xp2[3]) / MEAN_NODE_SPEED_INTV;
897 xp2[4] = xp2[5] = 0;
898 ndp->teval = tjd;
899 ndp->xflgs = -1;
900 /* lighttime etc. */
901 if ((retc = app_pos_etc_mean(SEI_MEAN_NODE, iflag, serr)) != OK)
902 goto return_error;
903 /* to avoid infinitesimal deviations from latitude = 0
904 * that result from conversions */
905 if (!(iflag & SEFLG_SIDEREAL) && !(iflag & SEFLG_J2000)) {
906 ndp->xreturn[1] = 0.0; /* ecl. latitude */
907 ndp->xreturn[4] = 0.0; /* speed */
908 ndp->xreturn[5] = 0.0; /* radial speed */
909 ndp->xreturn[8] = 0.0; /* z coordinate */
910 ndp->xreturn[11] = 0.0; /* speed */
911 }
912 if (retc == ERR)
913 goto return_error;
914 /**********************************************
915 * mean lunar apogee ('dark moon', 'lilith') *
916 * for comment s. moshmoon.c, swi_mean_apog() *
917 **********************************************/
918 } else if (ipl == SE_MEAN_APOG) {
919 if ((iflag & SEFLG_HELCTR) || (iflag & SEFLG_BARYCTR)) {
920 /* heliocentric/barycentric lunar apogee not allowed */
921 for (i = 0; i < 24; i++)
922 x[i] = 0;
923 return iflag;
924 }
925 ndp = &swed.nddat[SEI_MEAN_APOG];
926 xp = ndp->xreturn;
927 xp2 = ndp->x;
928 retc = swi_mean_apog(tjd, xp2, serr);
929 if (retc == ERR)
930 goto return_error;
931 /* speed (is not constant! variation ~= several arcsec) */
932 retc = swi_mean_apog(tjd - MEAN_NODE_SPEED_INTV, xp2+3, serr);
933 if (retc == ERR)
934 goto return_error;
935 for(i = 0; i <= 1; i++)
936 xp2[3+i] = swe_difrad2n(xp2[i], xp2[3+i]) / MEAN_NODE_SPEED_INTV;
937 xp2[5] = 0;
938 ndp->teval = tjd;
939 ndp->xflgs = -1;
940 /* lighttime etc. */
941 if ((retc = app_pos_etc_mean(SEI_MEAN_APOG, iflag, serr)) != OK)
942 goto return_error;
943 /* to avoid infinitesimal deviations from r-speed = 0
944 * that result from conversions */
945 ndp->xreturn[5] = 0.0; /* speed */
946 if (retc == ERR)
947 goto return_error;
948 /***********************************************
949 * osculating lunar node ('true node') *
950 ***********************************************/
951 } else if (ipl == SE_TRUE_NODE) {
952 if ((iflag & SEFLG_HELCTR) || (iflag & SEFLG_BARYCTR)) {
953 /* heliocentric/barycentric lunar node not allowed */
954 for (i = 0; i < 24; i++)
955 x[i] = 0;
956 return iflag;
957 }
958 ndp = &swed.nddat[SEI_TRUE_NODE];
959 xp = ndp->xreturn;
960 retc = lunar_osc_elem(tjd, SEI_TRUE_NODE, iflag, serr);
961 iflag = ndp->xflgs;
962 /* to avoid infinitesimal deviations from latitude = 0
963 * that result from conversions */
964 if (!(iflag & SEFLG_SIDEREAL) && !(iflag & SEFLG_J2000)) {
965 ndp->xreturn[1] = 0.0; /* ecl. latitude */
966 ndp->xreturn[4] = 0.0; /* speed */
967 ndp->xreturn[8] = 0.0; /* z coordinate */
968 ndp->xreturn[11] = 0.0; /* speed */
969 }
970 if (retc == ERR)
971 goto return_error;
972 /***********************************************
973 * osculating lunar apogee *
974 ***********************************************/
975 } else if (ipl == SE_OSCU_APOG) {
976 if ((iflag & SEFLG_HELCTR) || (iflag & SEFLG_BARYCTR)) {
977 /* heliocentric/barycentric lunar apogee not allowed */
978 for (i = 0; i < 24; i++)
979 x[i] = 0;
980 return iflag;
981 }
982 ndp = &swed.nddat[SEI_OSCU_APOG];
983 xp = ndp->xreturn;
984 retc = lunar_osc_elem(tjd, SEI_OSCU_APOG, iflag, serr);
985 iflag = ndp->xflgs;
986 if (retc == ERR)
987 goto return_error;
988 /***********************************************
989 * interpolated lunar apogee *
990 ***********************************************/
991 } else if (ipl == SE_INTP_APOG) {
992 if ((iflag & SEFLG_HELCTR) || (iflag & SEFLG_BARYCTR)) {
993 /* heliocentric/barycentric lunar apogee not allowed */
994 for (i = 0; i < 24; i++)
995 x[i] = 0;
996 return iflag;
997 }
998 if (tjd < MOSHLUEPH_START || tjd > MOSHLUEPH_END) {
999 for (i = 0; i < 24; i++)
1000 x[i] = 0;
1001 if (serr != NULL)
1002 sprintf(serr, "Interpolated apsides are restricted to JD %8.1f - JD %8.1f",
1003 MOSHLUEPH_START, MOSHLUEPH_END);
1004 return ERR;
1005 }
1006 ndp = &swed.nddat[SEI_INTP_APOG];
1007 xp = ndp->xreturn;
1008 retc = intp_apsides(tjd, SEI_INTP_APOG, iflag, serr);
1009 iflag = ndp->xflgs;
1010 if (retc == ERR)
1011 goto return_error;
1012 /***********************************************
1013 * interpolated lunar perigee *
1014 ***********************************************/
1015 } else if (ipl == SE_INTP_PERG) {
1016 if ((iflag & SEFLG_HELCTR) || (iflag & SEFLG_BARYCTR)) {
1017 /* heliocentric/barycentric lunar apogee not allowed */
1018 for (i = 0; i < 24; i++)
1019 x[i] = 0;
1020 return iflag;
1021 }
1022 if (tjd < MOSHLUEPH_START || tjd > MOSHLUEPH_END) {
1023 for (i = 0; i < 24; i++)
1024 x[i] = 0;
1025 if (serr != NULL)
1026 sprintf(serr, "Interpolated apsides are restricted to JD %8.1f - JD %8.1f",
1027 MOSHLUEPH_START, MOSHLUEPH_END);
1028 return ERR;
1029 }
1030 ndp = &swed.nddat[SEI_INTP_PERG];
1031 xp = ndp->xreturn;
1032 retc = intp_apsides(tjd, SEI_INTP_PERG, iflag, serr);
1033 iflag = ndp->xflgs;
1034 if (retc == ERR)
1035 goto return_error;
1036 /***********************************************
1037 * minor planets *
1038 ***********************************************/
1039 } else if (ipl == SE_CHIRON
1040 || ipl == SE_PHOLUS
1041 || ipl == SE_CERES /* Ceres - Vesta */
1042 || ipl == SE_PALLAS
1043 || ipl == SE_JUNO
1044 || ipl == SE_VESTA
1045 || ipl > SE_PLMOON_OFFSET
1046 || ipl > SE_AST_OFFSET // obsolete after previous condition
1047 ) {
1048 /* internal planet number */
1049 if (ipl < SE_NPLANETS)
1050 ipli = pnoext2int[ipl];
1051 else if (ipl <= SE_AST_OFFSET + MPC_VESTA && ipl > SE_AST_OFFSET) {
1052 ipli = SEI_CERES + ipl - SE_AST_OFFSET - 1;
1053 ipl = SE_CERES + ipl - SE_AST_OFFSET - 1;
1054 #if 0
1055 } else if (ipl == SE_AST_OFFSET + MPC_CHIRON) {
1056 ipli = SEI_CHIRON;
1057 ipl = SE_CHIRON;
1058 } else if (ipl == SE_AST_OFFSET + MPC_PHOLUS) {
1059 ipli = SEI_PHOLUS;
1060 ipl = SE_PHOLUS;
1061 #endif
1062 } else { /* any asteroid except*/
1063 ipli = SEI_ANYBODY;
1064 }
1065 if (ipli == SEI_ANYBODY)
1066 ipli_ast = ipl;
1067 else
1068 ipli_ast = ipli;
1069 pdp = &swed.pldat[ipli];
1070 xp = pdp->xreturn;
1071 if (ipli_ast > SE_AST_OFFSET)
1072 ifno = SEI_FILE_ANY_AST;
1073 else if (ipli_ast > SE_PLMOON_OFFSET)
1074 ifno = SEI_FILE_ANY_AST;
1075 else
1076 ifno = SEI_FILE_MAIN_AST;
1077 if (ipli == SEI_CHIRON && (tjd < CHIRON_START || tjd > CHIRON_END)) {
1078 if (serr != NULL)
1079 sprintf(serr, "Chiron's ephemeris is restricted to JD %8.1f - JD %8.1f",
1080 CHIRON_START, CHIRON_END);
1081 return ERR;
1082 }
1083 if (ipli == SEI_PHOLUS && (tjd < PHOLUS_START || tjd > PHOLUS_END)) {
1084 if (serr != NULL)
1085 sprintf(serr,
1086 "Pholus's ephemeris is restricted to JD %8.1f - JD %8.1f",
1087 PHOLUS_START, PHOLUS_END);
1088 return ERR;
1089 }
1090 do_asteroid:
1091 /* earth and sun are also needed */
1092 retc = main_planet(tjd, SEI_EARTH, 0, epheflag, iflag, serr);
1093 if (retc == ERR)
1094 goto return_error;
1095 /* iflag (ephemeris bit) has possibly changed in main_planet() */
1096 iflag = swed.pldat[SEI_EARTH].xflgs;
1097 /* asteroid */
1098 if (serr != NULL) {
1099 strcpy(serr2, serr);
1100 *serr = '\0';
1101 }
1102 /* asteroid */
1103 retc = sweph(tjd, ipli_ast, ifno, iflag, psdp->x, DO_SAVE, NULL, serr);
1104 if (retc == ERR || retc == NOT_AVAILABLE)
1105 goto return_error;
1106 retc = app_pos_etc_plan(ipli_ast, 0, iflag, serr);
1107 if (retc == ERR)
1108 goto return_error;
1109 /* app_pos_etc_plan() might have failed, if t(light-time)
1110 * is beyond ephemeris range. in this case redo with Moshier
1111 */
1112 if (retc == NOT_AVAILABLE || retc == BEYOND_EPH_LIMITS) {
1113 if (epheflag != SEFLG_MOSEPH) {
1114 iflag = (iflag & ~SEFLG_EPHMASK) | SEFLG_MOSEPH;
1115 epheflag = SEFLG_MOSEPH;
1116 if (serr != NULL && strlen(serr) + 30 < AS_MAXCH)
1117 strcat(serr, "\nusing Moshier eph.; ");
1118 goto do_asteroid;
1119 } else
1120 goto return_error;
1121 }
1122 /* add warnings from earth/sun computation */
1123 if (serr != NULL && *serr == '\0' && *serr2 != '\0') {
1124 strcpy(serr, "sun: ");
1125 serr2[AS_MAXCH-5] = '\0';
1126 strcat(serr, serr2);
1127 }
1128 /***********************************************
1129 * fictitious planets *
1130 * (Isis-Transpluto and Uranian planets) *
1131 ***********************************************/
1132 } else if (ipl >= SE_FICT_OFFSET && ipl <= SE_FICT_MAX) {
1133 #if 0
1134 ipl == SE_CUPIDO
1135 || ipl == SE_HADES
1136 || ipl == SE_ZEUS
1137 || ipl == SE_KRONOS
1138 || ipl == SE_APOLLON
1139 || ipl == SE_ADMETOS
1140 || ipl == SE_VULKANUS
1141 || ipl == SE_POSEIDON
1142 || ipl == SE_ISIS
1143 || ipl == SE_NEPTUNE_LEVERRIER
1144 || ipl == SE_NEPTUNE_ADAMS)
1145 #endif
1146 /* internal planet number */
1147 ipli = SEI_ANYBODY;
1148 pdp = &swed.pldat[ipli];
1149 xp = pdp->xreturn;
1150 do_fict_plan:
1151 /* the earth for geocentric position */
1152 retc = main_planet(tjd, SEI_EARTH, 0, epheflag, iflag, serr);
1153 /* iflag (ephemeris bit) has possibly changed in main_planet() */
1154 iflag = swed.pldat[SEI_EARTH].xflgs;
1155 /* planet from osculating elements */
1156 if (swi_osc_el_plan(tjd, pdp->x, ipl-SE_FICT_OFFSET, ipli, pedp->x, psdp->x, serr) != OK)
1157 goto return_error;
1158 if (retc == ERR)
1159 goto return_error;
1160 retc = app_pos_etc_plan_osc(ipl, ipli, iflag, serr);
1161 if (retc == ERR)
1162 goto return_error;
1163 /* app_pos_etc_plan_osc() might have failed, if t(light-time)
1164 * is beyond ephemeris range. in this case redo with Moshier
1165 */
1166 if (retc == NOT_AVAILABLE || retc == BEYOND_EPH_LIMITS) {
1167 if (epheflag != SEFLG_MOSEPH) {
1168 iflag = (iflag & ~SEFLG_EPHMASK) | SEFLG_MOSEPH;
1169 epheflag = SEFLG_MOSEPH;
1170 if (serr != NULL && strlen(serr) + 30 < AS_MAXCH)
1171 strcat(serr, "\nusing Moshier eph.; ");
1172 goto do_fict_plan;
1173 } else
1174 goto return_error;
1175 }
1176 /***********************************************
1177 * invalid body number *
1178 ***********************************************/
1179 } else {
1180 if (serr != NULL) {
1181 sprintf(serr, "illegal planet number %d.", ipl);
1182 }
1183 goto return_error;
1184 }
1185 for (i = 0; i < 24; i++)
1186 x[i] = xp[i];
1187 return(iflag);
1188 /***********************************************
1189 * return error *
1190 ***********************************************/
1191 return_error:;
1192 for (i = 0; i < 24; i++)
1193 x[i] = 0;
1194 return ERR;
1195 }
1196
free_planets(void)1197 static void free_planets(void)
1198 {
1199 int i;
1200 /* free planets data space */
1201 for (i = 0; i < SEI_NPLANETS; i++) {
1202 if (swed.pldat[i].segp != NULL) {
1203 free((void *) swed.pldat[i].segp);
1204 }
1205 if (swed.pldat[i].refep != NULL) {
1206 free((void *) swed.pldat[i].refep);
1207 }
1208 memset((void *) &swed.pldat[i], 0, sizeof(struct plan_data));
1209 }
1210 for (i = 0; i <= SE_NPLANETS; i++) /* "<=" is correct! see decl. */
1211 memset((void *) &swed.savedat[i], 0, sizeof(struct save_positions));
1212 /* clear node data space */
1213 for (i = 0; i < SEI_NNODE_ETC; i++) {
1214 #if 0
1215 memset((void *) &swed.nddat[i], 0, sizeof(struct node_data));
1216 #else
1217 memset((void *) &swed.nddat[i], 0, sizeof(struct plan_data));
1218 #endif
1219 }
1220 }
1221
1222 /* Function initialises swed structure.
1223 * Returns 1 if initialisation is done, otherwise 0 */
swi_init_swed_if_start(void)1224 int32 swi_init_swed_if_start(void)
1225 {
1226 /* initialisation of swed, when called first time from */
1227 if (!swed.swed_is_initialised) {
1228 memset((void *) &swed, 0, sizeof(struct swe_data));
1229 strcpy(swed.ephepath, SE_EPHE_PATH);
1230 strcpy(swed.jplfnam, SE_FNAME_DFT);
1231 swe_set_tid_acc(SE_TIDAL_AUTOMATIC);
1232 swed.swed_is_initialised = TRUE;
1233 return 1;
1234 }
1235 return 0;
1236 }
1237
1238 /* closes all open files, frees space of planetary data,
1239 * deletes memory of all computed positions
1240 */
swi_close_keep_topo_etc(void)1241 static void swi_close_keep_topo_etc(void)
1242 {
1243 int i;
1244 /* close SWISSEPH files */
1245 for (i = 0; i < SEI_NEPHFILES; i ++) {
1246 if (swed.fidat[i].fptr != NULL)
1247 fclose(swed.fidat[i].fptr);
1248 memset((void *) &swed.fidat[i], 0, sizeof(struct file_data));
1249 }
1250 free_planets();
1251 memset((void *) &swed.oec, 0, sizeof(struct epsilon));
1252 memset((void *) &swed.oec2000, 0, sizeof(struct epsilon));
1253 memset((void *) &swed.nut, 0, sizeof(struct nut));
1254 memset((void *) &swed.nut2000, 0, sizeof(struct nut));
1255 memset((void *) &swed.nutv, 0, sizeof(struct nut));
1256 memset((void *) &swed.astro_models, 0, SEI_NMODELS * sizeof(int32));
1257 /* close JPL file */
1258 swi_close_jpl_file();
1259 swed.jpl_file_is_open = FALSE;
1260 swed.jpldenum = 0;
1261 /* close fixed stars */
1262 if (swed.fixfp != NULL) {
1263 fclose(swed.fixfp);
1264 swed.fixfp = NULL;
1265 }
1266 swe_set_tid_acc(SE_TIDAL_AUTOMATIC);
1267 swed.is_old_starfile = FALSE;
1268 swed.i_saved_planet_name = 0;
1269 *(swed.saved_planet_name) = '\0';
1270 swed.timeout = 0;
1271 }
1272
1273 /* closes all open files, frees space of planetary data,
1274 * deletes memory of all computed positions
1275 */
swe_close(void)1276 void CALL_CONV swe_close(void)
1277 {
1278 int i;
1279 /* close SWISSEPH files */
1280 for (i = 0; i < SEI_NEPHFILES; i ++) {
1281 if (swed.fidat[i].fptr != NULL)
1282 fclose(swed.fidat[i].fptr);
1283 memset((void *) &swed.fidat[i], 0, sizeof(struct file_data));
1284 }
1285 free_planets();
1286 memset((void *) &swed.oec, 0, sizeof(struct epsilon));
1287 memset((void *) &swed.oec2000, 0, sizeof(struct epsilon));
1288 memset((void *) &swed.nut, 0, sizeof(struct nut));
1289 memset((void *) &swed.nut2000, 0, sizeof(struct nut));
1290 memset((void *) &swed.nutv, 0, sizeof(struct nut));
1291 memset((void *) &swed.astro_models, 0, SEI_NMODELS * sizeof(int32));
1292 /* close JPL file */
1293 swi_close_jpl_file();
1294 swed.jpl_file_is_open = FALSE;
1295 swed.jpldenum = 0;
1296 /* close fixed stars */
1297 if (swed.fixfp != NULL) {
1298 fclose(swed.fixfp);
1299 swed.fixfp = NULL;
1300 }
1301 swe_set_tid_acc(SE_TIDAL_AUTOMATIC);
1302 swed.geopos_is_set = FALSE;
1303 swed.ayana_is_set = FALSE;
1304 swed.is_old_starfile = FALSE;
1305 swed.i_saved_planet_name = 0;
1306 *(swed.saved_planet_name) = '\0';
1307 memset((void *) &swed.topd, 0, sizeof(struct topo_data));
1308 memset((void *) &swed.sidd, 0, sizeof(struct sid_data));
1309 swed.timeout = 0;
1310 swed.last_epheflag = 0;
1311 if (swed.dpsi != NULL) {
1312 free(swed.dpsi);
1313 swed.dpsi = NULL;
1314 }
1315 if (swed.deps != NULL) {
1316 free(swed.deps);
1317 swed.deps = NULL;
1318 }
1319 if (swed.n_fixstars_records > 0) {
1320 free(swed.fixed_stars);
1321 swed.fixed_stars = NULL;
1322 swed.n_fixstars_real = 0;
1323 swed.n_fixstars_named = 0;
1324 swed.n_fixstars_records = 0;
1325 }
1326 /* swed.ephe_path_is_set = FALSE;
1327 *swed.ephepath = '\0'; */
1328 #ifdef TRACE
1329 #define TRACE_CLOSE FALSE
1330 swi_open_trace(NULL);
1331 if (swi_fp_trace_c != NULL) {
1332 if (swi_trace_count < TRACE_COUNT_MAX) {
1333 fputs("\n/*SWE_CLOSE*/\n", swi_fp_trace_c);
1334 fputs(" swe_close();\n", swi_fp_trace_c);
1335 #if TRACE_CLOSE
1336 fputs("}\n", swi_fp_trace_c);
1337 #endif
1338 fflush(swi_fp_trace_c);
1339 }
1340 #if TRACE_CLOSE
1341 fclose(swi_fp_trace_c);
1342 #endif
1343 }
1344 #if TRACE_CLOSE
1345 if (swi_fp_trace_out != NULL)
1346 fclose(swi_fp_trace_out);
1347 swi_fp_trace_c = NULL;
1348 swi_fp_trace_out = NULL;
1349 #endif
1350 #endif /* TRACE */
1351 }
1352
1353 /* sets ephemeris file path.
1354 * also calls swe_close(). this makes sure that swe_calc()
1355 * won't return planet positions previously computed from other
1356 * ephemerides
1357 */
swe_set_ephe_path(char * path)1358 void CALL_CONV swe_set_ephe_path(char *path)
1359 {
1360 int i, iflag;
1361 char s[AS_MAXCH];
1362 char *sp;
1363 double xx[6];
1364 /* close all open files and delete all planetary data */
1365 swi_close_keep_topo_etc();
1366 swi_init_swed_if_start();
1367 swed.ephe_path_is_set = TRUE;
1368 /* environment variable SE_EPHE_PATH has priority */
1369 if ((sp = getenv("SE_EPHE_PATH")) != NULL
1370 && strlen(sp) != 0
1371 && strlen(sp) <= AS_MAXCH-1-13) {
1372 strcpy(s, sp);
1373 } else if (path == NULL || *path == '\0') {
1374 strcpy(s, SE_EPHE_PATH);
1375 } else if (strlen(path) <= AS_MAXCH-1-13) {
1376 strcpy(s, path);
1377 } else {
1378 strcpy(s, SE_EPHE_PATH);
1379 }
1380 /*
1381 #if MSDOS
1382 if (strchr(s, '/') != NULL)
1383 strcpy(s, SE_EPHE_PATH);
1384 #else
1385 if (strchr(s, '\\') != NULL)
1386 strcpy(s, SE_EPHE_PATH);
1387 #endif
1388 */
1389 i = (int) strlen(s);
1390 if (*(s + i - 1) != *DIR_GLUE && *s != '\0')
1391 strcat(s, DIR_GLUE);
1392 strcpy(swed.ephepath, s);
1393 //swe_set_interpolate_nut(TRUE);
1394 /* try to open lunar ephemeris, in order to get DE number and set
1395 * tidal acceleration of the Moon */
1396 iflag = SEFLG_SWIEPH|SEFLG_J2000|SEFLG_TRUEPOS|SEFLG_ICRS;
1397 swed.last_epheflag = 2;
1398 swe_calc(J2000, SE_MOON, iflag, xx, NULL);
1399 if (swed.fidat[SEI_FILE_MOON].fptr != NULL) {
1400 swi_set_tid_acc(0, 0, swed.fidat[SEI_FILE_MOON].sweph_denum, NULL);
1401 }
1402 #ifdef TRACE
1403 swi_open_trace(NULL);
1404 if (swi_trace_count < TRACE_COUNT_MAX) {
1405 if (swi_fp_trace_c != NULL) {
1406 fputs("\n/*SWE_SET_EPHE_PATH*/\n", swi_fp_trace_c);
1407 if (path == NULL)
1408 fputs(" *s = '\\0';\n", swi_fp_trace_c);
1409 else
1410 fprintf(swi_fp_trace_c, " strcpy(s, \"%s\");\n", path);
1411 fputs(" swe_set_ephe_path(s);\n", swi_fp_trace_c);
1412 fputs(" printf(\"swe_set_ephe_path: path_in = \");", swi_fp_trace_c);
1413 fputs(" printf(s);\n", swi_fp_trace_c);
1414 fputs(" \tprintf(\"\\tpath_set = unknown to swetrace\\n\"); /* unknown to swetrace */\n", swi_fp_trace_c);
1415 fflush(swi_fp_trace_c);
1416 }
1417 if (swi_fp_trace_out != NULL) {
1418 fputs("swe_set_ephe_path: path_in = ", swi_fp_trace_out);
1419 if (path != NULL)
1420 fputs(path, swi_fp_trace_out);
1421 fputs("\tpath_set = ", swi_fp_trace_out);
1422 fputs(s, swi_fp_trace_out);
1423 fputs("\n", swi_fp_trace_out);
1424 fflush(swi_fp_trace_out);
1425 }
1426 }
1427 #endif
1428 }
1429
load_dpsi_deps(void)1430 void load_dpsi_deps(void)
1431 {
1432 FILE *fp;
1433 char s[AS_MAXCH];
1434 char *cpos[20];
1435 int n = 0, iyear, mjd = 0, mjdsv = 0;
1436 double dpsi, deps, TJDOFS = 2400000.5;
1437 if (swed.eop_dpsi_loaded > 0)
1438 return;
1439 fp = swi_fopen(-1, DPSI_DEPS_IAU1980_FILE_EOPC04, swed.ephepath, NULL);
1440 if (fp == NULL) {
1441 swed.eop_dpsi_loaded = ERR;
1442 return;
1443 }
1444 if ((swed.dpsi = (double *) calloc((size_t) SWE_DATA_DPSI_DEPS, sizeof(double))) == NULL) {
1445 swed.eop_dpsi_loaded = ERR;
1446 return;
1447 }
1448 if ((swed.deps = (double *) calloc((size_t) SWE_DATA_DPSI_DEPS, sizeof(double))) == NULL) {
1449 swed.eop_dpsi_loaded = ERR;
1450 return;
1451 }
1452 swed.eop_tjd_beg_horizons = DPSI_DEPS_IAU1980_TJD0_HORIZONS;
1453 while (fgets(s, AS_MAXCH, fp) != NULL) {
1454 swi_cutstr(s, " ", cpos, 16);
1455 if ((iyear = atoi(cpos[0])) == 0)
1456 continue;
1457 mjd = atoi(cpos[3]);
1458 /* is file in one-day steps? */
1459 if (mjdsv > 0 && mjd - mjdsv != 1) {
1460 /* we cannot return error but we note it as follows: */
1461 swed.eop_dpsi_loaded = -2;
1462 fclose(fp);
1463 return;
1464 }
1465 if (n == 0)
1466 swed.eop_tjd_beg = mjd + TJDOFS;
1467 swed.dpsi[n] = atof(cpos[8]);
1468 swed.deps[n] = atof(cpos[9]);
1469 /* fprintf(stderr, "n=%d, tjd=%f, dpsi=%f, deps=%f\n", n, mjd + 2400000.5, swed.dpsi[n] * 1000, swed.deps[n] * 1000);exit(0);*/
1470 n++;
1471 mjdsv = mjd;
1472 }
1473 swed.eop_tjd_end = mjd + TJDOFS;
1474 swed.eop_dpsi_loaded = 1;
1475 fclose(fp);
1476 /* file finals.all may have some more data, and especially estimations
1477 * for the near future */
1478 fp = swi_fopen(-1, DPSI_DEPS_IAU1980_FILE_FINALS, swed.ephepath, NULL);
1479 if (fp == NULL)
1480 return; /* return without error as existence of file is not mandatory */
1481 while (fgets(s, AS_MAXCH, fp) != NULL) {
1482 mjd = atoi(s + 7);
1483 if (mjd + TJDOFS <= swed.eop_tjd_end)
1484 continue;
1485 if (n >= SWE_DATA_DPSI_DEPS)
1486 return;
1487 /* are data in one-day steps? */
1488 if (mjdsv > 0 && mjd - mjdsv != 1) {
1489 /* no error, as we do have data; however, if this file is usefull,
1490 * then swed.eop_dpsi_loaded will be set to 2 */
1491 swed.eop_dpsi_loaded = -3;
1492 fclose(fp);
1493 return;
1494 }
1495 /* dpsi, deps Bulletin B */
1496 dpsi = atof(s + 168);
1497 deps = atof(s + 178);
1498 if (dpsi == 0) {
1499 /* try dpsi, deps Bulletin A */
1500 dpsi = atof(s + 99);
1501 deps = atof(s + 118);
1502 }
1503 if (dpsi == 0) {
1504 swed.eop_dpsi_loaded = 2;
1505 /*printf("dpsi from %f to %f \n", swed.eop_tjd_beg, swed.eop_tjd_end);*/
1506 fclose(fp);
1507 return;
1508 }
1509 swed.eop_tjd_end = mjd + TJDOFS;
1510 swed.dpsi[n] = dpsi / 1000.0;
1511 swed.deps[n] = deps / 1000.0;
1512 /*fprintf(stderr, "tjd=%f, dpsi=%f, deps=%f\n", mjd + 2400000.5, swed.dpsi[n] * 1000, swed.deps[n] * 1000);*/
1513 n++;
1514 mjdsv = mjd;
1515 }
1516 swed.eop_dpsi_loaded = 2;
1517 fclose(fp);
1518 }
1519
1520 /* sets jpl file name.
1521 * also calls swe_close(). this makes sure that swe_calc()
1522 * won't return planet positions previously computed from other
1523 * ephemerides
1524 */
swe_set_jpl_file(char * fname)1525 void CALL_CONV swe_set_jpl_file(char *fname)
1526 {
1527 char *sp;
1528 int retc;
1529 double ss[3];
1530 /* close all open files and delete all planetary data */
1531 swi_close_keep_topo_etc();
1532 swi_init_swed_if_start();
1533 /* if path is contained in fnam, it is filled into the path variable */
1534 sp = strrchr(fname, (int) *DIR_GLUE);
1535 if (sp == NULL)
1536 sp = fname;
1537 else
1538 sp = sp + 1;
1539 if (strlen(sp) >= AS_MAXCH)
1540 sp[AS_MAXCH] = '\0';
1541 strcpy(swed.jplfnam, sp);
1542 /* open ephemeris */
1543 retc = open_jpl_file(ss, swed.jplfnam, swed.ephepath, NULL);
1544 if (retc == OK) {
1545 if (swed.jpldenum >= 403) {
1546 /*if (INCLUDE_CODE_FOR_DPSI_DEPS_IAU1980) */
1547 load_dpsi_deps();
1548 }
1549 }
1550 #ifdef TRACE
1551 swi_open_trace(NULL);
1552 if (swi_trace_count < TRACE_COUNT_MAX) {
1553 if (swi_fp_trace_c != NULL) {
1554 fputs("\n/*SWE_SET_JPL_FILE*/\n", swi_fp_trace_c);
1555 fprintf(swi_fp_trace_c, " strcpy(s, \"%s\");\n", fname);
1556 fputs(" swe_set_jpl_file(s);\n", swi_fp_trace_c);
1557 fputs(" printf(\"swe_set_jpl_file: fname_in = \");", swi_fp_trace_c);
1558 fputs(" printf(s);\n", swi_fp_trace_c);
1559 fputs(" printf(\"\\tfname_set = unknown to swetrace\\n\"); /* unknown to swetrace */\n", swi_fp_trace_c);
1560 fflush(swi_fp_trace_c);
1561 }
1562 if (swi_fp_trace_out != NULL) {
1563 fputs("swe_set_jpl_file: fname_in = ", swi_fp_trace_out);
1564 fputs(fname, swi_fp_trace_out);
1565 fputs("\tfname_set = ", swi_fp_trace_out);
1566 fputs(sp, swi_fp_trace_out);
1567 fputs("\n", swi_fp_trace_out);
1568 fflush(swi_fp_trace_out);
1569 }
1570 }
1571 #endif
1572 }
1573
1574 /* calculates obliquity of ecliptic and stores it together
1575 * with its date, sine, and cosine
1576 */
calc_epsilon(double tjd,int32 iflag,struct epsilon * e)1577 static void calc_epsilon(double tjd, int32 iflag, struct epsilon *e)
1578 {
1579 e->teps = tjd;
1580 e->eps = swi_epsiln(tjd, iflag);
1581 e->seps = sin(e->eps);
1582 e->ceps = cos(e->eps);
1583 }
1584
1585 /* computes a main planet from any ephemeris, if it
1586 * has not yet been computed for this date.
1587 * since a geocentric position requires the earth, the
1588 * earth's position will be computed as well. With SWISSEPH
1589 * files the barycentric sun will be done as well.
1590 * With Moshier, the moon will be done as well.
1591 *
1592 * tjd = julian day
1593 * ipli = body number
1594 * epheflag = which ephemeris? JPL, SWISSEPH, Moshier?
1595 * iflag = other flags
1596 *
1597 * the geocentric apparent position of ipli (or whatever has
1598 * been specified in iflag) will be saved in
1599 * &swed.pldat[ipli].xreturn[];
1600 *
1601 * the barycentric (heliocentric with Moshier) position J2000
1602 * will be kept in
1603 * &swed.pldat[ipli].x[];
1604 */
main_planet(double tjd,int ipli,int iplmoon,int32 epheflag,int32 iflag,char * serr)1605 static int main_planet(double tjd, int ipli, int iplmoon, int32 epheflag, int32 iflag,
1606 char *serr)
1607 {
1608 int retc;
1609 if ((iflag & SEFLG_CENTER_BODY)
1610 && ipli >= SE_MARS && ipli <= SE_PLUTO) {
1611 //ipli_com = ipli * 100 + 9099;
1612 /* jupiter center of body, relative to jupiter barycenter */
1613 retc = sweph(tjd, iplmoon, SEI_FILE_ANY_AST, iflag, NULL, DO_SAVE, NULL, serr);
1614 if (retc == ERR || retc == NOT_AVAILABLE)
1615 return ERR;
1616 }
1617 switch(epheflag) {
1618 case SEFLG_JPLEPH:
1619 retc = jplplan(tjd, ipli, iflag, DO_SAVE, NULL, NULL, NULL, serr);
1620 /* read error or corrupt file */
1621 if (retc == ERR)
1622 return ERR;
1623 /* jpl ephemeris not on disk or date beyond ephemeris range */
1624 if (retc == NOT_AVAILABLE) {
1625 iflag = (iflag & ~SEFLG_JPLEPH) | SEFLG_SWIEPH;
1626 if (serr != NULL && strlen(serr) + 30 < AS_MAXCH)
1627 strcat(serr, " \ntrying Swiss Eph; ");
1628 goto sweph_planet;
1629 } else if (retc == BEYOND_EPH_LIMITS) {
1630 if (tjd > MOSHPLEPH_START && tjd < MOSHPLEPH_END) {
1631 iflag = (iflag & ~SEFLG_JPLEPH) | SEFLG_MOSEPH;
1632 if (serr != NULL && strlen(serr) + 30 < AS_MAXCH)
1633 strcat(serr, " \nusing Moshier Eph; ");
1634 goto moshier_planet;
1635 } else {
1636 return ERR;
1637 }
1638 }
1639 /* geocentric, lighttime etc. */
1640 if (ipli == SEI_SUN) {
1641 retc = app_pos_etc_sun(iflag, serr)/**/;
1642 } else {
1643 retc = app_pos_etc_plan(ipli, iplmoon, iflag, serr);
1644 }
1645 if (retc == ERR)
1646 return ERR;
1647 /* t for light-time beyond ephemeris range */
1648 if (retc == NOT_AVAILABLE) {
1649 iflag = (iflag & ~SEFLG_JPLEPH) | SEFLG_SWIEPH;
1650 if (serr != NULL && strlen(serr) + 30 < AS_MAXCH)
1651 strcat(serr, " \ntrying Swiss Eph; ");
1652 goto sweph_planet;
1653 } else if (retc == BEYOND_EPH_LIMITS) {
1654 if (tjd > MOSHPLEPH_START && tjd < MOSHPLEPH_END) {
1655 iflag = (iflag & ~SEFLG_JPLEPH) | SEFLG_MOSEPH;
1656 if (serr != NULL && strlen(serr) + 30 < AS_MAXCH)
1657 strcat(serr, " \nusing Moshier Eph; ");
1658 goto moshier_planet;
1659 } else
1660 return ERR;
1661 }
1662 break;
1663 case SEFLG_SWIEPH:
1664 sweph_planet:
1665 /* compute barycentric planet (+ earth, sun, moon) */
1666 retc = sweplan(tjd, ipli, SEI_FILE_PLANET, iflag, DO_SAVE, NULL, NULL, NULL, NULL, serr);
1667 if (retc == ERR)
1668 return ERR;
1669 /* if sweph file not found, switch to moshier */
1670 if (retc == NOT_AVAILABLE) {
1671 if (tjd > MOSHPLEPH_START && tjd < MOSHPLEPH_END) {
1672 iflag = (iflag & ~SEFLG_SWIEPH) | SEFLG_MOSEPH;
1673 if (serr != NULL && strlen(serr) + 30 < AS_MAXCH)
1674 strcat(serr, " \nusing Moshier eph.; ");
1675 goto moshier_planet;
1676 } else
1677 return ERR;
1678 }
1679 /* geocentric, lighttime etc. */
1680 if (ipli == SEI_SUN)
1681 retc = app_pos_etc_sun(iflag, serr)/**/;
1682 else
1683 retc = app_pos_etc_plan(ipli, iplmoon, iflag, serr);
1684 if (retc == ERR)
1685 return ERR;
1686 /* if sweph file for t(lighttime) not found, switch to moshier */
1687 if (retc == NOT_AVAILABLE) {
1688 if (tjd > MOSHPLEPH_START && tjd < MOSHPLEPH_END) {
1689 iflag = (iflag & ~SEFLG_SWIEPH) | SEFLG_MOSEPH;
1690 if (serr != NULL && strlen(serr) + 30 < AS_MAXCH)
1691 strcat(serr, " \nusing Moshier eph.; ");
1692 goto moshier_planet;
1693 } else
1694 return ERR;
1695 }
1696 break;
1697 case SEFLG_MOSEPH:
1698 moshier_planet:
1699 retc = swi_moshplan(tjd, ipli, DO_SAVE, NULL, NULL, serr);/**/
1700 if (retc == ERR)
1701 return ERR;
1702 /* geocentric, lighttime etc. */
1703 if (ipli == SEI_SUN)
1704 retc = app_pos_etc_sun(iflag, serr)/**/;
1705 else
1706 retc = app_pos_etc_plan(ipli, iplmoon, iflag, serr);
1707 if (retc == ERR)
1708 return ERR;
1709 break;
1710 default:
1711 break;
1712 }
1713 return OK;
1714 }
1715
1716 /* Computes a main planet from any ephemeris or returns
1717 * it again, if it has been computed before.
1718 * In barycentric equatorial position of the J2000 equinox.
1719 * The earth's position is computed as well. With SWISSEPH
1720 * and JPL ephemeris the barycentric sun is computed, too.
1721 * With Moshier, the moon is returned, as well.
1722 *
1723 * tjd = julian day
1724 * ipli = body number
1725 * epheflag = which ephemeris? JPL, SWISSEPH, Moshier?
1726 * iflag = other flags
1727 * xp, xe, xs, and xm are the pointers, where the program
1728 * either finds or stores (if not found) the barycentric
1729 * (heliocentric with Moshier) positions of the following
1730 * bodies:
1731 * xp planet
1732 * xe earth
1733 * xs sun
1734 * xm moon
1735 *
1736 * xm is used with Moshier only
1737 */
main_planet_bary(double tjd,int ipli,int32 epheflag,int32 iflag,AS_BOOL do_save,double * xp,double * xe,double * xs,double * xm,char * serr)1738 static int main_planet_bary(double tjd, int ipli, int32 epheflag, int32 iflag, AS_BOOL do_save,
1739 double *xp, double *xe, double *xs, double *xm,
1740 char *serr)
1741 {
1742 int i, retc;
1743 switch(epheflag) {
1744 case SEFLG_JPLEPH:
1745 retc = jplplan(tjd, ipli, iflag, do_save, xp, xe, xs, serr);
1746 /* read error or corrupt file */
1747 if (retc == ERR || retc == BEYOND_EPH_LIMITS)
1748 return retc;
1749 /* jpl ephemeris not on disk or date beyond ephemeris range */
1750 if (retc == NOT_AVAILABLE) {
1751 iflag = (iflag & ~SEFLG_JPLEPH) | SEFLG_SWIEPH;
1752 if (serr != NULL && strlen(serr) + 30 < AS_MAXCH)
1753 strcat(serr, " \ntrying Swiss Eph; ");
1754 goto sweph_planet;
1755 }
1756 break;
1757 case SEFLG_SWIEPH:
1758 sweph_planet:
1759 /* compute barycentric planet (+ earth, sun, moon) */
1760 retc = sweplan(tjd, ipli, SEI_FILE_PLANET, iflag, do_save, xp, xe, xs, xm, serr);
1761 #if 0
1762 if (retc == ERR || retc == NOT_AVAILABLE)
1763 return retc;
1764 #else /* if barycentric moshier calculation were implemented */
1765 if (retc == ERR)
1766 return ERR;
1767 /* if sweph file not found, switch to moshier */
1768 if (retc == NOT_AVAILABLE) {
1769 if (tjd > MOSHPLEPH_START && tjd < MOSHPLEPH_END) {
1770 iflag = (iflag & ~SEFLG_SWIEPH) | SEFLG_MOSEPH;
1771 if (serr != NULL && strlen(serr) + 30 < AS_MAXCH)
1772 strcat(serr, " \nusing Moshier eph.; ");
1773 goto moshier_planet;
1774 } else {
1775 return ERR;
1776 }
1777 }
1778 #endif
1779 break;
1780 case SEFLG_MOSEPH:
1781 #if 1
1782 moshier_planet:
1783 #endif
1784 retc = swi_moshplan(tjd, ipli, do_save, xp, xe, serr);/**/
1785 if (retc == ERR)
1786 return ERR;
1787 for (i = 0; i <= 5; i++)
1788 xs[i] = 0;
1789 break;
1790 default:
1791 break;
1792 }
1793 return OK;
1794 }
1795
1796 /* SWISSEPH
1797 * this routine computes heliocentric cartesian equatorial coordinates
1798 * of equinox 2000 of
1799 * geocentric moon
1800 *
1801 * tjd julian date
1802 * iflag flag
1803 * do_save save J2000 position in save area pdp->x ?
1804 * xp array of 6 doubles for lunar position and speed
1805 * serr error string
1806 */
swemoon(double tjd,int32 iflag,AS_BOOL do_save,double * xpret,char * serr)1807 static int swemoon(double tjd, int32 iflag, AS_BOOL do_save, double *xpret, char *serr)
1808 {
1809 int i, retc;
1810 struct plan_data *pdp = &swed.pldat[SEI_MOON];
1811 int32 speedf1, speedf2;
1812 double xx[6], *xp;
1813 if (do_save)
1814 xp = pdp->x;
1815 else
1816 xp = xx;
1817 /* if planet has already been computed for this date, return
1818 * if speed flag has been turned on, recompute planet */
1819 speedf1 = pdp->xflgs & SEFLG_SPEED;
1820 speedf2 = iflag & SEFLG_SPEED;
1821 if (tjd == pdp->teval
1822 && pdp->iephe == SEFLG_SWIEPH
1823 && (!speedf2 || speedf1)) {
1824 xp = pdp->x;
1825 } else {
1826 /* call sweph for moon */
1827 retc = sweph(tjd, SEI_MOON, SEI_FILE_MOON, iflag, NULL, do_save, xp, serr);
1828 if (retc != OK)
1829 return(retc);
1830 if (do_save) {
1831 pdp->teval = tjd;
1832 pdp->xflgs = -1;
1833 pdp->iephe = SEFLG_SWIEPH;
1834 }
1835 }
1836 if (xpret != NULL)
1837 for (i = 0; i <= 5; i++)
1838 xpret[i] = xp[i];
1839 return(OK);
1840 }
1841
1842 /* SWISSEPH
1843 * this function computes
1844 * 1. a barycentric planet
1845 * plus, under certain conditions,
1846 * 2. the barycentric sun,
1847 * 3. the barycentric earth, and
1848 * 4. the geocentric moon,
1849 * in barycentric cartesian equatorial coordinates J2000.
1850 *
1851 * these are the data needed for calculation of light-time etc.
1852 *
1853 * tjd julian date
1854 * ipli SEI_ planet number
1855 * ifno ephemeris file number
1856 * do_save write new positions in save area
1857 * xp array of 6 doubles for planet's position and velocity
1858 * xpe earth's
1859 * xps sun's
1860 * xpm moon's
1861 * serr error string
1862 *
1863 * xp - xpm can be NULL. if do_save is TRUE, all of them can be NULL.
1864 * the positions will be written into the save area (swed.pldat[ipli].x)
1865 */
sweplan(double tjd,int ipli,int ifno,int32 iflag,AS_BOOL do_save,double * xpret,double * xperet,double * xpsret,double * xpmret,char * serr)1866 static int sweplan(double tjd, int ipli, int ifno, int32 iflag, AS_BOOL do_save,
1867 double *xpret, double *xperet, double *xpsret, double *xpmret,
1868 char *serr)
1869 {
1870 int i, retc;
1871 int do_earth = FALSE, do_moon = FALSE, do_sunbary = FALSE;
1872 struct plan_data *pdp = &swed.pldat[ipli];
1873 struct plan_data *pebdp = &swed.pldat[SEI_EMB];
1874 struct plan_data *psbdp = &swed.pldat[SEI_SUNBARY];
1875 struct plan_data *pmdp = &swed.pldat[SEI_MOON];
1876 double xxp[6], xxm[6], xxs[6], xxe[6];
1877 double *xp, *xpe, *xpm, *xps;
1878 int32 speedf1, speedf2;
1879 /* xps (barycentric sun) may be necessary because some planets on sweph
1880 * file are heliocentric, other ones are barycentric. without xps,
1881 * the heliocentric ones cannot be returned barycentrically.
1882 */
1883 if (do_save || ipli == SEI_SUNBARY || (pdp->iflg & SEI_FLG_HELIO)
1884 || xpsret != NULL || (iflag & SEFLG_HELCTR))
1885 do_sunbary = TRUE;
1886 if (do_save || ipli == SEI_EARTH || xperet != NULL)
1887 do_earth = TRUE;
1888 if (ipli == SEI_MOON) {
1889 #if 0
1890 if (iflag & (SEFLG_HELCTR | SEFLG_BARYCTR | SEFLG_NOABERR))
1891 do_earth = TRUE;
1892 if (iflag & (SEFLG_HELCTR | SEFLG_NOABERR))
1893 do_sunbary = TRUE;
1894 #else
1895 do_earth = TRUE;
1896 do_sunbary = TRUE;
1897 #endif
1898 }
1899 if (do_save || ipli == SEI_MOON || ipli == SEI_EARTH || xperet != NULL || xpmret != NULL)
1900 do_moon = TRUE;
1901 if (do_save) {
1902 xp = pdp->x;
1903 xpe = pebdp->x;
1904 xps = psbdp->x;
1905 xpm = pmdp->x;
1906 } else {
1907 xp = xxp;
1908 xpe = xxe;
1909 xps = xxs;
1910 xpm = xxm;
1911 }
1912 speedf2 = iflag & SEFLG_SPEED;
1913 /* barycentric sun */
1914 if (do_sunbary) {
1915 speedf1 = psbdp->xflgs & SEFLG_SPEED;
1916 /* if planet has already been computed for this date, return
1917 * if speed flag has been turned on, recompute planet */
1918 if (tjd == psbdp->teval
1919 && psbdp->iephe == SEFLG_SWIEPH
1920 && (!speedf2 || speedf1)) {
1921 for (i = 0; i <= 5; i++)
1922 xps[i] = psbdp->x[i];
1923 } else {
1924 retc = sweph(tjd, SEI_SUNBARY, SEI_FILE_PLANET, iflag, NULL, do_save, xps, serr);/**/
1925 if (retc != OK)
1926 return(retc);
1927 }
1928 if (xpsret != NULL)
1929 for (i = 0; i <= 5; i++)
1930 xpsret[i] = xps[i];
1931 }
1932 /* moon */
1933 if (do_moon) {
1934 speedf1 = pmdp->xflgs & SEFLG_SPEED;
1935 if (tjd == pmdp->teval
1936 && pmdp->iephe == SEFLG_SWIEPH
1937 && (!speedf2 || speedf1)) {
1938 for (i = 0; i <= 5; i++)
1939 xpm[i] = pmdp->x[i];
1940 } else {
1941 retc = sweph(tjd, SEI_MOON, SEI_FILE_MOON, iflag, NULL, do_save, xpm, serr);
1942 if (retc == ERR)
1943 return(retc);
1944 /* if moon file doesn't exist, take moshier moon */
1945 if (swed.fidat[SEI_FILE_MOON].fptr == NULL) {
1946 if (serr != NULL && strlen(serr) + 35 < AS_MAXCH)
1947 strcat(serr, " \nusing Moshier eph. for moon; ");
1948 retc = swi_moshmoon(tjd, do_save, xpm, serr);
1949 if (retc != OK)
1950 return(retc);
1951 }
1952 }
1953 if (xpmret != NULL)
1954 for (i = 0; i <= 5; i++)
1955 xpmret[i] = xpm[i];
1956 }
1957 /* barycentric earth */
1958 if (do_earth) {
1959 speedf1 = pebdp->xflgs & SEFLG_SPEED;
1960 if (tjd == pebdp->teval
1961 && pebdp->iephe == SEFLG_SWIEPH
1962 && (!speedf2 || speedf1)) {
1963 for (i = 0; i <= 5; i++)
1964 xpe[i] = pebdp->x[i];
1965 } else {
1966 retc = sweph(tjd, SEI_EMB, SEI_FILE_PLANET, iflag, NULL, do_save, xpe, serr);
1967 if (retc != OK)
1968 return(retc);
1969 /* earth from emb and moon */
1970 embofs(xpe, xpm);
1971 /* speed is needed, if
1972 * 1. true position is being computed before applying light-time etc.
1973 * this is the position saved in pdp->x.
1974 * in this case, speed is needed for light-time correction.
1975 * 2. the speed flag has been specified.
1976 */
1977 if (xpe == pebdp->x || (iflag & SEFLG_SPEED))
1978 embofs(xpe+3, xpm+3);
1979 }
1980 if (xperet != NULL)
1981 for (i = 0; i <= 5; i++)
1982 xperet[i] = xpe[i];
1983 }
1984 if (ipli == SEI_MOON) {
1985 for (i = 0; i <= 5; i++)
1986 xp[i] = xpm[i];
1987 } else if (ipli == SEI_EARTH) {
1988 for (i = 0; i <= 5; i++)
1989 xp[i] = xpe[i];
1990 } else if (ipli == SEI_SUN) {
1991 for (i = 0; i <= 5; i++)
1992 xp[i] = xps[i];
1993 } else {
1994 /* planet */
1995 speedf1 = pdp->xflgs & SEFLG_SPEED;
1996 if (tjd == pdp->teval
1997 && pdp->iephe == SEFLG_SWIEPH
1998 && (!speedf2 || speedf1)) {
1999 for (i = 0; i <= 5; i++)
2000 xp[i] = pdp->x[i];
2001 return(OK);
2002 } else {
2003 retc = sweph(tjd, ipli, ifno, iflag, NULL, do_save, xp, serr);
2004 if (retc != OK)
2005 return(retc);
2006 /* if planet is heliocentric, it must be transformed to barycentric */
2007 if (pdp->iflg & SEI_FLG_HELIO) {
2008 /* now barycentric planet */
2009 for (i = 0; i <= 2; i++)
2010 xp[i] += xps[i];
2011 if (do_save || (iflag & SEFLG_SPEED))
2012 for (i = 3; i <= 5; i++)
2013 xp[i] += xps[i];
2014 }
2015 }
2016 }
2017 if (xpret != NULL)
2018 for (i = 0; i <= 5; i++)
2019 xpret[i] = xp[i];
2020 return(OK);
2021 }
2022
2023 /* jpl ephemeris.
2024 * this function computes
2025 * 1. a barycentric planet position
2026 * plus, under certain conditions,
2027 * 2. the barycentric sun,
2028 * 3. the barycentric earth,
2029 * in barycentric cartesian equatorial coordinates J2000.
2030
2031 * tjd julian day
2032 * ipli sweph internal planet number
2033 * do_save write new positions in save area
2034 * xp array of 6 doubles for planet's position and speed vectors
2035 * xpe earth's
2036 * xps sun's
2037 * serr pointer to error string
2038 *
2039 * xp - xps can be NULL. if do_save is TRUE, all of them can be NULL.
2040 * the positions will be written into the save area (swed.pldat[ipli].x)
2041 */
jplplan(double tjd,int ipli,int32 iflag,AS_BOOL do_save,double * xpret,double * xperet,double * xpsret,char * serr)2042 static int jplplan(double tjd, int ipli, int32 iflag, AS_BOOL do_save,
2043 double *xpret, double *xperet, double *xpsret, char *serr)
2044 {
2045 int i, retc;
2046 AS_BOOL do_earth = FALSE, do_sunbary = FALSE;
2047 double ss[3];
2048 double xxp[6], xxe[6], xxs[6];
2049 double *xp, *xpe, *xps;
2050 int ictr = J_SBARY;
2051 struct plan_data *pdp = &swed.pldat[ipli];
2052 struct plan_data *pedp = &swed.pldat[SEI_EARTH];
2053 struct plan_data *psdp = &swed.pldat[SEI_SUNBARY];
2054 iflag = SEFLG_JPLEPH; /* currently not used, but this stops compiler warning */
2055 /* we assume Teph ~= TDB ~= TT. The maximum error is < 0.002 sec,
2056 * corresponding to an ephemeris error < 0.001 arcsec for the moon */
2057 /* double tjd_tdb, T;
2058 T = (tjd - 2451545.0)/36525.0;
2059 tjd_tdb = tjd + (0.001657 * sin(628.3076 * T + 6.2401)
2060 + 0.000022 * sin(575.3385 * T + 4.2970)
2061 + 0.000014 * sin(1256.6152 * T + 6.1969)) / 8640.0;*/
2062 if (do_save) {
2063 xp = pdp->x;
2064 xpe = pedp->x;
2065 xps = psdp->x;
2066 } else {
2067 xp = xxp;
2068 xpe = xxe;
2069 xps = xxs;
2070 }
2071 if (do_save || ipli == SEI_EARTH || xperet != NULL
2072 || (ipli == SEI_MOON)) /* && (iflag & (SEFLG_HELCTR | SEFLG_BARYCTR | SEFLG_NOABERR)))) */
2073 do_earth = TRUE;
2074 if (do_save || ipli == SEI_SUNBARY || xpsret != NULL
2075 || (ipli == SEI_MOON)) /* && (iflag & (SEFLG_HELCTR | SEFLG_NOABERR)))) */
2076 do_sunbary = TRUE;
2077 if (ipli == SEI_MOON)
2078 ictr = J_EARTH;
2079 /* open ephemeris, if still closed */
2080 if (!swed.jpl_file_is_open) {
2081 retc = open_jpl_file(ss, swed.jplfnam, swed.ephepath, serr);
2082 if (retc != OK)
2083 return (retc);
2084 }
2085 if (do_earth) {
2086 /* barycentric earth */
2087 if (tjd != pedp->teval || tjd == 0) {
2088 retc = swi_pleph(tjd, J_EARTH, J_SBARY, xpe, serr);
2089 if (do_save) {
2090 pedp->teval = tjd;
2091 pedp->xflgs = -1; /* new light-time etc. required */
2092 pedp->iephe = SEFLG_JPLEPH;
2093 }
2094 if (retc != OK) {
2095 swi_close_jpl_file();
2096 swed.jpl_file_is_open = FALSE;
2097 return retc;
2098 }
2099 } else {
2100 xpe = pedp->x;
2101 }
2102 if (xperet != NULL)
2103 for (i = 0; i <= 5; i++)
2104 xperet[i] = xpe[i];
2105
2106 }
2107 if (do_sunbary) {
2108 /* barycentric sun */
2109 if (tjd != psdp->teval || tjd == 0) {
2110 retc = swi_pleph(tjd, J_SUN, J_SBARY, xps, serr);
2111 if (do_save) {
2112 psdp->teval = tjd;
2113 psdp->xflgs = -1;
2114 psdp->iephe = SEFLG_JPLEPH;
2115 }
2116 if (retc != OK) {
2117 swi_close_jpl_file();
2118 swed.jpl_file_is_open = FALSE;
2119 return retc;
2120 }
2121 } else {
2122 xps = psdp->x;
2123 }
2124 if (xpsret != NULL)
2125 for (i = 0; i <= 5; i++)
2126 xpsret[i] = xps[i];
2127 }
2128 /* earth is wanted */
2129 if (ipli == SEI_EARTH) {
2130 for (i = 0; i <= 5; i++)
2131 xp[i] = xpe[i];
2132 /* sunbary is wanted */
2133 } if (ipli == SEI_SUNBARY) {
2134 for (i = 0; i <= 5; i++)
2135 xp[i] = xps[i];
2136 /* other planet */
2137 } else {
2138 /* if planet already computed */
2139 if (tjd == pdp->teval && pdp->iephe == SEFLG_JPLEPH) {
2140 xp = pdp->x;
2141 } else {
2142 retc = swi_pleph(tjd, pnoint2jpl[ipli], ictr, xp, serr);
2143 if (do_save) {
2144 pdp->teval = tjd;
2145 pdp->xflgs = -1;
2146 pdp->iephe = SEFLG_JPLEPH;
2147 }
2148 if (retc != OK) {
2149 swi_close_jpl_file();
2150 swed.jpl_file_is_open = FALSE;
2151 return retc;
2152 }
2153 }
2154 }
2155 if (xpret != NULL)
2156 for (i = 0; i <= 5; i++)
2157 xpret[i] = xp[i];
2158 return (OK);
2159 }
2160
2161 /*
2162 * this function looks for an ephemeris file,
2163 * opens it, if not yet open,
2164 * reads constants, if not yet read,
2165 * computes a planet, if not yet computed
2166 * attention: asteroids are heliocentric
2167 * other planets barycentric
2168 *
2169 * tjd julian date
2170 * ipli SEI_ planet number
2171 * ifno ephemeris file number
2172 * xsunb INPUT (!) array of 6 doubles containing barycentric sun
2173 * (must be given with asteroids)
2174 * do_save boolean: save result in save area
2175 * xp return array of 6 doubles for planet's position
2176 * serr error string
2177 */
sweph(double tjd,int ipli,int ifno,int32 iflag,double * xsunb,AS_BOOL do_save,double * xpret,char * serr)2178 static int sweph(double tjd, int ipli, int ifno, int32 iflag, double *xsunb, AS_BOOL do_save, double *xpret, char *serr)
2179 {
2180 int i, ipl, retc, subdirlen;
2181 char s[2 * AS_MAXCH], subdirnam[AS_MAXCH], fname[AS_MAXCH], *sp;
2182 double t, tsv;
2183 double xemb[6], xx[6], *xp;
2184 struct plan_data *pdp;
2185 struct plan_data *pedp = &swed.pldat[SEI_EARTH];
2186 struct plan_data *psdp = &swed.pldat[SEI_SUNBARY];
2187 struct file_data *fdp = &swed.fidat[ifno];
2188 int32 speedf1, speedf2;
2189 AS_BOOL need_speed;
2190 ipl = ipli;
2191 if (ipli > SE_AST_OFFSET)
2192 ipl = SEI_ANYBODY;
2193 if (ipli > SE_PLMOON_OFFSET)
2194 ipl = SEI_ANYBODY;
2195 pdp = &swed.pldat[ipl];
2196 if (do_save)
2197 xp = pdp->x;
2198 else
2199 xp = xx;
2200 /* if planet has already been computed for this date, return.
2201 * if speed flag has been turned on, recompute planet */
2202 speedf1 = pdp->xflgs & SEFLG_SPEED;
2203 speedf2 = iflag & SEFLG_SPEED;
2204 if (tjd == pdp->teval
2205 && pdp->iephe == SEFLG_SWIEPH
2206 && (!speedf2 || speedf1)
2207 && ipl < SEI_ANYBODY) {
2208 if (xpret != NULL)
2209 for (i = 0; i <= 5; i++)
2210 xpret[i] = pdp->x[i];
2211 return(OK);
2212 }
2213 /******************************
2214 * get correct ephemeris file *
2215 ******************************/
2216 if (fdp->fptr != NULL) {
2217 /* if tjd is beyond file range, close old file.
2218 * if new asteroid, close old file. */
2219 if (tjd < fdp->tfstart || tjd > fdp->tfend
2220 || (ipl == SEI_ANYBODY && ipli != pdp->ibdy)) {
2221 fclose(fdp->fptr);
2222 fdp->fptr = NULL;
2223 if (pdp->refep != NULL)
2224 free((void *) pdp->refep);
2225 pdp->refep = NULL;
2226 if (pdp->segp != NULL)
2227 free((void *) pdp->segp);
2228 pdp->segp = NULL;
2229 }
2230 }
2231 /* if sweph file not open, find and open it */
2232 if (fdp->fptr == NULL) {
2233 swi_gen_filename(tjd, ipli, fname);
2234 strcpy(subdirnam, fname);
2235 sp = strrchr(subdirnam, (int) *DIR_GLUE);
2236 if (sp != NULL) {
2237 *sp = '\0';
2238 subdirlen = (int) strlen(subdirnam);
2239 } else {
2240 subdirlen = 0;
2241 }
2242 strcpy(s, fname);
2243 again:
2244 fdp->fptr = swi_fopen(ifno, s, swed.ephepath, serr);
2245 if (fdp->fptr == NULL) {
2246 // if it is a planetary moon, also try without the directory "sat/"
2247 if (ipli > SE_PLMOON_OFFSET && ipli < SE_AST_OFFSET) {
2248 if (subdirlen > 0 && strncmp(s, subdirnam, (size_t) subdirlen) == 0) {
2249 swi_strcpy(s, s + subdirlen + 1); /* remove "sat/" etc. */
2250 goto again;
2251 }
2252 /*
2253 * if it is a numbered asteroid file, try also for short files (..s.se1)
2254 * On the second try, the inserted 's' will be seen and not tried again.
2255 */
2256 } else if (ipli > SE_AST_OFFSET) {
2257 char *spp;
2258 spp = strchr(s, '.');
2259 if (spp > s && *(spp-1) != 's') { /* no 's' before '.' ? */
2260 sprintf(spp, "s.%s", SE_FILE_SUFFIX); /* insert an 's' */
2261 goto again;
2262 }
2263 /*
2264 * if we still have 'ast0' etc. in front of the filename,
2265 * we remove it now, remove the 's' also,
2266 * and try in the main ephemeris directory instead of the
2267 * asteroid subdirectory.
2268 */
2269 spp--; /* point to the character before '.' which must be a 's' */
2270 swi_strcpy(spp, spp + 1); /* remove the s */
2271 if (subdirlen > 0 && strncmp(s, subdirnam, (size_t) subdirlen) == 0) {
2272 swi_strcpy(s, s + subdirlen + 1); /* remove "ast0/" etc. */
2273 goto again;
2274 }
2275 }
2276 return(NOT_AVAILABLE);
2277 }
2278 /* during the search error messages may have been built, delete them */
2279 if (serr != NULL) *serr = '\0';
2280 retc = read_const(ifno, serr);
2281 if (retc != OK)
2282 return(retc);
2283 }
2284 /* if first ephemeris file (J-3000), it might start a mars period
2285 * after -3000. if last ephemeris file (J3000), it might end a
2286 * 4000-day-period before 3000. */
2287 if (tjd < fdp->tfstart || tjd > fdp->tfend) {
2288 if (serr != NULL) {
2289 sp = strrchr(fname, (int) *DIR_GLUE);
2290 if (sp != NULL)
2291 sp++;
2292 else
2293 sp = fname;
2294 if (ipli > SE_AST_OFFSET) {
2295 sprintf(s, "asteroid No. %d (%s): ", ipli - SE_AST_OFFSET, sp);
2296 } else if (ipli > SE_PLMOON_OFFSET) {
2297 if (strstr(fname, "99.") != NULL)
2298 sprintf(s, "plan. COB No. %d (%s): ", ipli, sp);
2299 else
2300 sprintf(s, "plan. moon No. %d (%s): ", ipli, sp);
2301 } else if (ipli > SEI_PLUTO) {
2302 sprintf(s, "asteroid eph. file (%s): ", sp);
2303 } else if (ipli != SEI_MOON) {
2304 sprintf(s, "planets eph. file (%s): ", sp);
2305 } else {
2306 sprintf(s, "moon eph. file (%s): ", sp);
2307 }
2308 if (tjd < fdp->tfstart)
2309 sprintf(s + strlen(s), "jd %f < lower limit %f;",
2310 tjd, fdp->tfstart);
2311 else
2312 sprintf(s + strlen(s), "jd %f > upper limit %f;",
2313 tjd, fdp->tfend);
2314 if (strlen(serr) + strlen(s) < AS_MAXCH)
2315 strcat(serr, s);
2316 }
2317 return(NOT_AVAILABLE);
2318 }
2319 /******************************
2320 * get planet's position
2321 ******************************/
2322 /* get new segment, if necessary */
2323 if (pdp->segp == NULL || tjd < pdp->tseg0 || tjd > pdp->tseg1) {
2324 retc = get_new_segment(tjd, ipl, ifno, serr);
2325 if (retc != OK)
2326 return(retc);
2327 /* rotate cheby coeffs back to equatorial system.
2328 * if necessary, add reference orbit. */
2329 if (pdp->iflg & SEI_FLG_ROTATE)
2330 rot_back(ipl); /**/
2331 else
2332 pdp->neval = pdp->ncoe;
2333 }
2334 /* evaluate chebyshew polynomial for tjd */
2335 t = (tjd - pdp->tseg0) / pdp->dseg;
2336 t = t * 2 - 1;
2337 /* speed is needed, if
2338 * 1. true position is being computed before applying light-time etc.
2339 * this is the position saved in pdp->x.
2340 * in this case, speed is needed for light-time correction.
2341 * 2. the speed flag has been specified.
2342 */
2343 need_speed = (do_save || (iflag & SEFLG_SPEED));
2344 for (i = 0; i <= 2; i++) {
2345 xp[i] = swi_echeb (t, pdp->segp+(i*pdp->ncoe), pdp->neval);
2346 if (need_speed)
2347 xp[i+3] = swi_edcheb(t, pdp->segp+(i*pdp->ncoe), pdp->neval) / pdp->dseg * 2;
2348 else
2349 xp[i+3] = 0; /* von Alois als billiger fix, evtl. illegal */
2350 }
2351 /* if planet wanted is barycentric sun:
2352 * current sepl* files have do not have barycentric sun,
2353 * but have heliocentric earth and barycentric earth.
2354 * So barycentric sun and must be computed
2355 * from heliocentric earth and barycentric earth: the
2356 * computation above gives heliocentric earth, therefore we
2357 * have to compute barycentric earth and subtract heliocentric
2358 * earth from it. this may be necessary with calls from
2359 * sweplan() and from app_pos_etc_sun() (light-time). */
2360 if (ipl == SEI_SUNBARY && (pdp->iflg & SEI_FLG_EMBHEL)) {
2361 /* sweph() calls sweph() !!! for EMB.
2362 * Attention: a new calculation must be forced in any case.
2363 * Otherwise EARTH (instead of EMB) will possibly taken from
2364 * save area.
2365 * to force new computation, set pedp->teval = 0 and restore it
2366 * after call of sweph(EMB).
2367 */
2368 tsv = pedp->teval;
2369 pedp->teval = 0;
2370 retc = sweph(tjd, SEI_EMB, ifno, iflag | SEFLG_SPEED, NULL, NO_SAVE, xemb, serr);
2371 if (retc != OK)
2372 return(retc);
2373 pedp->teval = tsv;
2374 for (i = 0; i <= 2; i++)
2375 xp[i] = xemb[i] - xp[i];
2376 if (need_speed)
2377 for (i = 3; i <= 5; i++)
2378 xp[i] = xemb[i] - xp[i];
2379 }
2380 #if 1
2381 /* asteroids are heliocentric.
2382 * if JPL or SWISSEPH, convert to barycentric */
2383 if (xsunb != NULL && ((iflag & SEFLG_JPLEPH) || (iflag & SEFLG_SWIEPH))) {
2384 if (ipl >= SEI_ANYBODY) {
2385 for (i = 0; i <= 2; i++)
2386 xp[i] += xsunb[i];
2387 if (need_speed)
2388 for (i = 3; i <= 5; i++)
2389 xp[i] += xsunb[i];
2390 }
2391 }
2392 #endif
2393 if (do_save) {
2394 pdp->teval = tjd;
2395 pdp->xflgs = -1; /* do new computation of light-time etc. */
2396 if (ifno == SEI_FILE_PLANET || ifno == SEI_FILE_MOON)
2397 pdp->iephe = SEFLG_SWIEPH;/**/
2398 else
2399 pdp->iephe = psdp->iephe;
2400 }
2401 if (xpret != NULL)
2402 for (i = 0; i <= 5; i++)
2403 xpret[i] = xp[i];
2404 return(OK);
2405 }
2406
2407 /*
2408 * Alois 2.12.98: inserted error message generation for file not found
2409 */
swi_fopen(int ifno,char * fname,char * ephepath,char * serr)2410 FILE *swi_fopen(int ifno, char *fname, char *ephepath, char *serr)
2411 {
2412 int np, i, j;
2413 FILE *fp = NULL;
2414 char *fnamp, fn[AS_MAXCH];
2415 char *cpos[20];
2416 char s[2 * AS_MAXCH];
2417 char s1[AS_MAXCH];
2418 if (ifno >= 0) {
2419 fnamp = swed.fidat[ifno].fnam;
2420 } else {
2421 fnamp = fn;
2422 }
2423 strcpy(s1, ephepath);
2424 np = swi_cutstr(s1, PATH_SEPARATOR, cpos, 20);
2425 *s = '\0';
2426 for (i = 0; i < np; i++) {
2427 strcpy(s, cpos[i]);
2428 if (strcmp(s, ".") == 0) { /* current directory */
2429 *s = '\0';
2430 } else {
2431 j = (int) strlen(s);
2432 if (*s != '\0' && *(s + j - 1) != *DIR_GLUE)
2433 strcat(s, DIR_GLUE);
2434 }
2435 if (strlen(s) + strlen(fname) < AS_MAXCH) {
2436 strcat(s, fname);
2437 } else {
2438 if (serr != NULL)
2439 sprintf(serr, "error: file path and name must be shorter than %d.", AS_MAXCH);
2440 return NULL;
2441 }
2442 strcpy(fnamp, s);
2443 fp = fopen(fnamp, BFILE_R_ACCESS);
2444 if (fp != NULL)
2445 return fp;
2446 }
2447 sprintf(s, "SwissEph file '%s' not found in PATH '%s'", fname, ephepath);
2448 s[AS_MAXCH-1] = '\0'; /* s must not be longer then AS_MAXCH */
2449 if (serr != NULL)
2450 strcpy(serr, s);
2451 return NULL;
2452 }
2453
swi_get_denum(int32 ipli,int32 iflag)2454 int32 swi_get_denum(int32 ipli, int32 iflag)
2455 {
2456 struct file_data *fdp = NULL;
2457 if (iflag & SEFLG_MOSEPH)
2458 return 403;
2459 if (iflag & SEFLG_JPLEPH) {
2460 if (swed.jpldenum > 0)
2461 return swed.jpldenum;
2462 else
2463 return SE_DE_NUMBER;
2464 }
2465 if (ipli > SE_AST_OFFSET) {
2466 fdp = &swed.fidat[SEI_FILE_ANY_AST];
2467 } else if (ipli > SE_PLMOON_OFFSET) {
2468 fdp = &swed.fidat[SEI_FILE_ANY_AST];
2469 } else if (ipli == SEI_CHIRON
2470 || ipli == SEI_PHOLUS
2471 || ipli == SEI_CERES
2472 || ipli == SEI_PALLAS
2473 || ipli == SEI_JUNO
2474 || ipli == SEI_VESTA) {
2475 fdp = &swed.fidat[SEI_FILE_MAIN_AST];
2476 } else if (ipli == SEI_MOON) {
2477 fdp = &swed.fidat[SEI_FILE_MOON];
2478 } else {
2479 fdp = &swed.fidat[SEI_FILE_PLANET];
2480 }
2481 if (fdp != NULL) {
2482 if (fdp->sweph_denum != 0)
2483 return fdp->sweph_denum;
2484 else
2485 return SE_DE_NUMBER;
2486 }
2487 return SE_DE_NUMBER;
2488 }
2489
calc_center_body(int32 ipli,int32 iflag,double * xx,double * xcom,char * serr)2490 static int calc_center_body(int32 ipli, int32 iflag, double *xx, double *xcom, char *serr)
2491 {
2492 int i;
2493 if (!(iflag & SEFLG_CENTER_BODY))
2494 return OK;
2495 if (ipli < SEI_MARS || ipli > SEI_PLUTO)
2496 return OK;
2497 for (i = 0; i <= 5; i++)
2498 xx[i] += xcom[i];
2499 return OK;
2500 }
2501
2502 /* converts planets from barycentric to geocentric,
2503 * apparent positions
2504 * precession and nutation
2505 * according to flags
2506 * ipli planet number
2507 * iflag flags
2508 * serr error string
2509 */
app_pos_etc_plan(int ipli,int iplmoon,int32 iflag,char * serr)2510 static int app_pos_etc_plan(int ipli, int iplmoon, int32 iflag, char *serr)
2511 {
2512 int i, j, niter, retc = OK;
2513 int ipl, ifno, ibody;
2514 int32 flg1, flg2;
2515 double xx[6], xx0[6], dx[3], dt, t, dtsave_for_defl;
2516 double xobs[6], xobs2[6];
2517 double xearth[6], xsun[6], xcom[6];
2518 double xxsp[6], xxsv[6];
2519 struct plan_data *pedp = &swed.pldat[SEI_EARTH];
2520 struct plan_data *pdp;
2521 struct epsilon *oe = &swed.oec2000;
2522 int32 epheflag = iflag & SEFLG_EPHMASK;
2523 dtsave_for_defl = 0;
2524 /* ephemeris file */
2525 if (ipli > SE_PLMOON_OFFSET || ipli > SE_AST_OFFSET) { // 2nd condition obsolete
2526 ifno = SEI_FILE_ANY_AST;
2527 ibody = IS_ANY_BODY;
2528 pdp = &swed.pldat[SEI_ANYBODY];
2529 } else if (ipli == SEI_CHIRON
2530 || ipli == SEI_PHOLUS
2531 || ipli == SEI_CERES
2532 || ipli == SEI_PALLAS
2533 || ipli == SEI_JUNO
2534 || ipli == SEI_VESTA) {
2535 ifno = SEI_FILE_MAIN_AST;
2536 ibody = IS_MAIN_ASTEROID;
2537 pdp = &swed.pldat[ipli];
2538 } else {
2539 ifno = SEI_FILE_PLANET;
2540 ibody = IS_PLANET;
2541 pdp = &swed.pldat[ipli];
2542 }
2543 t = pdp->teval;
2544 #if 0
2545 {
2546 struct plan_data *psp = &swed.pldat[SEI_SUNBARY];
2547 printf("planet %.14f %.14f %.14f\n", pdp->x[0], pdp->x[1], pdp->x[2]);
2548 printf("sunbary %.14f %.14f %.14f\n", psp->x[0], psp->x[1], psp->x[2]);
2549 }
2550 #endif
2551 /* if the same conversions have already been done for the same
2552 * date, then return */
2553 flg1 = iflag & ~SEFLG_EQUATORIAL & ~SEFLG_XYZ;
2554 flg2 = pdp->xflgs & ~SEFLG_EQUATORIAL & ~SEFLG_XYZ;
2555 if (flg1 == flg2) {
2556 pdp->xflgs = iflag;
2557 pdp->iephe = iflag & SEFLG_EPHMASK;
2558 return OK;
2559 }
2560 /* the conversions will be done with xx[]. */
2561 for (i = 0; i <= 5; i++)
2562 xx[i] = pdp->x[i];
2563 /* center body of planet, if SEFLG_CENTER_BODY (which is checked inside function) */
2564 calc_center_body(ipli, iflag, xx, swed.pldat[SEI_ANYBODY].x, serr);
2565 for (i = 0; i <= 5; i++)
2566 xx0[i] = xx[i];
2567 /* if heliocentric position is wanted */
2568 if (iflag & SEFLG_HELCTR) {
2569 if (pdp->iephe == SEFLG_JPLEPH || pdp->iephe == SEFLG_SWIEPH)
2570 for (i = 0; i <= 5; i++)
2571 xx[i] -= swed.pldat[SEI_SUNBARY].x[i];
2572 }
2573 /************************************
2574 * observer: geocenter or topocenter
2575 ************************************/
2576 /* if topocentric position is wanted */
2577 if (iflag & SEFLG_TOPOCTR) {
2578 if (swed.topd.teval != pedp->teval
2579 || swed.topd.teval == 0) {
2580 if (swi_get_observer(pedp->teval, iflag | SEFLG_NONUT, DO_SAVE, xobs, serr) != OK)
2581 return ERR;
2582 } else {
2583 for (i = 0; i <= 5; i++)
2584 xobs[i] = swed.topd.xobs[i];
2585 }
2586 /* barycentric position of observer */
2587 for (i = 0; i <= 5; i++)
2588 xobs[i] = xobs[i] + pedp->x[i];
2589 } else {
2590 /* barycentric position of geocenter */
2591 for (i = 0; i <= 5; i++)
2592 xobs[i] = pedp->x[i];
2593 }
2594 /*******************************
2595 * light-time geocentric *
2596 *******************************/
2597 if (!(iflag & SEFLG_TRUEPOS)) {
2598 /* number of iterations - 1 */
2599 if (pdp->iephe == SEFLG_JPLEPH || pdp->iephe == SEFLG_SWIEPH)
2600 niter = 1;
2601 else /* SEFLG_MOSEPH or planet from osculating elements */
2602 niter = 0;
2603 if (iflag & SEFLG_SPEED) {
2604 /*
2605 * Apparent speed is influenced by the fact that dt changes with
2606 * time. This makes a difference of several hundredths of an
2607 * arc second / day. To take this into account, we compute
2608 * 1. true position - apparent position at time t - 1.
2609 * 2. true position - apparent position at time t.
2610 * 3. the difference between the two is the part of the daily motion
2611 * that results from the change of dt.
2612 */
2613 for (i = 0; i <= 2; i++)
2614 xxsv[i] = xxsp[i] = xx[i] - xx[i+3];
2615 for (j = 0; j <= niter; j++) {
2616 for (i = 0; i <= 2; i++) {
2617 dx[i] = xxsp[i];
2618 if (!(iflag & SEFLG_HELCTR) && !(iflag & SEFLG_BARYCTR))
2619 dx[i] -= (xobs[i] - xobs[i+3]);
2620 }
2621 /* new dt */
2622 dt = sqrt(square_sum(dx)) * AUNIT / CLIGHT / 86400.0;
2623 for (i = 0; i <= 2; i++) { /* rough apparent position at t-1 */
2624 //xxsp[i] = xxsv[i] - dt * pdp->x[i+3];
2625 xxsp[i] = xxsv[i] - dt * xx0[i+3];
2626 }
2627 }
2628 /* true position - apparent position at time t-1 */
2629 for (i = 0; i <= 2; i++)
2630 xxsp[i] = xxsv[i] - xxsp[i];
2631 }
2632 /* dt and t(apparent) */
2633 for (j = 0; j <= niter; j++) {
2634 for (i = 0; i <= 2; i++) {
2635 dx[i] = xx[i];
2636 if (!(iflag & SEFLG_HELCTR) && !(iflag & SEFLG_BARYCTR))
2637 dx[i] -= xobs[i];
2638 }
2639 dt = sqrt(square_sum(dx)) * AUNIT / CLIGHT / 86400.0;
2640 /* new t */
2641 t = pdp->teval - dt;
2642 dtsave_for_defl = dt;
2643 for (i = 0; i <= 2; i++) { /* rough apparent position at t*/
2644 //xx[i] = pdp->x[i] - dt * pdp->x[i+3];
2645 xx[i] = xx0[i] - dt * xx0[i+3];
2646 }
2647 }
2648 /* part of daily motion resulting from change of dt */
2649 if (iflag & SEFLG_SPEED) {
2650 for (i = 0; i <= 2; i++) {
2651 //xxsp[i] = pdp->x[i] - xx[i] - xxsp[i];
2652 xxsp[i] = xx0[i] - xx[i] - xxsp[i];
2653 }
2654 }
2655 /* new position, accounting for light-time (accurate) */
2656 if ((iflag & SEFLG_CENTER_BODY)
2657 && ipli >= SE_MARS && ipli <= SE_PLUTO) {
2658 //ipli_com = ipli * 100 + 9099;
2659 /* jupiter center of body, relative to jupiter barycenter */
2660 retc = sweph(t, iplmoon, SEI_FILE_ANY_AST, iflag, NULL, NO_SAVE, xcom, serr);
2661 if (retc == ERR || retc == NOT_AVAILABLE)
2662 return ERR;
2663 }
2664 switch(epheflag) {
2665 case SEFLG_JPLEPH:
2666 if (ibody >= IS_ANY_BODY)
2667 ipl = -1; /* will not be used */ /*pnoint2jpl[SEI_ANYBODY];*/
2668 else
2669 ipl = pnoint2jpl[ipli];
2670 if (ibody == IS_PLANET) {
2671 retc = swi_pleph(t, ipl, J_SBARY, xx, serr);
2672 if (retc != OK) {
2673 swi_close_jpl_file();
2674 swed.jpl_file_is_open = FALSE;
2675 }
2676 } else { /* asteroid */
2677 /* first sun */
2678 retc = swi_pleph(t, J_SUN, J_SBARY, xsun, serr);
2679 if (retc != OK) {
2680 swi_close_jpl_file();
2681 swed.jpl_file_is_open = FALSE;
2682 }
2683 /* asteroid */
2684 retc = sweph(t, ipli, ifno, iflag, xsun, NO_SAVE, xx, serr);
2685 }
2686 if (retc != OK)
2687 return(retc);
2688 /* for accuracy in speed, we need earth as well */
2689 if ((iflag & SEFLG_SPEED)
2690 && !(iflag & SEFLG_HELCTR) && !(iflag & SEFLG_BARYCTR)) {
2691 retc = swi_pleph(t, J_EARTH, J_SBARY, xearth, serr);
2692 if (retc != OK) {
2693 swi_close_jpl_file();
2694 swed.jpl_file_is_open = FALSE;
2695 return(retc);
2696 }
2697 }
2698 break;
2699 case SEFLG_SWIEPH:
2700 if (ibody == IS_PLANET) {
2701 retc = sweplan(t, ipli, ifno, iflag, NO_SAVE, xx, xearth, xsun, NULL, serr);
2702 } else { /*asteroid*/
2703 retc = sweplan(t, SEI_EARTH, SEI_FILE_PLANET, iflag, NO_SAVE, xearth, NULL, xsun, NULL, serr);
2704 if (retc == OK)
2705 retc = sweph(t, ipli, ifno, iflag, xsun, NO_SAVE, xx, serr);
2706 }
2707 if (retc != OK)
2708 return(retc);
2709 break;
2710 case SEFLG_MOSEPH:
2711 default:
2712 /*
2713 * with moshier or other ephemerides, subtraction of dt * speed
2714 * is sufficient (has been done in light-time iteration above)
2715 */
2716 #if 0
2717 for (i = 0; i <= 2; i++) {
2718 xx[i] = pdp->x[i] - dt * pdp->x[i+3];/**/
2719 xx[i+3] = pdp->x[i+3];
2720 }
2721 #endif
2722 /* if speed flag is true, we call swi_moshplan() for new t.
2723 * this does not increase position precision,
2724 * but speed precision, which becomes better than 0.01"/day.
2725 * for precise speed, we need earth as well.
2726 */
2727 if (iflag & SEFLG_SPEED
2728 && !(iflag & (SEFLG_HELCTR | SEFLG_BARYCTR))) {
2729 if (ibody == IS_PLANET) {
2730 retc = swi_moshplan(t, ipli, NO_SAVE, xxsv, xearth, serr);
2731 } else { /* if asteroid */
2732 retc = sweph(t, ipli, ifno, iflag, NULL, NO_SAVE, xxsv, serr);
2733 if (retc == OK)
2734 retc = swi_moshplan(t, SEI_EARTH, NO_SAVE, xearth, xearth, serr);
2735 }
2736 if (retc != OK)
2737 return(retc);
2738 /* only speed is taken from this computation, otherwise position
2739 * calculations with and without speed would not agree. The difference
2740 * would be about 0.01", which is far below the intrinsic error of the
2741 * moshier ephemeris.
2742 */
2743 for (i = 3; i <= 5; i++)
2744 xx[i] = xxsv[i];
2745 }
2746 break;
2747 }
2748 calc_center_body(ipli, iflag, xx, xcom, serr);
2749 if (iflag & SEFLG_HELCTR) {
2750 if (pdp->iephe == SEFLG_JPLEPH || pdp->iephe == SEFLG_SWIEPH)
2751 for (i = 0; i <= 5; i++)
2752 xx[i] -= swed.pldat[SEI_SUNBARY].x[i];
2753 }
2754 if (iflag & SEFLG_SPEED) {
2755 /* observer position for t(light-time) */
2756 if (iflag & SEFLG_TOPOCTR) {
2757 if (swi_get_observer(t, iflag | SEFLG_NONUT, NO_SAVE, xobs2, serr) != OK)
2758 return ERR;
2759 for (i = 0; i <= 5; i++)
2760 xobs2[i] += xearth[i];
2761 } else {
2762 for (i = 0; i <= 5; i++)
2763 xobs2[i] = xearth[i];
2764 }
2765 }
2766 }
2767 /*******************************
2768 * conversion to geocenter *
2769 *******************************/
2770 if (!(iflag & SEFLG_HELCTR) && !(iflag & SEFLG_BARYCTR)) {
2771 /* subtract earth */
2772 for (i = 0; i <= 5; i++)
2773 xx[i] -= xobs[i];
2774 #if 0
2775 /* earth and planets are barycentric with jpl and swisseph,
2776 * but asteroids are heliocentric. therefore, add baryctr. sun */
2777 if (ibody != IS_PLANET && !(iflag & SEFLG_MOSEPH)) {
2778 for (i = 0; i <= 5; i++)
2779 xx[i] += swed.pldat[SEI_SUNBARY].x[i];
2780 }
2781 #endif
2782 if ((iflag & SEFLG_TRUEPOS) == 0 ) {
2783 /*
2784 * Apparent speed is also influenced by
2785 * the change of dt during motion.
2786 * Neglect of this would result in an error of several 0.01"
2787 */
2788 if (iflag & SEFLG_SPEED)
2789 for (i = 3; i <= 5; i++)
2790 xx[i] -= xxsp[i-3];
2791 }
2792 }
2793 if (!(iflag & SEFLG_SPEED))
2794 for (i = 3; i <= 5; i++)
2795 xx[i] = 0;
2796 /************************************
2797 * relativistic deflection of light *
2798 ************************************/
2799 if (!(iflag & SEFLG_TRUEPOS) && !(iflag & SEFLG_NOGDEFL))
2800 /* SEFLG_NOGDEFL is on, if SEFLG_HELCTR or SEFLG_BARYCTR */
2801 swi_deflect_light(xx, dtsave_for_defl, iflag);
2802 /**********************************
2803 * 'annual' aberration of light *
2804 **********************************/
2805 if (!(iflag & SEFLG_TRUEPOS) && !(iflag & SEFLG_NOABERR)) {
2806 /* SEFLG_NOABERR is on, if SEFLG_HELCTR or SEFLG_BARYCTR */
2807 swi_aberr_light(xx, xobs, iflag);
2808 /*
2809 * Apparent speed is also influenced by
2810 * the difference of speed of the earth between t and t-dt.
2811 * Neglecting this would involve an error of several 0.1"
2812 */
2813 if (iflag & SEFLG_SPEED) {
2814 for (i = 3; i <= 5; i++)
2815 xx[i] += xobs[i] - xobs2[i];
2816 }
2817 }
2818 if (!(iflag & SEFLG_SPEED))
2819 for (i = 3; i <= 5; i++)
2820 xx[i] = 0;
2821 #if 0
2822 swi_cartpol(xx, xx);
2823 xx[0] -= 0.053 / 3600.0 * DEGTORAD;
2824 swi_polcart(xx, xx);
2825 #endif
2826 /* ICRS to J2000 */
2827 if (!(iflag & SEFLG_ICRS) && swi_get_denum(ipli, epheflag) >= 403) {
2828 swi_bias(xx, t, iflag, FALSE);
2829 }/**/
2830 /* save J2000 coordinates; required for sidereal positions */
2831 for (i = 0; i <= 5; i++)
2832 xxsv[i] = xx[i];
2833 /************************************************
2834 * precession, equator 2000 -> equator of date *
2835 ************************************************/
2836 if (!(iflag & SEFLG_J2000)) {
2837 swi_precess(xx, pdp->teval, iflag, J2000_TO_J);
2838 if (iflag & SEFLG_SPEED)
2839 swi_precess_speed(xx, pdp->teval, iflag, J2000_TO_J);
2840 oe = &swed.oec;
2841 } else {
2842 oe = &swed.oec2000;
2843 }
2844 return app_pos_rest(pdp, iflag, xx, xxsv, oe, serr);
2845 }
2846
app_pos_rest(struct plan_data * pdp,int32 iflag,double * xx,double * x2000,struct epsilon * oe,char * serr)2847 static int app_pos_rest(struct plan_data *pdp, int32 iflag,
2848 double *xx, double *x2000,
2849 struct epsilon *oe, char *serr)
2850 {
2851 int i;
2852 double daya[2];
2853 double xxsv[24];
2854 /************************************************
2855 * nutation *
2856 ************************************************/
2857 if (!(iflag & SEFLG_NONUT))
2858 swi_nutate(xx, iflag, FALSE);
2859 /* now we have equatorial cartesian coordinates; save them */
2860 for (i = 0; i <= 5; i++)
2861 pdp->xreturn[18+i] = xx[i];
2862 /************************************************
2863 * transformation to ecliptic. *
2864 * with sidereal calc. this will be overwritten *
2865 * afterwards. *
2866 ************************************************/
2867 swi_coortrf2(xx, xx, oe->seps, oe->ceps);
2868 if (iflag & SEFLG_SPEED)
2869 swi_coortrf2(xx+3, xx+3, oe->seps, oe->ceps);
2870 if (!(iflag & SEFLG_NONUT)) {
2871 swi_coortrf2(xx, xx, swed.nut.snut, swed.nut.cnut);
2872 if (iflag & SEFLG_SPEED)
2873 swi_coortrf2(xx+3, xx+3, swed.nut.snut, swed.nut.cnut);
2874 }
2875 /* now we have ecliptic cartesian coordinates */
2876 for (i = 0; i <= 5; i++)
2877 pdp->xreturn[6+i] = xx[i];
2878 /************************************
2879 * sidereal positions *
2880 ************************************/
2881 if (iflag & SEFLG_SIDEREAL) {
2882 /* project onto ecliptic t0 */
2883 if (swed.sidd.sid_mode & SE_SIDBIT_ECL_T0) {
2884 if (swi_trop_ra2sid_lon(x2000, pdp->xreturn+6, pdp->xreturn+18, iflag) != OK)
2885 return ERR;
2886 /* project onto solar system equator */
2887 } else if (swed.sidd.sid_mode & SE_SIDBIT_SSY_PLANE) {
2888 if (swi_trop_ra2sid_lon_sosy(x2000, pdp->xreturn+6, iflag) != OK)
2889 return ERR;
2890 } else {
2891 /* traditional algorithm */
2892 swi_cartpol_sp(pdp->xreturn+6, pdp->xreturn);
2893 /* note, swi_get_ayanamsa_ex() disturbs present calculations, if sun is calculated with
2894 * TRUE_CHITRA ayanamsha, because the ayanamsha also calculates the sun.
2895 * Therefore current values are saved... */
2896 for (i = 0; i < 24; i++)
2897 xxsv[i] = pdp->xreturn[i];
2898 if (swi_get_ayanamsa_with_speed(pdp->teval, iflag, daya, serr) == ERR)
2899 return ERR;
2900 /* ... and restored */
2901 for (i = 0; i < 24; i++)
2902 pdp->xreturn[i] = xxsv[i];
2903 pdp->xreturn[0] -= daya[0] * DEGTORAD;
2904 pdp->xreturn[3] -= daya[1] * DEGTORAD;
2905 swi_polcart_sp(pdp->xreturn, pdp->xreturn+6);
2906 }
2907 }
2908 /************************************************
2909 * transformation to polar coordinates *
2910 ************************************************/
2911 swi_cartpol_sp(pdp->xreturn+18, pdp->xreturn+12);
2912 swi_cartpol_sp(pdp->xreturn+6, pdp->xreturn);
2913 /**********************
2914 * radians to degrees *
2915 **********************/
2916 /*if ((iflag & SEFLG_RADIANS) == 0) {*/
2917 for (i = 0; i < 2; i++) {
2918 pdp->xreturn[i] *= RADTODEG; /* ecliptic */
2919 pdp->xreturn[i+3] *= RADTODEG;
2920 pdp->xreturn[i+12] *= RADTODEG; /* equator */
2921 pdp->xreturn[i+15] *= RADTODEG;
2922 }
2923 /*pdp->xreturn[12] -= (0.053 / 3600.0); */
2924 /*}*/
2925 /* save, what has been done */
2926 pdp->xflgs = iflag;
2927 pdp->iephe = iflag & SEFLG_EPHMASK;
2928 return OK;
2929 }
2930
swe_set_sid_mode(int32 sid_mode,double t0,double ayan_t0)2931 void CALL_CONV swe_set_sid_mode(int32 sid_mode, double t0, double ayan_t0)
2932 {
2933 struct sid_data *sip = &swed.sidd;
2934 swi_init_swed_if_start();
2935 if (sid_mode < 0)
2936 sid_mode = 0;
2937 sip->sid_mode = sid_mode;
2938 if (sid_mode >= SE_SIDBITS)
2939 sid_mode %= SE_SIDBITS;
2940 /* standard equinoxes: positions always referred to ecliptic of t0 */
2941 if (sid_mode == SE_SIDM_J2000
2942 || sid_mode == SE_SIDM_J1900
2943 || sid_mode == SE_SIDM_B1950
2944 || sid_mode == SE_SIDM_GALALIGN_MARDYKS
2945 ) {
2946 //sip->sid_mode &= ~SE_SIDBIT_SSY_PLANE;
2947 sip->sid_mode = sid_mode;
2948 sip->sid_mode |= SE_SIDBIT_ECL_T0;
2949 }
2950 if (sid_mode == SE_SIDM_TRUE_CITRA
2951 || sid_mode == SE_SIDM_TRUE_REVATI
2952 || sid_mode == SE_SIDM_TRUE_PUSHYA
2953 || sid_mode == SE_SIDM_TRUE_SHEORAN
2954 || sid_mode == SE_SIDM_TRUE_MULA
2955 || sid_mode == SE_SIDM_GALCENT_0SAG
2956 || sid_mode == SE_SIDM_GALCENT_COCHRANE
2957 || sid_mode == SE_SIDM_GALCENT_RGILBRAND
2958 || sid_mode == SE_SIDM_GALCENT_MULA_WILHELM
2959 || sid_mode == SE_SIDM_GALEQU_IAU1958
2960 || sid_mode == SE_SIDM_GALEQU_TRUE
2961 || sid_mode == SE_SIDM_GALEQU_MULA
2962 ) {
2963 //sip->sid_mode &= ~(SE_SIDBIT_ECL_T0 | SE_SIDBIT_SSY_PLANE | SE_SIDBIT_USER_UT);
2964 sip->sid_mode = sid_mode;
2965 }
2966 if (sid_mode >= SE_NSIDM_PREDEF && sid_mode != SE_SIDM_USER)
2967 sip->sid_mode = sid_mode = SE_SIDM_FAGAN_BRADLEY;
2968 swed.ayana_is_set = TRUE;
2969 if (sid_mode == SE_SIDM_USER) {
2970 sip->t0 = t0;
2971 sip->ayan_t0 = ayan_t0;
2972 sip->t0_is_UT = FALSE;
2973 if (sip->sid_mode & SE_SIDBIT_USER_UT)
2974 sip->t0_is_UT = TRUE;
2975 } else {
2976 sip->t0 = ayanamsa[sid_mode].t0;
2977 sip->ayan_t0 = ayanamsa[sid_mode].ayan_t0;
2978 sip->t0_is_UT = ayanamsa[sid_mode].t0_is_UT;
2979 }
2980 // test feature: ayanamsha using its original precession model
2981 if ((sip->sid_mode & SE_SIDBIT_PREC_ORIG) && ayanamsa[sid_mode].prec_offset > 0) {
2982 swed.astro_models[SE_MODEL_PREC_LONGTERM] = ayanamsa[sid_mode].prec_offset;
2983 swed.astro_models[SE_MODEL_PREC_SHORTTERM] = ayanamsa[sid_mode].prec_offset;
2984 // add a corresponding nutation model
2985 switch(ayanamsa[sid_mode].prec_offset) {
2986 case SEMOD_PREC_NEWCOMB:
2987 swed.astro_models[SE_MODEL_NUT] = SEMOD_NUT_WOOLARD;
2988 break;
2989 case SEMOD_PREC_IAU_1976:
2990 swed.astro_models[SE_MODEL_NUT] = SEMOD_NUT_IAU_1980;
2991 break;
2992 default:
2993 break;
2994 }
2995 }
2996 swi_force_app_pos_etc();
2997 }
2998
swe_get_ayanamsa_ex(double tjd_et,int32 iflag,double * daya,char * serr)2999 int32 CALL_CONV swe_get_ayanamsa_ex(double tjd_et, int32 iflag, double *daya, char *serr)
3000 {
3001 struct nut nuttmp;
3002 struct nut *nutp = &nuttmp; /* dummy assign, to silence gcc warning */
3003 int32 retval = swi_get_ayanamsa_ex(tjd_et, iflag, daya, serr);
3004 if (!(iflag & SEFLG_NONUT)) {
3005 if (tjd_et == swed.nut.tnut) {
3006 nutp = &swed.nut;
3007 } else {
3008 nutp = &nuttmp;
3009 swi_nutation(tjd_et, iflag, nutp->nutlo);
3010 }
3011 *daya += nutp->nutlo[0] * RADTODEG;
3012 }
3013 return retval;
3014 }
3015
3016 /*
3017 * Function calculates a correction for ayanamsha if the ayanamsha was
3018 * defined using a different precession model than our standard one.
3019 * This allows us to use this ayanamsha with our standard precession
3020 * model and still remain very accurate in ephemeris positions.
3021 * It has the effect that ayanamsha values change depending on the precession
3022 * model used, but sidereal planetary positions remain the same.
3023 *
3024 * For this function to work correctly, our standard precession model
3025 * must be relative to J2000. Any future precession model should not
3026 * use a different starting epoch.
3027 */
get_aya_correction(int iflag,double * corr,char * serr)3028 static int get_aya_correction(int iflag, double *corr, char *serr) {
3029 double x[6], eps, t0;
3030 struct sid_data *sip = &swed.sidd;
3031 int prec_model = swed.astro_models[SE_MODEL_PREC_LONGTERM];
3032 int prec_model_short = swed.astro_models[SE_MODEL_PREC_SHORTTERM];
3033 int prec_offset = 0;
3034 int sid_mode = sip->sid_mode;
3035 sid_mode %= SE_SIDBITS;
3036 *corr = 0;
3037 if (sip->t0 == J2000)
3038 return 0;
3039 if (sip->sid_mode & SE_SIDBIT_NO_PREC_OFFSET)
3040 return 0;
3041 prec_offset = ayanamsa[sid_mode].prec_offset;
3042 if (prec_offset < 0) prec_offset = 0;
3043 if (prec_model == prec_offset)
3044 return 0;
3045 t0 = sip->t0;
3046 if (sip->t0_is_UT)
3047 t0 += swe_deltat_ex(t0, iflag, serr);
3048 /* vernal point (tjd), cartesian */
3049 x[0] = 1;
3050 x[1] = x[2] = 0;
3051 swi_precess(x, t0, 0, J_TO_J2000);
3052 swed.astro_models[SE_MODEL_PREC_LONGTERM] = prec_offset;
3053 swed.astro_models[SE_MODEL_PREC_SHORTTERM] = prec_offset;
3054 swi_precess(x, t0, 0, J2000_TO_J);
3055 swed.astro_models[SE_MODEL_PREC_LONGTERM] = prec_model;
3056 swed.astro_models[SE_MODEL_PREC_SHORTTERM] = prec_model_short;
3057 /* to ecliptic */
3058 eps = swi_epsiln(t0, 0);
3059 swi_coortrf(x, x, eps);
3060 /* to polar */
3061 swi_cartpol(x, x);
3062 /* get ayanamsa */
3063 *corr = x[0] * RADTODEG;
3064 if (*corr > 350 /*correct!*/) *corr -= 360; // a signed value near 0
3065 //fprintf(stderr, "corr=%f\n", *corr * 3600.0);
3066 return OK;
3067 }
3068
swi_get_ayanamsa_ex(double tjd_et,int32 iflag,double * daya,char * serr)3069 int32 swi_get_ayanamsa_ex(double tjd_et, int32 iflag, double *daya, char *serr)
3070 {
3071 double x[6], eps, t0, corr;
3072 struct sid_data *sip = &swed.sidd;
3073 char star[AS_MAXCH];
3074 int32 epheflag, otherflag, retflag, iflag_true, iflag_galequ;
3075 int sid_mode = sip->sid_mode;
3076 iflag = plaus_iflag(iflag, -1, tjd_et, serr);
3077 epheflag = iflag & SEFLG_EPHMASK;
3078 otherflag = iflag & ~SEFLG_EPHMASK;
3079 *daya = 0.0;
3080 iflag &= SEFLG_EPHMASK;
3081 iflag |= SEFLG_NONUT;
3082 sid_mode %= SE_SIDBITS;
3083 /* ayanamshas based on the intersection point of galactic equator and
3084 * ecliptic always need SEFLG_TRUEPOS, because position of galactic
3085 * pole is required without aberration or light deflection */
3086 iflag_galequ = iflag | SEFLG_TRUEPOS;
3087 #if 1
3088 /* _TRUE_ ayanamshas can have the following SEFLG_s;
3089 * The star will have the intended fixed position even if these flags are
3090 * provided */
3091 iflag_true = iflag;
3092 if (otherflag & SEFLG_TRUEPOS) iflag_true |= SEFLG_TRUEPOS;
3093 if (otherflag & SEFLG_NOABERR) iflag_true |= SEFLG_NOABERR;
3094 if (otherflag & SEFLG_NOGDEFL) iflag_true |= SEFLG_NOGDEFL;
3095 #endif
3096 /* warning, if swe_set_ephe_path() or swe_set_jplfile() was not called yet,
3097 * although ephemeris files are required */
3098 if (swi_init_swed_if_start() == 1 && !(epheflag & SEFLG_MOSEPH)
3099 && (sid_mode == SE_SIDM_TRUE_CITRA
3100 || sid_mode == SE_SIDM_TRUE_REVATI
3101 || sid_mode == SE_SIDM_TRUE_PUSHYA
3102 || sip->sid_mode == SE_SIDM_TRUE_SHEORAN
3103 || sid_mode == SE_SIDM_TRUE_MULA
3104 || sid_mode == SE_SIDM_GALCENT_0SAG
3105 || sid_mode == SE_SIDM_GALCENT_COCHRANE
3106 || sid_mode == SE_SIDM_GALCENT_RGILBRAND
3107 || sid_mode == SE_SIDM_GALCENT_MULA_WILHELM
3108 || sid_mode == SE_SIDM_GALEQU_IAU1958
3109 || sid_mode == SE_SIDM_GALEQU_TRUE
3110 || sid_mode == SE_SIDM_GALEQU_MULA)
3111 && serr != NULL) {
3112 strcpy(serr, "Please call swe_set_ephe_path() or swe_set_jplfile() before calling swe_get_ayanamsa_ex()");
3113 }
3114 if (!swed.ayana_is_set)
3115 swe_set_sid_mode(SE_SIDM_FAGAN_BRADLEY, 0, 0);
3116 if (sid_mode == SE_SIDM_TRUE_CITRA) {
3117 strcpy(star, "Spica"); /* Citra */
3118 if ((retflag = swe_fixstar(star, tjd_et, iflag_true, x, serr)) == ERR) {
3119 return ERR;
3120 }
3121 /*fprintf(stderr, "serr=%s\n", serr);*/
3122 *daya = swe_degnorm(x[0] - 180);
3123 return (retflag & SEFLG_EPHMASK);
3124 }
3125 if (sid_mode == SE_SIDM_TRUE_REVATI) {
3126 strcpy(star, ",zePsc"); /* Revati */
3127 if ((retflag = swe_fixstar(star, tjd_et, iflag_true, x, serr)) == ERR)
3128 return ERR;
3129 *daya = swe_degnorm(x[0] - 359.8333333333);
3130 return (retflag & SEFLG_EPHMASK);
3131 }
3132 if (sid_mode == SE_SIDM_TRUE_PUSHYA) {
3133 strcpy(star, ",deCnc"); /* Pushya = Asellus Australis */
3134 if ((retflag = swe_fixstar(star, tjd_et, iflag_true, x, serr)) == ERR)
3135 return ERR;
3136 *daya = swe_degnorm(x[0] - 106);
3137 return (retflag & SEFLG_EPHMASK);
3138 }
3139 if (sid_mode == SE_SIDM_TRUE_SHEORAN) {
3140 strcpy(star, ",deCnc"); /* Asellus Australis */
3141 if ((retflag = swe_fixstar(star, tjd_et, iflag_true, x, serr)) == ERR)
3142 return ERR;
3143 *daya = swe_degnorm(x[0] - 103.49264221625);
3144 return (retflag & SEFLG_EPHMASK);
3145 }
3146 if (sid_mode == SE_SIDM_TRUE_MULA) {
3147 strcpy(star, ",laSco"); /* Mula = lambda Scorpionis */
3148 if ((retflag = swe_fixstar(star, tjd_et, iflag_true, x, serr)) == ERR)
3149 return ERR;
3150 *daya = swe_degnorm(x[0] - 240);
3151 return (retflag & SEFLG_EPHMASK);
3152 }
3153 if (sid_mode == SE_SIDM_GALCENT_0SAG) {
3154 strcpy(star, ",SgrA*"); /* Galactic Centre */
3155 if ((retflag = swe_fixstar(star, tjd_et, iflag_true, x, serr)) == ERR)
3156 return ERR;
3157 *daya = swe_degnorm(x[0] - 240.0);
3158 return (retflag & SEFLG_EPHMASK);
3159 /*return swe_degnorm(x[0] - 359.83333333334);*/
3160 }
3161 if (sid_mode == SE_SIDM_GALCENT_COCHRANE) {
3162 strcpy(star, ",SgrA*"); /* Galactic Centre */
3163 if ((retflag = swe_fixstar(star, tjd_et, iflag_true, x, serr)) == ERR)
3164 return ERR;
3165 *daya = swe_degnorm(x[0] - 270.0);
3166 return (retflag & SEFLG_EPHMASK);
3167 /*return swe_degnorm(x[0] - 359.83333333334);*/
3168 }
3169 if (sid_mode == SE_SIDM_GALCENT_RGILBRAND) {
3170 strcpy(star, ",SgrA*"); /* Galactic Centre */
3171 if ((retflag = swe_fixstar(star, tjd_et, iflag_true, x, serr)) == ERR)
3172 return ERR;
3173 *daya = swe_degnorm(x[0] - 210.0 - 90.0 * 0.3819660113);
3174 return (retflag & SEFLG_EPHMASK);
3175 /*return swe_degnorm(x[0] - 359.83333333334);*/
3176 }
3177 if (sid_mode == SE_SIDM_GALCENT_MULA_WILHELM) {
3178 strcpy(star, ",SgrA*"); /* Galactic Centre */
3179 /* right ascension in polar projection onto the ecliptic,
3180 * and that point is put in the middle of Mula */
3181 if ((retflag = swe_fixstar(star, tjd_et, iflag_true | SEFLG_EQUATORIAL, x, serr)) == ERR)
3182 return ERR;
3183 eps = swi_epsiln(tjd_et, iflag) * RADTODEG;
3184 *daya = swi_armc_to_mc(x[0], eps);
3185 *daya = swe_degnorm(*daya - 246.6666666667);
3186 return (retflag & SEFLG_EPHMASK);
3187 /*return swe_degnorm(x[0] - 359.83333333334);*/
3188 }
3189 if (sid_mode == SE_SIDM_GALEQU_IAU1958) {
3190 strcpy(star, ",GP1958"); /* Galactic Pole IAU 1958 */
3191 if ((retflag = swe_fixstar(star, tjd_et, iflag_galequ, x, serr)) == ERR)
3192 return ERR;
3193 *daya = swe_degnorm(x[0] - 150);
3194 return (retflag & SEFLG_EPHMASK);
3195 }
3196 if (sid_mode == SE_SIDM_GALEQU_TRUE) {
3197 strcpy(star, ",GPol"); /* Galactic Pole modern, true */
3198 if ((retflag = swe_fixstar(star, tjd_et, iflag_galequ, x, serr)) == ERR)
3199 return ERR;
3200 *daya = swe_degnorm(x[0] - 150);
3201 return (retflag & SEFLG_EPHMASK);
3202 }
3203 if (sid_mode == SE_SIDM_GALEQU_MULA) {
3204 strcpy(star, ",GPol"); /* Galactic Pole modern, true */
3205 if ((retflag = swe_fixstar(star, tjd_et, iflag_galequ, x, serr)) == ERR)
3206 return ERR;
3207 *daya = swe_degnorm(x[0] - 150 - 6.6666666667);
3208 return (retflag & SEFLG_EPHMASK);
3209 }
3210 if (!(sip->sid_mode & SE_SIDBIT_ECL_DATE)) {
3211 // Now calculate precession for ayanamsha.
3212 // The following is the original method implemented in 1999 and
3213 // still used as our default method, although it is not logical.
3214 // Precession is measured on the ecliptic of the start epoch t0 (ayan_t0),
3215 // then the initial value of ayanamsha is added.
3216 // The procedure is as follows: The vernal point of the end epoch tjd_et
3217 // is precessed to t0. Ayanamsha is the resulting longitude of that
3218 // point at t0 plus the initial value.
3219 // This method is not really consistent because later this ayanamsha,
3220 // which is based on the ecliptic t0, will be applied to planetary
3221 // positions relative to the ecliptic of date.
3222 //
3223 /* vernal point (tjd), cartesian */
3224 x[0] = 1;
3225 x[1] = x[2] = x[3] = x[4] = x[5] = 0;
3226 /* to J2000 */
3227 if (tjd_et != J2000)
3228 swi_precess(x, tjd_et, 0, J_TO_J2000);
3229 /* to t0 */
3230 t0 = sip->t0;
3231 if (sip->t0_is_UT)
3232 t0 += swe_deltat_ex(t0, iflag, serr);
3233 swi_precess(x, t0, 0, J2000_TO_J);
3234 /* to ecliptic t0 */
3235 eps = swi_epsiln(t0, 0);
3236 swi_coortrf(x, x, eps);
3237 /* to polar */
3238 swi_cartpol(x, x);
3239 /* subtract initial value of ayanamsa */
3240 x[0] = -x[0] * RADTODEG + sip->ayan_t0;
3241 } else {
3242 // Alternative method, more consistent, programmed on 15 may 2020.
3243 // The ayanamsha is measured on the ecliptic of date. This is more
3244 // correct because the ayanamsha will be applied to planetary positions
3245 // relative to the ecliptic of date.
3246 //
3247 // at t0, we have ayanamsha sip->ayan_t0
3248 x[0] = swe_degnorm(sip->ayan_t0) * DEGTORAD;
3249 x[1] = 0; x[2] = 1;
3250 // get epsilon for t0
3251 t0 = sip->t0;
3252 if (sip->t0_is_UT)
3253 t0 += swe_deltat_ex(t0, iflag, serr);
3254 eps = swi_epsiln(t0, 0);
3255 // to polar equatorial relative to equinox t0
3256 swi_polcart(x, x);
3257 swi_coortrf(x, x, -eps);
3258 // precess to J2000
3259 if (t0 != J2000)
3260 swi_precess(x, t0, 0, J_TO_J2000);
3261 // precess to date
3262 swi_precess(x, tjd_et, 0, J2000_TO_J);
3263 // epsilon of date
3264 eps = swi_epsiln(tjd_et, 0);
3265 // to polar
3266 swi_coortrf(x, x, eps);
3267 swi_cartpol(x, x);
3268 x[0] = swe_degnorm(x[0] * RADTODEG);
3269 }
3270 get_aya_correction(iflag, &corr, serr);
3271 /* get ayanamsa */
3272 *daya = swe_degnorm(x[0] - corr);
3273 //*daya = swe_degnorm(x[0]);
3274 return iflag;
3275 }
3276
swi_get_ayanamsa_with_speed(double tjd_et,int32 iflag,double * daya,char * serr)3277 int32 swi_get_ayanamsa_with_speed(double tjd_et, int32 iflag, double *daya, char *serr)
3278 {
3279 double daya_t2, t2;
3280 double tintv = 0.001;
3281 int32 retflag;
3282 t2 = tjd_et - tintv;
3283 retflag = swi_get_ayanamsa_ex(t2, iflag, &daya_t2, serr);
3284 if (retflag == ERR)
3285 return ERR;
3286 retflag = swi_get_ayanamsa_ex(tjd_et, iflag, daya, serr);
3287 if (retflag == ERR)
3288 return ERR;
3289 daya[1] = (daya[0] - daya_t2) / tintv;
3290 return retflag;
3291 }
3292
swe_get_ayanamsa_ex_ut(double tjd_ut,int32 iflag,double * daya,char * serr)3293 int32 CALL_CONV swe_get_ayanamsa_ex_ut(double tjd_ut, int32 iflag, double *daya, char *serr)
3294 {
3295 double deltat;
3296 int32 retflag = OK;
3297 int32 epheflag = iflag & SEFLG_EPHMASK;
3298 if (epheflag == 0) {
3299 epheflag = SEFLG_SWIEPH;
3300 iflag |= SEFLG_SWIEPH;
3301 }
3302 deltat = swe_deltat_ex(tjd_ut, iflag, serr);
3303 // swe... includes nutation, unless SEFLG_NONUT
3304 retflag = swe_get_ayanamsa_ex(tjd_ut + deltat, iflag, daya, serr);
3305 /* if ephe required is not ephe returned, adjust delta t: */
3306 if ((retflag & SEFLG_EPHMASK) != epheflag) {
3307 deltat = swe_deltat_ex(tjd_ut, retflag, serr);
3308 retflag = swe_get_ayanamsa_ex(tjd_ut + deltat, iflag, daya, serr);
3309 }
3310 return retflag;
3311 }
3312
3313 /* the ayanamsa (precession in longitude)
3314 * according to Newcomb's definition: 360 -
3315 * longitude of the vernal point of t referred to the
3316 * ecliptic of t0.
3317 */
swe_get_ayanamsa(double tjd_et)3318 double CALL_CONV swe_get_ayanamsa(double tjd_et)
3319 {
3320 double daya;
3321 int32 iflag = swi_guess_ephe_flag();
3322 // swi... function never includes nutation
3323 swi_get_ayanamsa_ex(tjd_et, iflag, &daya, NULL);
3324 return daya;
3325 }
3326
swe_get_ayanamsa_ut(double tjd_ut)3327 double CALL_CONV swe_get_ayanamsa_ut(double tjd_ut)
3328 {
3329 double daya;
3330 int32 iflag = swi_guess_ephe_flag();
3331 swi_get_ayanamsa_ex(tjd_ut + swe_deltat_ex(tjd_ut, iflag, NULL), 0, &daya, NULL);
3332 return daya;
3333 }
3334
3335 /*
3336 * input coordinates are J2000, cartesian.
3337 * xout ecliptical sidereal position (relative to ecliptic t0)
3338 * xoutr equatorial sidereal position (relative to equator t0)
3339 */
swi_trop_ra2sid_lon(double * xin,double * xout,double * xoutr,int32 iflag)3340 int swi_trop_ra2sid_lon(double *xin, double *xout, double *xoutr, int32 iflag)
3341 {
3342 double x[6], corr;
3343 int i;
3344 struct sid_data *sip = &swed.sidd;
3345 struct epsilon oectmp;
3346 for (i = 0; i <= 5; i++)
3347 x[i] = xin[i];
3348 if (sip->t0 != J2000) {
3349 /* iflag must not contain SEFLG_JPLHOR here */
3350 swi_precess(x, sip->t0, 0, J2000_TO_J);
3351 swi_precess(x+3, sip->t0, 0, J2000_TO_J); /* speed */
3352 }
3353 for (i = 0; i <= 5; i++)
3354 xoutr[i] = x[i];
3355 calc_epsilon(swed.sidd.t0, iflag, &oectmp);
3356 swi_coortrf2(x, x, oectmp.seps, oectmp.ceps);
3357 if (iflag & SEFLG_SPEED)
3358 swi_coortrf2(x+3, x+3, oectmp.seps, oectmp.ceps);
3359 /* to polar coordinates */
3360 swi_cartpol_sp(x, x);
3361 /* subtract ayan_t0 */
3362 get_aya_correction(iflag, &corr, NULL);
3363 x[0] -= sip->ayan_t0 * DEGTORAD;
3364 x[0] = swe_radnorm(x[0] + corr * DEGTORAD);
3365 /* back to cartesian */
3366 swi_polcart_sp(x, xout);
3367 return OK;
3368 }
3369
3370 /*
3371 * input coordinates are J2000, cartesian.
3372 * xout ecliptical sidereal position
3373 * xoutr equatorial sidereal position
3374 */
swi_trop_ra2sid_lon_sosy(double * xin,double * xout,int32 iflag)3375 int swi_trop_ra2sid_lon_sosy(double *xin, double *xout, int32 iflag)
3376 {
3377 double x[6], x0[6], corr;
3378 int i;
3379 struct sid_data *sip = &swed.sidd;
3380 struct epsilon *oe = &swed.oec2000;
3381 double plane_node = SSY_PLANE_NODE_E2000;
3382 double plane_incl = SSY_PLANE_INCL;
3383 for (i = 0; i <= 5; i++)
3384 x[i] = xin[i];
3385 /* planet to ecliptic 2000 */
3386 swi_coortrf2(x, x, oe->seps, oe->ceps);
3387 if (iflag & SEFLG_SPEED)
3388 swi_coortrf2(x+3, x+3, oe->seps, oe->ceps);
3389 /* to polar coordinates */
3390 swi_cartpol_sp(x, x);
3391 /* to solar system equator */
3392 x[0] -= plane_node;
3393 swi_polcart_sp(x, x);
3394 swi_coortrf(x, x, plane_incl);
3395 swi_coortrf(x+3, x+3, plane_incl);
3396 swi_cartpol_sp(x, x);
3397 /* zero point of t0 in J2000 system */
3398 x0[0] = 1;
3399 x0[1] = x0[2] = 0;
3400 if (sip->t0 != J2000) {
3401 /* iflag must not contain SEFLG_JPLHOR here */
3402 swi_precess(x0, sip->t0, 0, J_TO_J2000);
3403 }
3404 /* zero point to ecliptic 2000 */
3405 swi_coortrf2(x0, x0, oe->seps, oe->ceps);
3406 /* to polar coordinates */
3407 swi_cartpol(x0, x0);
3408 /* to solar system equator */
3409 x0[0] -= plane_node;
3410 swi_polcart(x0, x0);
3411 swi_coortrf(x0, x0, plane_incl);
3412 swi_cartpol(x0, x0);
3413 /* measure planet from zero point */
3414 x[0] -= x0[0];
3415 x[0] *= RADTODEG;
3416 /* subtract ayan_t0 */
3417 get_aya_correction(iflag, &corr, NULL);
3418 x[0] -= sip->ayan_t0;
3419 x[0] = swe_degnorm(x[0] + corr) * DEGTORAD;
3420 /* back to cartesian */
3421 swi_polcart_sp(x, xout);
3422 return OK;
3423 }
3424
3425 /* converts planets from barycentric to geocentric,
3426 * apparent positions
3427 * precession and nutation
3428 * according to flags
3429 * ipli planet number
3430 * iflag flags
3431 */
app_pos_etc_plan_osc(int ipl,int ipli,int32 iflag,char * serr)3432 static int app_pos_etc_plan_osc(int ipl, int ipli, int32 iflag, char *serr)
3433 {
3434 int i, j, niter, retc;
3435 double xx[6], dx[3], dt, dtsave_for_defl;
3436 double xearth[6], xsun[6], xmoon[6];
3437 double xxsv[6], xxsp[3]={0}, xobs[6], xobs2[6];
3438 double t;
3439 struct plan_data *pdp = &swed.pldat[ipli];
3440 struct plan_data *pedp = &swed.pldat[SEI_EARTH];
3441 struct plan_data *psdp = &swed.pldat[SEI_SUNBARY];
3442 struct epsilon *oe = &swed.oec2000;
3443 int32 epheflag = SEFLG_DEFAULTEPH;
3444 dt = dtsave_for_defl = 0; /* dummy assign to silence gcc */
3445 if (iflag & SEFLG_MOSEPH)
3446 epheflag = SEFLG_MOSEPH;
3447 else if (iflag & SEFLG_SWIEPH)
3448 epheflag = SEFLG_SWIEPH;
3449 else if (iflag & SEFLG_JPLEPH)
3450 epheflag = SEFLG_JPLEPH;
3451 /* the conversions will be done with xx[]. */
3452 for (i = 0; i <= 5; i++)
3453 xx[i] = pdp->x[i];
3454 /************************************
3455 * barycentric position is required *
3456 ************************************/
3457 /* = heliocentric position with Moshier ephemeris */
3458 /************************************
3459 * observer: geocenter or topocenter
3460 ************************************/
3461 /* if topocentric position is wanted */
3462 if (iflag & SEFLG_TOPOCTR) {
3463 if (swed.topd.teval != pedp->teval
3464 || swed.topd.teval == 0) {
3465 if (swi_get_observer(pedp->teval, iflag | SEFLG_NONUT, DO_SAVE, xobs, serr) != OK)
3466 return ERR;
3467 } else {
3468 for (i = 0; i <= 5; i++)
3469 xobs[i] = swed.topd.xobs[i];
3470 }
3471 /* barycentric position of observer */
3472 for (i = 0; i <= 5; i++)
3473 xobs[i] = xobs[i] + pedp->x[i];
3474 } else if (iflag & SEFLG_BARYCTR) {
3475 for (i = 0; i <= 5; i++)
3476 xobs[i] = 0;
3477 } else if (iflag & SEFLG_HELCTR) {
3478 if (iflag & SEFLG_MOSEPH) {
3479 for (i = 0; i <= 5; i++)
3480 xobs[i] = 0;
3481 } else {
3482 for (i = 0; i <= 5; i++)
3483 xobs[i] = psdp->x[i];
3484 }
3485 } else {
3486 for (i = 0; i <= 5; i++)
3487 xobs[i] = pedp->x[i];
3488 }
3489 /*******************************
3490 * light-time *
3491 *******************************/
3492 if (!(iflag & SEFLG_TRUEPOS)) {
3493 niter = 1;
3494 if (iflag & SEFLG_SPEED) {
3495 /*
3496 * Apparent speed is influenced by the fact that dt changes with
3497 * motion. This makes a difference of several hundredths of an
3498 * arc second. To take this into account, we compute
3499 * 1. true position - apparent position at time t - 1.
3500 * 2. true position - apparent position at time t.
3501 * 3. the difference between the two is the daily motion resulting from
3502 * the change of dt.
3503 */
3504 for (i = 0; i <= 2; i++)
3505 xxsv[i] = xxsp[i] = xx[i] - xx[i+3];
3506 for (j = 0; j <= niter; j++) {
3507 for (i = 0; i <= 2; i++) {
3508 dx[i] = xxsp[i];
3509 if (!(iflag & SEFLG_HELCTR) && !(iflag & SEFLG_BARYCTR))
3510 dx[i] -= (xobs[i] - xobs[i+3]);
3511 }
3512 /* new dt */
3513 dt = sqrt(square_sum(dx)) * AUNIT / CLIGHT / 86400.0;
3514 for (i = 0; i <= 2; i++)
3515 xxsp[i] = xxsv[i] - dt * pdp->x[i+3];/* rough apparent position */
3516 }
3517 /* true position - apparent position at time t-1 */
3518 for (i = 0; i <= 2; i++)
3519 xxsp[i] = xxsv[i] - xxsp[i];
3520 }
3521 /* dt and t(apparent) */
3522 for (j = 0; j <= niter; j++) {
3523 for (i = 0; i <= 2; i++) {
3524 dx[i] = xx[i];
3525 if (!(iflag & SEFLG_HELCTR) && !(iflag & SEFLG_BARYCTR))
3526 dx[i] -= xobs[i];
3527 }
3528 /* new dt */
3529 dt = sqrt(square_sum(dx)) * AUNIT / CLIGHT / 86400.0;
3530 dtsave_for_defl = dt;
3531 /* new position: subtract t * speed
3532 */
3533 for (i = 0; i <= 2; i++) {
3534 xx[i] = pdp->x[i] - dt * pdp->x[i+3];/**/
3535 xx[i+3] = pdp->x[i+3];
3536 }
3537 }
3538 if (iflag & SEFLG_SPEED) {
3539 /* part of daily motion resulting from change of dt */
3540 for (i = 0; i <= 2; i++)
3541 xxsp[i] = pdp->x[i] - xx[i] - xxsp[i];
3542 t = pdp->teval - dt;
3543 /* for accuracy in speed, we will need earth as well */
3544 retc = main_planet_bary(t, SEI_EARTH, epheflag, iflag, NO_SAVE, xearth, xearth, xsun, xmoon, serr);
3545 if (swi_osc_el_plan(t, xx, ipl-SE_FICT_OFFSET, ipli, xearth, xsun, serr) != OK)
3546 return ERR;
3547 if (retc != OK)
3548 return(retc);
3549 if (iflag & SEFLG_TOPOCTR) {
3550 if (swi_get_observer(t, iflag | SEFLG_NONUT, NO_SAVE, xobs2, serr) != OK)
3551 return ERR;
3552 for (i = 0; i <= 5; i++)
3553 xobs2[i] += xearth[i];
3554 } else {
3555 for (i = 0; i <= 5; i++)
3556 xobs2[i] = xearth[i];
3557 }
3558 }
3559 }
3560 /*******************************
3561 * conversion to geocenter *
3562 *******************************/
3563 for (i = 0; i <= 5; i++)
3564 xx[i] -= xobs[i];
3565 if (!(iflag & SEFLG_TRUEPOS)) {
3566 /*
3567 * Apparent speed is also influenced by
3568 * the change of dt during motion.
3569 * Neglect of this would result in an error of several 0.01"
3570 */
3571 if (iflag & SEFLG_SPEED)
3572 for (i = 3; i <= 5; i++)
3573 xx[i] -= xxsp[i-3];
3574 }
3575 if (!(iflag & SEFLG_SPEED))
3576 for (i = 3; i <= 5; i++)
3577 xx[i] = 0;
3578 /************************************
3579 * relativistic deflection of light *
3580 ************************************/
3581 if (!(iflag & SEFLG_TRUEPOS) && !(iflag & SEFLG_NOGDEFL))
3582 /* SEFLG_NOGDEFL is on, if SEFLG_HELCTR or SEFLG_BARYCTR */
3583 swi_deflect_light(xx, dtsave_for_defl, iflag);
3584 /**********************************
3585 * 'annual' aberration of light *
3586 **********************************/
3587 if (!(iflag & SEFLG_TRUEPOS) && !(iflag & SEFLG_NOABERR)) {
3588 /* SEFLG_NOABERR is on, if SEFLG_HELCTR or SEFLG_BARYCTR */
3589 swi_aberr_light(xx, xobs, iflag);
3590 /*
3591 * Apparent speed is also influenced by
3592 * the difference of speed of the earth between t and t-dt.
3593 * Neglecting this would involve an error of several 0.1"
3594 */
3595 if (iflag & SEFLG_SPEED)
3596 for (i = 3; i <= 5; i++)
3597 xx[i] += xobs[i] - xobs2[i];
3598 }
3599 /* save J2000 coordinates; required for sidereal positions */
3600 for (i = 0; i <= 5; i++)
3601 xxsv[i] = xx[i];
3602 /************************************************
3603 * precession, equator 2000 -> equator of date *
3604 ************************************************/
3605 if (!(iflag & SEFLG_J2000)) {
3606 swi_precess(xx, pdp->teval, iflag, J2000_TO_J);
3607 if (iflag & SEFLG_SPEED)
3608 swi_precess_speed(xx, pdp->teval, iflag, J2000_TO_J);
3609 oe = &swed.oec;
3610 } else
3611 oe = &swed.oec2000;
3612 return app_pos_rest(pdp, iflag, xx, xxsv, oe, serr);
3613 }
3614
3615 /* influence of precession on speed
3616 * xx position and speed of planet in equatorial cartesian
3617 * coordinates */
swi_precess_speed(double * xx,double t,int32 iflag,int direction)3618 void swi_precess_speed(double *xx, double t, int32 iflag, int direction)
3619 {
3620 struct epsilon *oe;
3621 double fac, dpre, dpre2;
3622 double tprec = (t - J2000) / 36525.0;
3623 int prec_model = swed.astro_models[SE_MODEL_PREC_LONGTERM];
3624 if (prec_model == 0) prec_model = SEMOD_PREC_DEFAULT;
3625 if (direction == J2000_TO_J) {
3626 fac = 1;
3627 oe = &swed.oec;
3628 } else {
3629 fac = -1;
3630 oe = &swed.oec2000;
3631 }
3632 /* first correct rotation.
3633 * this costs some sines and cosines, but neglect might
3634 * involve an error > 1"/day */
3635 swi_precess(xx+3, t, iflag, direction);
3636 /* then add 0.137"/day */
3637 swi_coortrf2(xx, xx, oe->seps, oe->ceps);
3638 swi_coortrf2(xx+3, xx+3, oe->seps, oe->ceps);
3639 swi_cartpol_sp(xx, xx);
3640 if (1) {
3641 if (prec_model == SEMOD_PREC_VONDRAK_2011) {
3642 swi_ldp_peps(t, &dpre, NULL);
3643 swi_ldp_peps(t + 1, &dpre2, NULL);
3644 xx[3] += (dpre2 - dpre) * fac;
3645 } else {
3646 xx[3] += (50.290966 + 0.0222226 * tprec) / 3600 / 365.25 * DEGTORAD * fac;
3647 /* formula from Montenbruck, German 1994, p. 18 */
3648 }
3649 }
3650 swi_polcart_sp(xx, xx);
3651 swi_coortrf2(xx, xx, -oe->seps, oe->ceps);
3652 swi_coortrf2(xx+3, xx+3, -oe->seps, oe->ceps);
3653 }
3654
3655 /* multiplies cartesian equatorial coordinates with previously
3656 * calculated nutation matrix. also corrects speed.
3657 */
swi_nutate(double * xx,int32 iflag,AS_BOOL backward)3658 void swi_nutate(double *xx, int32 iflag, AS_BOOL backward)
3659 {
3660 int i;
3661 double x[6], xv[6];
3662 for (i = 0; i <= 2; i++) {
3663 if (backward)
3664 x[i] = xx[0] * swed.nut.matrix[i][0] +
3665 xx[1] * swed.nut.matrix[i][1] +
3666 xx[2] * swed.nut.matrix[i][2];
3667 else
3668 x[i] = xx[0] * swed.nut.matrix[0][i] +
3669 xx[1] * swed.nut.matrix[1][i] +
3670 xx[2] * swed.nut.matrix[2][i];
3671 }
3672 if (iflag & SEFLG_SPEED) {
3673 /* correct speed:
3674 * first correct rotation */
3675 for (i = 0; i <= 2; i++) {
3676 if (backward)
3677 x[i+3] = xx[3] * swed.nut.matrix[i][0] +
3678 xx[4] * swed.nut.matrix[i][1] +
3679 xx[5] * swed.nut.matrix[i][2];
3680 else
3681 x[i+3] = xx[3] * swed.nut.matrix[0][i] +
3682 xx[4] * swed.nut.matrix[1][i] +
3683 xx[5] * swed.nut.matrix[2][i];
3684 }
3685 /* then apparent motion due to change of nutation during day.
3686 * this makes a difference of 0.01" */
3687 for (i = 0; i <= 2; i++) {
3688 if (backward)
3689 xv[i] = xx[0] * swed.nutv.matrix[i][0] +
3690 xx[1] * swed.nutv.matrix[i][1] +
3691 xx[2] * swed.nutv.matrix[i][2];
3692 else
3693 xv[i] = xx[0] * swed.nutv.matrix[0][i] +
3694 xx[1] * swed.nutv.matrix[1][i] +
3695 xx[2] * swed.nutv.matrix[2][i];
3696 /* new speed */
3697 xx[3+i] = x[3+i] + (x[i] - xv[i]) / NUT_SPEED_INTV;
3698 }
3699 }
3700 /* new position */
3701 for (i = 0; i <= 2; i++)
3702 xx[i] = x[i];
3703 }
3704
3705 /* computes 'annual' aberration
3706 * xx planet's position accounted for light-time
3707 * and gravitational light deflection
3708 * xe earth's position and speed
3709 */
aberr_light(double * xx,double * xe)3710 static void aberr_light(double *xx, double *xe) {
3711 int i;
3712 double xxs[6], v[6], u[6], ru;
3713 double b_1, f1, f2;
3714 double v2;
3715 for (i = 0; i <= 5; i++)
3716 u[i] = xxs[i] = xx[i];
3717 ru = sqrt(square_sum(u));
3718 for (i = 0; i <= 2; i++)
3719 v[i] = xe[i+3] / 24.0 / 3600.0 / CLIGHT * AUNIT;
3720 v2 = square_sum(v);
3721 b_1 = sqrt(1 - v2);
3722 f1 = dot_prod(u, v) / ru;
3723 f2 = 1.0 + f1 / (1.0 + b_1);
3724 for (i = 0; i <= 2; i++)
3725 xx[i] = (b_1*xx[i] + f2*ru*v[i]) / (1.0 + f1);
3726 }
3727
3728 /* computes 'annual' aberration
3729 * xx planet's position accounted for light-time
3730 * and gravitational light deflection
3731 * xe earth's position and speed
3732 * xe_dt earth's position and speed at t - dt
3733 * dt time difference for which xe_dt is given
3734 */
swi_aberr_light_ex(double * xx,double * xe,double * xe_dt,double dt,int32 iflag)3735 void swi_aberr_light_ex(double *xx, double *xe, double *xe_dt, double dt, int32 iflag) {
3736 int i;
3737 double xxs[6];
3738 double xx2[6];
3739 for (i = 0; i <= 5; i++) {
3740 xxs[i] = xx[i];
3741 }
3742 aberr_light(xx, xe);
3743 /* correction of speed
3744 * the influence of aberration on apparent velocity can
3745 * reach 0.4"/day
3746 */
3747 if (iflag & SEFLG_SPEED) {
3748 for (i = 0; i <= 2; i++)
3749 xx2[i] = xxs[i] - dt * xxs[i + 3];
3750 aberr_light(xx2, xe_dt);
3751 for (i = 0; i <= 2; i++) {
3752 xx[i+3] = (xx[i] - xx2[i]) / dt;
3753 }
3754 }
3755 }
3756
3757 /* computes 'annual' aberration
3758 * xx planet's position accounted for light-time
3759 * and gravitational light deflection
3760 * xe earth's position and speed
3761 */
swi_aberr_light(double * xx,double * xe,int32 iflag)3762 void swi_aberr_light(double *xx, double *xe, int32 iflag) {
3763 int i;
3764 double xxs[6], v[6], u[6], ru;
3765 double xx2[6], dx1, dx2;
3766 double b_1, f1, f2;
3767 double v2;
3768 double intv = PLAN_SPEED_INTV;
3769 for (i = 0; i <= 5; i++)
3770 u[i] = xxs[i] = xx[i];
3771 ru = sqrt(square_sum(u));
3772 for (i = 0; i <= 2; i++)
3773 v[i] = xe[i+3] / 24.0 / 3600.0 / CLIGHT * AUNIT;
3774 v2 = square_sum(v);
3775 b_1 = sqrt(1 - v2);
3776 f1 = dot_prod(u, v) / ru;
3777 f2 = 1.0 + f1 / (1.0 + b_1);
3778 for (i = 0; i <= 2; i++)
3779 xx[i] = (b_1*xx[i] + f2*ru*v[i]) / (1.0 + f1);
3780 if (iflag & SEFLG_SPEED) {
3781 /* correction of speed
3782 * the influence of aberration on apparent velocity can
3783 * reach 0.4"/day
3784 */
3785 for (i = 0; i <= 2; i++)
3786 u[i] = xxs[i] - intv * xxs[i+3];
3787 ru = sqrt(square_sum(u));
3788 f1 = dot_prod(u, v) / ru;
3789 f2 = 1.0 + f1 / (1.0 + b_1);
3790 for (i = 0; i <= 2; i++)
3791 xx2[i] = (b_1*u[i] + f2*ru*v[i]) / (1.0 + f1);
3792 for (i = 0; i <= 2; i++) {
3793 dx1 = xx[i] - xxs[i];
3794 dx2 = xx2[i] - u[i];
3795 dx1 -= dx2;
3796 xx[i+3] += dx1 / intv;
3797 }
3798 }
3799 }
3800
3801 /* computes relativistic light deflection by the sun
3802 * ipli sweph internal planet number
3803 * xx planet's position accounted for light-time
3804 * dt dt of light-time
3805 */
swi_deflect_light(double * xx,double dt,int32 iflag)3806 void swi_deflect_light(double *xx, double dt, int32 iflag)
3807 {
3808 int i;
3809 double xx2[6];
3810 double u[6], e[6], q[6], ru, re, rq, uq, ue, qe, g1, g2;
3811 #if 1
3812 double xx3[6], dx1, dx2, dtsp;
3813 #endif
3814 double xsun[6], xearth[6];
3815 double sina, sin_sunr, meff_fact;
3816 struct plan_data *pedp = &swed.pldat[SEI_EARTH];
3817 struct plan_data *psdp = &swed.pldat[SEI_SUNBARY];
3818 int32 iephe = pedp->iephe;
3819 for (i = 0; i <= 5; i++)
3820 xearth[i] = pedp->x[i];
3821 if (iflag & SEFLG_TOPOCTR)
3822 for (i = 0; i <= 5; i++)
3823 xearth[i] += swed.topd.xobs[i];
3824 /* U = planetbary(t-tau) - earthbary(t) = planetgeo */
3825 for (i = 0; i <= 2; i++)
3826 u[i] = xx[i];
3827 /* Eh = earthbary(t) - sunbary(t) = earthhel */
3828 if (iephe == SEFLG_JPLEPH || iephe == SEFLG_SWIEPH)
3829 for (i = 0; i <= 2; i++)
3830 e[i] = xearth[i] - psdp->x[i];
3831 else
3832 for (i = 0; i <= 2; i++)
3833 e[i] = xearth[i];
3834 /* Q = planetbary(t-tau) - sunbary(t-tau) = 'planethel' */
3835 /* first compute sunbary(t-tau) for */
3836 if (iephe == SEFLG_JPLEPH || iephe == SEFLG_SWIEPH) {
3837 for (i = 0; i <= 2; i++)
3838 /* this is sufficient precision */
3839 xsun[i] = psdp->x[i] - dt * psdp->x[i+3];
3840 for (i = 3; i <= 5; i++)
3841 xsun[i] = psdp->x[i];
3842 } else {
3843 for (i = 0; i <= 5; i++)
3844 xsun[i] = psdp->x[i];
3845 }
3846 for (i = 0; i <= 2; i++)
3847 q[i] = xx[i] + xearth[i] - xsun[i];
3848 ru = sqrt(square_sum(u));
3849 rq = sqrt(square_sum(q));
3850 re = sqrt(square_sum(e));
3851 for (i = 0; i <= 2; i++) {
3852 u[i] /= ru;
3853 q[i] /= rq;
3854 e[i] /= re;
3855 }
3856 uq = dot_prod(u,q);
3857 ue = dot_prod(u,e);
3858 qe = dot_prod(q,e);
3859 /* When a planet approaches the center of the sun in superior
3860 * conjunction, the formula for the deflection angle as given
3861 * in Expl. Suppl. p. 136 cannot be used. The deflection seems
3862 * to increase rapidly towards infinity. The reason is that the
3863 * formula considers the sun as a point mass. AA recommends to
3864 * set deflection = 0 in such a case.
3865 * However, to get a continous motion, we modify the formula
3866 * for a non-point-mass, taking into account the mass distribution
3867 * within the sun. For more info, s. meff().
3868 */
3869 sina = sqrt(1 - ue * ue); /* sin(angle) between sun and planet */
3870 sin_sunr = SUN_RADIUS / re; /* sine of sun radius (= sun radius) */
3871 if (sina < sin_sunr)
3872 meff_fact = meff(sina / sin_sunr);
3873 else
3874 meff_fact = 1;
3875 g1 = 2.0 * HELGRAVCONST * meff_fact / CLIGHT / CLIGHT / AUNIT / re;
3876 g2 = 1.0 + qe;
3877 /* compute deflected position */
3878 for (i = 0; i <= 2; i++)
3879 xx2[i] = ru * (u[i] + g1/g2 * (uq * e[i] - ue * q[i]));
3880 if (iflag & SEFLG_SPEED) {
3881 /* correction of speed
3882 * influence of light deflection on a planet's apparent speed:
3883 * for an outer planet at the solar limb with
3884 * |v(planet) - v(sun)| = 1 degree, this makes a difference of 7"/day.
3885 * if the planet is within the solar disc, the difference may increase
3886 * to 30" or more.
3887 * e.g. mercury at j2434871.45:
3888 * distance from sun 45"
3889 * 1. speed without deflection 2d10'10".4034
3890 * 2. speed with deflection 2d10'42".8460 (-speed flag)
3891 * 3. speed with deflection 2d10'43".4824 (< 3 positions/
3892 * -speed3 flag)
3893 * 3. is not very precise. Smaller dt would give result closer to 2.,
3894 * but will probably never be as good as 2, unless int32 doubles are
3895 * used. (try also j2434871.46!!)
3896 * however, in such a case speed changes rapidly. before being
3897 * passed by the sun, the planet accelerates, and after the sun
3898 * has passed it slows down. some time later it regains 'normal'
3899 * speed.
3900 * to compute speed, we do the same calculation as above with
3901 * slightly different u, e, q, and find out the difference in
3902 * deflection.
3903 */
3904 dtsp = -DEFL_SPEED_INTV;
3905 /* U = planetbary(t-tau) - earthbary(t) = planetgeo */
3906 for (i = 0; i <= 2; i++)
3907 u[i] = xx[i] - dtsp * xx[i+3];
3908 /* Eh = earthbary(t) - sunbary(t) = earthhel */
3909 if (iephe == SEFLG_JPLEPH || iephe == SEFLG_SWIEPH) {
3910 for (i = 0; i <= 2; i++)
3911 e[i] = xearth[i] - psdp->x[i] -
3912 dtsp * (xearth[i+3] - psdp->x[i+3]);
3913 } else
3914 for (i = 0; i <= 2; i++)
3915 e[i] = xearth[i] - dtsp * xearth[i+3];
3916 /* Q = planetbary(t-tau) - sunbary(t-tau) = 'planethel' */
3917 for (i = 0; i <= 2; i++)
3918 q[i] = u[i] + xearth[i] - xsun[i] -
3919 dtsp * (xearth[i+3] - xsun[i+3]);
3920 ru = sqrt(square_sum(u));
3921 rq = sqrt(square_sum(q));
3922 re = sqrt(square_sum(e));
3923 for (i = 0; i <= 2; i++) {
3924 u[i] /= ru;
3925 q[i] /= rq;
3926 e[i] /= re;
3927 }
3928 uq = dot_prod(u,q);
3929 ue = dot_prod(u,e);
3930 qe = dot_prod(q,e);
3931 sina = sqrt(1 - ue * ue); /* sin(angle) between sun and planet */
3932 sin_sunr = SUN_RADIUS / re; /* sine of sun radius (= sun radius) */
3933 if (sina < sin_sunr)
3934 meff_fact = meff(sina / sin_sunr);
3935 else
3936 meff_fact = 1;
3937 g1 = 2.0 * HELGRAVCONST * meff_fact / CLIGHT / CLIGHT / AUNIT / re;
3938 g2 = 1.0 + qe;
3939 for (i = 0; i <= 2; i++)
3940 xx3[i] = ru * (u[i] + g1/g2 * (uq * e[i] - ue * q[i]));
3941 for (i = 0; i <= 2; i++) {
3942 dx1 = xx2[i] - xx[i];
3943 dx2 = xx3[i] - u[i] * ru;
3944 dx1 -= dx2;
3945 xx[i+3] += dx1 / dtsp;
3946 }
3947 } /* endif speed */
3948 /* deflected position */
3949 for (i = 0; i <= 2; i++)
3950 xx[i] = xx2[i];
3951 }
3952
3953 /* converts the sun from barycentric to geocentric,
3954 * the earth from barycentric to heliocentric
3955 * computes
3956 * apparent position,
3957 * precession, and nutation
3958 * according to flags
3959 * iflag flags
3960 * serr error string
3961 */
app_pos_etc_sun(int32 iflag,char * serr)3962 static int app_pos_etc_sun(int32 iflag, char *serr)
3963 {
3964 int i, j, niter, retc = OK;
3965 int32 flg1, flg2;
3966 double xx[6], xxsv[6], dx[3], dt, t = 0;
3967 double xearth[6], xsun[6], xobs[6];
3968 struct plan_data *pedp = &swed.pldat[SEI_EARTH];
3969 struct plan_data *psdp = &swed.pldat[SEI_SUNBARY];
3970 struct epsilon *oe = &swed.oec2000;
3971 /* if the same conversions have already been done for the same
3972 * date, then return */
3973 flg1 = iflag & ~SEFLG_EQUATORIAL & ~SEFLG_XYZ;
3974 flg2 = pedp->xflgs & ~SEFLG_EQUATORIAL & ~SEFLG_XYZ;
3975 if (flg1 == flg2) {
3976 pedp->xflgs = iflag;
3977 pedp->iephe = iflag & SEFLG_EPHMASK;
3978 return OK;
3979 }
3980 /************************************
3981 * observer: geocenter or topocenter
3982 ************************************/
3983 /* if topocentric position is wanted */
3984 if (iflag & SEFLG_TOPOCTR) {
3985 if (swed.topd.teval != pedp->teval
3986 || swed.topd.teval == 0) {
3987 if (swi_get_observer(pedp->teval, iflag | SEFLG_NONUT, DO_SAVE, xobs, serr) != OK)
3988 return ERR;
3989 } else {
3990 for (i = 0; i <= 5; i++)
3991 xobs[i] = swed.topd.xobs[i];
3992 }
3993 /* barycentric position of observer */
3994 for (i = 0; i <= 5; i++)
3995 xobs[i] = xobs[i] + pedp->x[i];
3996 } else {
3997 /* barycentric position of geocenter */
3998 for (i = 0; i <= 5; i++)
3999 xobs[i] = pedp->x[i];
4000 }
4001 /***************************************
4002 * true heliocentric position of earth *
4003 ***************************************/
4004 if (pedp->iephe == SEFLG_MOSEPH || (iflag & SEFLG_BARYCTR))
4005 for (i = 0; i <= 5; i++)
4006 xx[i] = xobs[i];
4007 else
4008 for (i = 0; i <= 5; i++)
4009 xx[i] = xobs[i] - psdp->x[i];
4010 /*******************************
4011 * light-time *
4012 *******************************/
4013 if (!(iflag & SEFLG_TRUEPOS)) {
4014 /* number of iterations - 1
4015 * the following if() does the following:
4016 * with jpl and swiss ephemeris:
4017 * with geocentric computation of sun:
4018 * light-time correction of barycentric sun position.
4019 * with heliocentric or barycentric computation of earth:
4020 * light-time correction of barycentric earth position.
4021 * with moshier ephemeris (heliocentric!!!):
4022 * with geocentric computation of sun:
4023 * nothing! (aberration will be done later)
4024 * with heliocentric or barycentric computation of earth:
4025 * light-time correction of heliocentric earth position.
4026 */
4027 if (pedp->iephe == SEFLG_JPLEPH || pedp->iephe == SEFLG_SWIEPH
4028 || (iflag & SEFLG_HELCTR) || (iflag & SEFLG_BARYCTR)) {
4029 for (i = 0; i <= 5; i++) {
4030 xearth[i] = xobs[i];
4031 if (pedp->iephe == SEFLG_MOSEPH)
4032 xsun[i] = 0;
4033 else
4034 xsun[i] = psdp->x[i];
4035 }
4036 niter = 1; /* # of iterations */
4037 for (j = 0; j <= niter; j++) {
4038 /* distance earth-sun */
4039 for (i = 0; i <= 2; i++) {
4040 dx[i] = xearth[i];
4041 if (!(iflag & SEFLG_BARYCTR))
4042 dx[i] -= xsun[i];
4043 }
4044 /* new t */
4045 dt = sqrt(square_sum(dx)) * AUNIT / CLIGHT / 86400.0;
4046 t = pedp->teval - dt;
4047 /* new position */
4048 switch(pedp->iephe) {
4049 /* if geocentric sun, new sun at t'
4050 * if heliocentric or barycentric earth, new earth at t' */
4051 case SEFLG_JPLEPH:
4052 if ((iflag & SEFLG_HELCTR) || (iflag & SEFLG_BARYCTR))
4053 retc = swi_pleph(t, J_EARTH, J_SBARY, xearth, serr);
4054 else
4055 retc = swi_pleph(t, J_SUN, J_SBARY, xsun, serr);
4056 if (retc != OK) {
4057 swi_close_jpl_file();
4058 swed.jpl_file_is_open = FALSE;
4059 return(retc);
4060 }
4061 break;
4062 case SEFLG_SWIEPH:
4063 /*
4064 retc = sweph(t, SEI_SUN, SEI_FILE_PLANET, iflag, NULL, NO_SAVE, xearth, serr);
4065 */
4066 if ((iflag & SEFLG_HELCTR) || (iflag & SEFLG_BARYCTR))
4067 retc = sweplan(t, SEI_EARTH, SEI_FILE_PLANET, iflag, NO_SAVE, xearth, NULL, xsun, NULL, serr);
4068 else
4069 retc = sweph(t, SEI_SUNBARY, SEI_FILE_PLANET, iflag, NULL, NO_SAVE, xsun, serr);
4070 break;
4071 case SEFLG_MOSEPH:
4072 if ((iflag & SEFLG_HELCTR) || (iflag & SEFLG_BARYCTR))
4073 retc = swi_moshplan(t, SEI_EARTH, NO_SAVE, xearth, xearth, serr);
4074 /* with moshier there is no barycentric sun */
4075 break;
4076 default:
4077 retc = ERR;
4078 break;
4079 }
4080 if (retc != OK)
4081 return(retc);
4082 }
4083 /* apparent heliocentric earth */
4084 for (i = 0; i <= 5; i++) {
4085 xx[i] = xearth[i];
4086 if (!(iflag & SEFLG_BARYCTR))
4087 xx[i] -= xsun[i];
4088 }
4089 }
4090 }
4091 if (!(iflag & SEFLG_SPEED))
4092 for (i = 3; i <= 5; i++)
4093 xx[i] = 0;
4094 /*******************************
4095 * conversion to geocenter *
4096 *******************************/
4097 if (!(iflag & SEFLG_HELCTR) && !(iflag & SEFLG_BARYCTR))
4098 for (i = 0; i <= 5; i++)
4099 xx[i] = -xx[i];
4100 /**********************************
4101 * 'annual' aberration of light *
4102 **********************************/
4103 if (!(iflag & SEFLG_TRUEPOS) && !(iflag & SEFLG_NOABERR)) {
4104 /* SEFLG_NOABERR is on, if SEFLG_HELCTR or SEFLG_BARYCTR */
4105 swi_aberr_light(xx, xobs, iflag);
4106 }
4107 if (!(iflag & SEFLG_SPEED))
4108 for (i = 3; i <= 5; i++)
4109 xx[i] = 0;
4110 /* ICRS to J2000 */
4111 if (!(iflag & SEFLG_ICRS) && swi_get_denum(SEI_SUN, iflag) >= 403) {
4112 swi_bias(xx, t, iflag, FALSE);
4113 }/**/
4114 /* save J2000 coordinates; required for sidereal positions */
4115 for (i = 0; i <= 5; i++)
4116 xxsv[i] = xx[i];
4117 /************************************************
4118 * precession, equator 2000 -> equator of date *
4119 ************************************************/
4120 if (!(iflag & SEFLG_J2000)) {
4121 swi_precess(xx, pedp->teval, iflag, J2000_TO_J);/**/
4122 if (iflag & SEFLG_SPEED)
4123 swi_precess_speed(xx, pedp->teval, iflag, J2000_TO_J);/**/
4124 oe = &swed.oec;
4125 } else
4126 oe = &swed.oec2000;
4127 return app_pos_rest(pedp, iflag, xx, xxsv, oe, serr);
4128 }
4129
4130
4131 /* transforms the position of the moon:
4132 * heliocentric position
4133 * barycentric position
4134 * astrometric position
4135 * apparent position
4136 * precession and nutation
4137 *
4138 * note:
4139 * for apparent positions, we consider the earth-moon
4140 * system as independant.
4141 * for astrometric positions (SEFLG_NOABERR), we
4142 * consider the motions of the earth and the moon
4143 * related to the solar system barycenter.
4144 */
app_pos_etc_moon(int32 iflag,char * serr)4145 static int app_pos_etc_moon(int32 iflag, char *serr)
4146 {
4147 int i;
4148 int32 flg1, flg2;
4149 double xx[6], xxsv[6], xobs[6], xxm[6], xs[6], xe[6], xobs2[6], dt;
4150 struct plan_data *pedp = &swed.pldat[SEI_EARTH];
4151 struct plan_data *psdp = &swed.pldat[SEI_SUNBARY];
4152 struct plan_data *pdp = &swed.pldat[SEI_MOON];
4153 struct epsilon *oe = &swed.oec;
4154 double t = 0;
4155 int32 retc;
4156 /* if the same conversions have already been done for the same
4157 * date, then return */
4158 flg1 = iflag & ~SEFLG_EQUATORIAL & ~SEFLG_XYZ;
4159 flg2 = pdp->xflgs & ~SEFLG_EQUATORIAL & ~SEFLG_XYZ;
4160 if (flg1 == flg2) {
4161 pdp->xflgs = iflag;
4162 pdp->iephe = iflag & SEFLG_EPHMASK;
4163 return OK;
4164 }
4165 /* the conversions will be done with xx[]. */
4166 for (i = 0; i <= 5; i++) {
4167 xx[i] = pdp->x[i];
4168 xxm[i] = xx[i];
4169 }
4170 /***********************************
4171 * to solar system barycentric
4172 ***********************************/
4173 for (i = 0; i <= 5; i++)
4174 xx[i] += pedp->x[i];
4175 /*******************************
4176 * observer
4177 *******************************/
4178 if (iflag & SEFLG_TOPOCTR) {
4179 if (swed.topd.teval != pdp->teval
4180 || swed.topd.teval == 0) {
4181 if (swi_get_observer(pdp->teval, iflag | SEFLG_NONUT, DO_SAVE, xobs, serr) != OK)
4182 return ERR;
4183 } else {
4184 for (i = 0; i <= 5; i++)
4185 xobs[i] = swed.topd.xobs[i];
4186 }
4187 for (i = 0; i <= 5; i++)
4188 xxm[i] -= xobs[i];
4189 for (i = 0; i <= 5; i++)
4190 xobs[i] += pedp->x[i];
4191 } else if (iflag & SEFLG_BARYCTR) {
4192 for (i = 0; i <= 5; i++)
4193 xobs[i] = 0;
4194 for (i = 0; i <= 5; i++)
4195 xxm[i] += pedp->x[i];
4196 } else if (iflag & SEFLG_HELCTR) {
4197 for (i = 0; i <= 5; i++)
4198 xobs[i] = psdp->x[i];
4199 for (i = 0; i <= 5; i++)
4200 xxm[i] += pedp->x[i] - psdp->x[i];
4201 } else {
4202 for (i = 0; i <= 5; i++)
4203 xobs[i] = pedp->x[i];
4204 }
4205 /*******************************
4206 * light-time *
4207 *******************************/
4208 t = pdp->teval;
4209 if ((iflag & SEFLG_TRUEPOS) == 0) {
4210 dt = sqrt(square_sum(xxm)) * AUNIT / CLIGHT / 86400.0;
4211 t = pdp->teval - dt;
4212 switch(pdp->iephe) {
4213 case SEFLG_JPLEPH:
4214 retc = swi_pleph(t, J_MOON, J_EARTH, xx, serr);
4215 if (retc == OK)
4216 retc = swi_pleph(t, J_EARTH, J_SBARY, xe, serr);
4217 if (retc == OK && (iflag & SEFLG_HELCTR))
4218 retc = swi_pleph(t, J_SUN, J_SBARY, xs, serr);
4219 if (retc != OK) {
4220 swi_close_jpl_file();
4221 swed.jpl_file_is_open = FALSE;
4222 }
4223 for (i = 0; i <= 5; i++)
4224 xx[i] += xe[i];
4225 break;
4226 case SEFLG_SWIEPH:
4227 retc = sweplan(t, SEI_MOON, SEI_FILE_MOON, iflag, NO_SAVE, xx, xe, xs, NULL, serr);
4228 if (retc != OK)
4229 return(retc);
4230 for (i = 0; i <= 5; i++)
4231 xx[i] += xe[i];
4232 break;
4233 case SEFLG_MOSEPH:
4234 /* this method results in an error of a milliarcsec in speed */
4235 for (i = 0; i <= 2; i++) {
4236 xx[i] -= dt * xx[i+3];
4237 xe[i] = pedp->x[i] - dt * pedp->x[i+3];
4238 xe[i+3] = pedp->x[i+3];
4239 xs[i] = 0;
4240 xs[i+3] = 0;
4241 }
4242 break;
4243 }
4244 if (iflag & SEFLG_TOPOCTR) {
4245 if (swi_get_observer(t, iflag | SEFLG_NONUT, NO_SAVE, xobs2, NULL) != OK)
4246 return ERR;
4247 for (i = 0; i <= 5; i++)
4248 xobs2[i] += xe[i];
4249 } else if (iflag & SEFLG_BARYCTR) {
4250 for (i = 0; i <= 5; i++)
4251 xobs2[i] = 0;
4252 } else if (iflag & SEFLG_HELCTR) {
4253 for (i = 0; i <= 5; i++)
4254 xobs2[i] = xs[i];
4255 } else {
4256 for (i = 0; i <= 5; i++)
4257 xobs2[i] = xe[i];
4258 }
4259 }
4260 /*************************
4261 * to correct center
4262 *************************/
4263 for (i = 0; i <= 5; i++)
4264 xx[i] -= xobs[i];
4265 /**********************************
4266 * 'annual' aberration of light *
4267 **********************************/
4268 if (!(iflag & SEFLG_TRUEPOS) && !(iflag & SEFLG_NOABERR)) {
4269 /* SEFLG_NOABERR is on, if SEFLG_HELCTR or SEFLG_BARYCTR */
4270 swi_aberr_light(xx, xobs, iflag);
4271 /*
4272 * Apparent speed is also influenced by
4273 * the difference of speed of the earth between t and t-dt.
4274 * Neglecting this would lead to an error of several 0.1"
4275 */
4276 #if 1
4277 if (iflag & SEFLG_SPEED)
4278 for (i = 3; i <= 5; i++)
4279 xx[i] += xobs[i] - xobs2[i];
4280 #endif
4281 }
4282 /* if !speedflag, speed = 0 */
4283 if (!(iflag & SEFLG_SPEED))
4284 for (i = 3; i <= 5; i++)
4285 xx[i] = 0;
4286 /* ICRS to J2000 */
4287 if (!(iflag & SEFLG_ICRS) && swi_get_denum(SEI_MOON, iflag) >= 403) {
4288 swi_bias(xx, t, iflag, FALSE);
4289 }/**/
4290 /* save J2000 coordinates; required for sidereal positions */
4291 for (i = 0; i <= 5; i++)
4292 xxsv[i] = xx[i];
4293 /************************************************
4294 * precession, equator 2000 -> equator of date *
4295 ************************************************/
4296 if (!(iflag & SEFLG_J2000)) {
4297 swi_precess(xx, pdp->teval, iflag, J2000_TO_J);
4298 if (iflag & SEFLG_SPEED)
4299 swi_precess_speed(xx, pdp->teval, iflag, J2000_TO_J);
4300 oe = &swed.oec;
4301 } else
4302 oe = &swed.oec2000;
4303 return app_pos_rest(pdp, iflag, xx, xxsv, oe, serr);
4304 }
4305
4306 /* transforms the position of the barycentric sun:
4307 * precession and nutation
4308 * according to flags
4309 * iflag flags
4310 * serr error string
4311 */
app_pos_etc_sbar(int32 iflag,char * serr)4312 static int app_pos_etc_sbar(int32 iflag, char *serr)
4313 {
4314 int i;
4315 double xx[6], xxsv[6], dt;
4316 struct plan_data *psdp = &swed.pldat[SEI_EARTH];
4317 struct plan_data *psbdp = &swed.pldat[SEI_SUNBARY];
4318 struct epsilon *oe = &swed.oec;
4319 /* the conversions will be done with xx[]. */
4320 for (i = 0; i <= 5; i++)
4321 xx[i] = psbdp->x[i];
4322 /**************
4323 * light-time *
4324 **************/
4325 if (!(iflag & SEFLG_TRUEPOS)) {
4326 dt = sqrt(square_sum(xx)) * AUNIT / CLIGHT / 86400.0;
4327 for (i = 0; i <= 2; i++)
4328 xx[i] -= dt * xx[i+3]; /* apparent position */
4329 }
4330 if (!(iflag & SEFLG_SPEED))
4331 for (i = 3; i <= 5; i++)
4332 xx[i] = 0;
4333 /* ICRS to J2000 */
4334 if (!(iflag & SEFLG_ICRS) && swi_get_denum(SEI_SUN, iflag) >= 403) {
4335 swi_bias(xx, psdp->teval, iflag, FALSE);
4336 }/**/
4337 /* save J2000 coordinates; required for sidereal positions */
4338 for (i = 0; i <= 5; i++)
4339 xxsv[i] = xx[i];
4340 /************************************************
4341 * precession, equator 2000 -> equator of date *
4342 ************************************************/
4343 if (!(iflag & SEFLG_J2000)) {
4344 swi_precess(xx, psbdp->teval, iflag, J2000_TO_J);
4345 if (iflag & SEFLG_SPEED)
4346 swi_precess_speed(xx, psbdp->teval, iflag, J2000_TO_J);
4347 oe = &swed.oec;
4348 } else
4349 oe = &swed.oec2000;
4350 return app_pos_rest(psdp, iflag, xx, xxsv, oe, serr);
4351 }
4352
4353 /* transforms position of mean lunar node or apogee:
4354 * input is polar coordinates in mean ecliptic of date.
4355 * output is, according to iflag:
4356 * position accounted for light-time
4357 * position referred to J2000 (i.e. precession subtracted)
4358 * position with nutation
4359 * equatorial coordinates
4360 * cartesian coordinates
4361 * heliocentric position is not allowed ??????????????
4362 * DAS WAERE ZIEMLICH AUFWENDIG. SONNE UND ERDE MUESSTEN
4363 * SCHON VORHANDEN SEIN!
4364 * ipl bodynumber (SE_MEAN_NODE or SE_MEAN_APOG)
4365 * iflag flags
4366 * serr error string
4367 */
app_pos_etc_mean(int ipl,int32 iflag,char * serr)4368 static int app_pos_etc_mean(int ipl, int32 iflag, char *serr)
4369 {
4370 int i;
4371 int32 flg1, flg2;
4372 double xx[6], xxsv[6];
4373 #if 0
4374 struct node_data *pdp = &swed.nddat[ipl];
4375 #else
4376 struct plan_data *pdp = &swed.nddat[ipl];
4377 #endif
4378 struct epsilon *oe;
4379 /* if the same conversions have already been done for the same
4380 * date, then return */
4381 flg1 = iflag & ~SEFLG_EQUATORIAL & ~SEFLG_XYZ;
4382 flg2 = pdp->xflgs & ~SEFLG_EQUATORIAL & ~SEFLG_XYZ;
4383 if (flg1 == flg2) {
4384 pdp->xflgs = iflag;
4385 pdp->iephe = iflag & SEFLG_EPHMASK;
4386 return OK;
4387 }
4388 for (i = 0; i <= 5; i++)
4389 xx[i] = pdp->x[i];
4390 /* cartesian equatorial coordinates */
4391 swi_polcart_sp(xx, xx);
4392 swi_coortrf2(xx, xx, -swed.oec.seps, swed.oec.ceps);
4393 swi_coortrf2(xx+3, xx+3, -swed.oec.seps, swed.oec.ceps);
4394 #if 0
4395 /****************************************************
4396 * light-time, this is only a few milliarcseconds *
4397 ***************************************************/
4398 if ((iflag & SEFLG_TRUEPOS) == 0) {
4399 dt = pdp->x[3] * AUNIT / CLIGHT / 86400;
4400 for (i = 0; i <= 2; i++)
4401 xx[i] -= dt * xx[i+3];
4402 }
4403 #endif
4404 if (!(iflag & SEFLG_SPEED))
4405 for (i = 3; i <= 5; i++)
4406 xx[i] = 0;
4407 /* J2000 coordinates; required for sidereal positions */
4408 if (((iflag & SEFLG_SIDEREAL)
4409 && (swed.sidd.sid_mode & SE_SIDBIT_ECL_T0))
4410 || (swed.sidd.sid_mode & SE_SIDBIT_SSY_PLANE)) {
4411 for (i = 0; i <= 5; i++)
4412 xxsv[i] = xx[i];
4413 /* xxsv is not J2000 yet! */
4414 if (pdp->teval != J2000) {
4415 swi_precess(xxsv, pdp->teval, iflag, J_TO_J2000);
4416 if (iflag & SEFLG_SPEED)
4417 swi_precess_speed(xxsv, pdp->teval, iflag, J_TO_J2000);
4418 }
4419 }
4420 /*****************************************************
4421 * if no precession, equator of date -> equator 2000 *
4422 *****************************************************/
4423 if (iflag & SEFLG_J2000) {
4424 swi_precess(xx, pdp->teval, iflag, J_TO_J2000);
4425 if (iflag & SEFLG_SPEED)
4426 swi_precess_speed(xx, pdp->teval, iflag, J_TO_J2000);
4427 oe = &swed.oec2000;
4428 } else
4429 oe = &swed.oec;
4430 return app_pos_rest(pdp, iflag, xx, xxsv, oe, serr);
4431 }
4432
4433 /* fetch chebyshew coefficients from sweph file for
4434 * tjd time
4435 * ipli planet number
4436 * ifno file number
4437 * serr error string
4438 */
get_new_segment(double tjd,int ipli,int ifno,char * serr)4439 static int get_new_segment(double tjd, int ipli, int ifno, char *serr)
4440 {
4441 int i, j, k, m, n, o, icoord, retc;
4442 int32 iseg;
4443 int32 fpos;
4444 int nsizes, nsize[6];
4445 int nco;
4446 int idbl;
4447 unsigned char c[4];
4448 struct plan_data *pdp = &swed.pldat[ipli];
4449 struct file_data *fdp = &swed.fidat[ifno];
4450 FILE *fp = fdp->fptr;
4451 int freord = (int) fdp->iflg & SEI_FILE_REORD;
4452 int fendian = (int) fdp->iflg & SEI_FILE_LITENDIAN;
4453 uint32 longs[MAXORD+1];
4454 /* compute segment number */
4455 iseg = (int32) ((tjd - pdp->tfstart) / pdp->dseg);
4456 /*if (tjd - pdp->tfstart < 0)
4457 return(NOT_AVAILABLE);*/
4458 pdp->tseg0 = pdp->tfstart + iseg * pdp->dseg;
4459 pdp->tseg1 = pdp->tseg0 + pdp->dseg;
4460 /* get file position of coefficients from file */
4461 fpos = pdp->lndx0 + iseg * 3;
4462 retc = do_fread((void *) &fpos, 3, 1, 4, fp, fpos, freord, fendian, ifno, serr);
4463 if (retc != OK)
4464 goto return_error_gns;
4465 fseek(fp, fpos, SEEK_SET);
4466 /* clear space of chebyshew coefficients */
4467 if (pdp->segp == NULL)
4468 pdp->segp = (double *) malloc((size_t) pdp->ncoe * 3 * 8);
4469 memset((void *) pdp->segp, 0, (size_t) pdp->ncoe * 3 * 8);
4470 /* read coefficients for 3 coordinates */
4471 for (icoord = 0; icoord < 3; icoord++) {
4472 idbl = icoord * pdp->ncoe;
4473 /* first read header */
4474 /* first bit indicates number of sizes of packed coefficients */
4475 retc = do_fread((void *) &c[0], 1, 2, 1, fp, SEI_CURR_FPOS, freord, fendian, ifno, serr);
4476 if (retc != OK)
4477 goto return_error_gns;
4478 if (c[0] & 128) {
4479 nsizes = 6;
4480 retc = do_fread((void *) (c+2), 1, 2, 1, fp, SEI_CURR_FPOS, freord, fendian, ifno, serr);
4481 if (retc != OK)
4482 goto return_error_gns;
4483 nsize[0] = (int) c[1] / 16;
4484 nsize[1] = (int) c[1] % 16;
4485 nsize[2] = (int) c[2] / 16;
4486 nsize[3] = (int) c[2] % 16;
4487 nsize[4] = (int) c[3] / 16;
4488 nsize[5] = (int) c[3] % 16;
4489 nco = nsize[0] + nsize[1] + nsize[2] + nsize[3] + nsize[4] + nsize[5];
4490 } else {
4491 nsizes = 4;
4492 nsize[0] = (int) c[0] / 16;
4493 nsize[1] = (int) c[0] % 16;
4494 nsize[2] = (int) c[1] / 16;
4495 nsize[3] = (int) c[1] % 16;
4496 nco = nsize[0] + nsize[1] + nsize[2] + nsize[3];
4497 }
4498 /* there may not be more coefficients than interpolation
4499 * order + 1 */
4500 if (nco > pdp->ncoe) {
4501 if (serr != NULL) {
4502 sprintf(serr, "error in ephemeris file: %d coefficients instead of %d. ", nco, pdp->ncoe);
4503 if (strlen(serr) + strlen(fdp->fnam) < AS_MAXCH - 1) {
4504 sprintf(serr, "error in ephemeris file %s: %d coefficients instead of %d. ", fdp->fnam, nco, pdp->ncoe);
4505 }
4506 }
4507 free(pdp->segp);
4508 pdp->segp = NULL;
4509 return (ERR);
4510 }
4511 /* now unpack */
4512 for (i = 0; i < nsizes; i++) {
4513 if (nsize[i] == 0)
4514 continue;
4515 if (i < 4) {
4516 j = (4 - i);
4517 k = nsize[i];
4518 retc = do_fread((void *) &longs[0], j, k, 4, fp, SEI_CURR_FPOS, freord, fendian, ifno, serr);
4519 if (retc != OK)
4520 goto return_error_gns;
4521 for (m = 0; m < k; m++, idbl++) {
4522 if (longs[m] & 1) /* will be negative */
4523 pdp->segp[idbl] = -(((longs[m]+1) / 2) / 1e+9 * pdp->rmax / 2);
4524 else
4525 pdp->segp[idbl] = (longs[m] / 2) / 1e+9 * pdp->rmax / 2;
4526 }
4527 } else if (i == 4) { /* half byte packing */
4528 j = 1;
4529 k = (nsize[i] + 1) / 2;
4530 retc = do_fread((void *) longs, j, k, 4, fp, SEI_CURR_FPOS, freord, fendian, ifno, serr);
4531 if (retc != OK)
4532 goto return_error_gns;
4533 for (m = 0, j = 0;
4534 m < k && j < nsize[i];
4535 m++) {
4536 for (n = 0, o = 16;
4537 n < 2 && j < nsize[i];
4538 n++, j++, idbl++, longs[m] %= o, o /= 16) {
4539 if (longs[m] & o)
4540 pdp->segp[idbl] =
4541 -(((longs[m]+o) / o / 2) * pdp->rmax / 2 / 1e+9);
4542 else
4543 pdp->segp[idbl] = (longs[m] / o / 2) * pdp->rmax / 2 / 1e+9;
4544 }
4545 }
4546 } else if (i == 5) { /* quarter byte packing */
4547 j = 1;
4548 k = (nsize[i] + 3) / 4;
4549 retc = do_fread((void *) longs, j, k, 4, fp, SEI_CURR_FPOS, freord, fendian, ifno, serr);
4550 if (retc != OK)
4551 goto return_error_gns;
4552 for (m = 0, j = 0;
4553 m < k && j < nsize[i];
4554 m++) {
4555 for (n = 0, o = 64;
4556 n < 4 && j < nsize[i];
4557 n++, j++, idbl++, longs[m] %= o, o /= 4) {
4558 if (longs[m] & o)
4559 pdp->segp[idbl] =
4560 -(((longs[m]+o) / o / 2) * pdp->rmax / 2 / 1e+9);
4561 else
4562 pdp->segp[idbl] = (longs[m] / o / 2) * pdp->rmax / 2 / 1e+9;
4563 }
4564 }
4565 }
4566 }
4567 }
4568 #if 0
4569 if (ipli == SEI_SUNBARY) {
4570 printf("%d, %x\n", fpos, fpos);
4571 for (i = 0; i < pdp->ncoe; i++)
4572 printf("%e, %e, %e\n", pdp->segp[i], pdp->segp[i+pdp->ncoe], pdp->segp[i+2*pdp->ncoe]);
4573 }
4574 #endif
4575 return(OK);
4576 return_error_gns:
4577 fclose(fdp->fptr);
4578 // free(fdp->fptr); is not from malloc(), must not be freed by us
4579 fdp->fptr = NULL;
4580 free_planets();
4581 return ERR;
4582 }
4583
4584 /* SWISSEPH
4585 * reads constants on ephemeris file
4586 * ifno file #
4587 * serr error string
4588 */
read_const(int ifno,char * serr)4589 static int read_const(int ifno, char *serr)
4590 {
4591 char *c, c2, *sp;
4592 char s[AS_MAXCH*2], s2[AS_MAXCH];
4593 char sastnam[41];
4594 int i, ipli, kpl;
4595 int retc;
4596 int fendian, freord;
4597 int lastnam = 19;
4598 FILE *fp;
4599 int32 lng;
4600 uint32 ulng;
4601 int32 flen, fpos;
4602 short nplan;
4603 int32 testendian;
4604 double doubles[20];
4605 struct plan_data *pdp;
4606 struct file_data *fdp = &swed.fidat[ifno];
4607 char *serr_file_damage = "Ephemeris file %s is damaged (0%s). ";
4608 char *smsg = "";
4609 int nbytes_ipl = 2;
4610 fp = fdp->fptr;
4611 /*************************************
4612 * version number of file *
4613 *************************************/
4614 sp = fgets(s, AS_MAXCH, fp);
4615 if (sp == NULL || strstr(sp, "\r\n") == NULL) {
4616 goto file_damage;
4617 }
4618 sp = strchr(s, '\r');
4619 *sp = '\0';
4620 sp = s;
4621 while (isdigit((int) *sp) == 0 && *sp != '\0')
4622 sp++;
4623 if (*sp == '\0') {
4624 smsg = "a";
4625 goto file_damage;
4626 }
4627 /* version unused so far */
4628 fdp->fversion = atoi(sp);
4629 /*************************************
4630 * correct file name? *
4631 *************************************/
4632 sp = fgets(s, AS_MAXCH, fp);
4633 if (sp == NULL || strstr(sp, "\r\n") == NULL) {
4634 smsg = "b";
4635 goto file_damage;
4636 }
4637 /* file name, without path */
4638 sp = strrchr(fdp->fnam, (int) *DIR_GLUE);
4639 if (sp == NULL)
4640 sp = fdp->fnam;
4641 else
4642 sp++;
4643 strcpy(s2, sp);
4644 /* to lower case */
4645 for (sp = s2; *sp != '\0'; sp++)
4646 *sp = tolower((int) *sp);
4647 /* prepare string of should-be file name */
4648 sp = s + strlen(s) - 1;
4649 while (*sp == '\n' || *sp == '\r' || *sp == ' ') {
4650 *sp = '\0';
4651 sp--;
4652 }
4653 for (sp = s; *sp != '\0'; sp++)
4654 *sp = tolower((int) *sp);
4655 if (strcmp(s2, s) != 0) {
4656 if (serr != NULL) {
4657 sprintf(serr, "Ephemeris file name '%s' wrong; rename '%s' ", s2, s);
4658 }
4659 goto return_error;
4660 }
4661 /*************************************
4662 * copyright *
4663 *************************************/
4664 sp = fgets(s, AS_MAXCH, fp);
4665 if (sp == NULL || strstr(sp, "\r\n") == NULL) {
4666 smsg = "c";
4667 goto file_damage;
4668 }
4669 /****************************************
4670 * orbital elements, if single asteroid *
4671 ****************************************/
4672 if (ifno == SEI_FILE_ANY_AST) {
4673 sp = fgets(s, AS_MAXCH * 2, fp);
4674 if (sp == NULL || strstr(sp, "\r\n") == NULL) {
4675 smsg = "d";
4676 goto file_damage;
4677 }
4678 /* MPC number and name; will be analyzed below:
4679 * search "asteroid name" */
4680 while(*sp == ' ') sp++;
4681 while(isdigit(*sp)) sp++;
4682 sp++;
4683 i = (int) (sp - s);
4684 strncpy(sastnam, s, lastnam+i); // fixed 19-nov-19
4685 *(sastnam+lastnam+i) = '\0';
4686 /* save elements, they are required for swe_plan_pheno() */
4687 strcpy(swed.astelem, s);
4688 /* required for magnitude */
4689 swed.ast_H = atof(s + 35 + i);
4690 swed.ast_G = atof(s + 42 + i);
4691 if (swed.ast_G == 0) swed.ast_G = 0.15;
4692 /* diameter in kilometers, not always given: */
4693 strncpy(s2, s+51+i, 7);
4694 *(s2 + 7) = '\0';
4695 swed.ast_diam = atof(s2);
4696 if (swed.ast_diam == 0) {
4697 /* estimate the diameter from magnitude; assume albedo = 0.15 */
4698 swed.ast_diam = 1329/sqrt(0.15) * pow(10, -0.2 * swed.ast_H);
4699 }
4700 #if 0
4701 i = 5;
4702 while (*(sp+i) != ' ')
4703 i++;
4704 j = i - 5;
4705 strncpy(sastnam, sp, lastnam+i);
4706 *(sastnam+lastnam+i) = 0;
4707 /* save elements, they are required for swe_plan_pheno() */
4708 strcpy(swed.astelem, s);
4709 /* required for magnitude */
4710 swed.ast_G = atof(sp + 40 + j);
4711 swed.ast_H = atof(sp + 46 + j);
4712 /* diameter in kilometers, not always given: */
4713 strncpy(s2, sp+56+j, 7);
4714 *(s2 + 7) = '\0';
4715 swed.ast_diam = atof(s2);
4716 #endif
4717 }
4718 /*************************************
4719 * one int32 for test of byte order *
4720 *************************************/
4721 if (fread((void *) &testendian, 4, 1, fp) != 1) {
4722 smsg = "e";
4723 goto file_damage;
4724 }
4725 /* is byte order correct? */
4726 if (testendian == SEI_FILE_TEST_ENDIAN) {
4727 freord = SEI_FILE_NOREORD;
4728 } else {
4729 freord = SEI_FILE_REORD;
4730 sp = (char *) &lng;
4731 c = (char *) &testendian;
4732 for (i = 0; i < 4; i++)
4733 *(sp+i) = *(c+3-i);
4734 if (lng != SEI_FILE_TEST_ENDIAN) {
4735 smsg = "f";
4736 goto file_damage;
4737 }
4738 }
4739 /* is file bigendian or littlendian?
4740 * test first byte of test integer, which is highest if bigendian */
4741 c = (char *) &testendian;
4742 c2 = SEI_FILE_TEST_ENDIAN / 16777216L;
4743 if (*c == c2)
4744 fendian = SEI_FILE_BIGENDIAN;
4745 else
4746 fendian = SEI_FILE_LITENDIAN;
4747 fdp->iflg = (int32) freord | fendian;
4748 /*************************************
4749 * length of file correct? *
4750 *************************************/
4751 retc = do_fread((void *) &lng, 4, 1, 4, fp, SEI_CURR_FPOS, freord,
4752 fendian, ifno, serr);
4753 if (retc != OK)
4754 goto return_error;
4755 fpos = ftell(fp);
4756 if (fseek(fp, 0L, SEEK_END) != 0) {
4757 smsg = "g";
4758 goto file_damage;
4759 }
4760 flen = ftell(fp);
4761 if (lng != flen) {
4762 smsg = "h";
4763 goto file_damage;
4764 }
4765 /**********************************************************
4766 * DE number of JPL ephemeris which this file is based on *
4767 **********************************************************/
4768 retc = do_fread((void *) &fdp->sweph_denum, 4, 1, 4, fp, fpos, freord,
4769 fendian, ifno, serr);
4770 if (retc != OK)
4771 goto return_error;
4772 /*************************************
4773 * start and end epoch of file *
4774 *************************************/
4775 retc = do_fread((void *) &fdp->tfstart, 8, 1, 8, fp, SEI_CURR_FPOS,
4776 freord, fendian, ifno, serr);
4777 if (retc != OK)
4778 goto return_error;
4779 retc = do_fread((void *) &fdp->tfend, 8, 1, 8, fp, SEI_CURR_FPOS, freord,
4780 fendian, ifno, serr);
4781 if (retc != OK)
4782 goto return_error;
4783 /*************************************
4784 * how many planets are in file? *
4785 *************************************/
4786 retc = do_fread((void *) &nplan, 2, 1, 2, fp, SEI_CURR_FPOS, freord, fendian, ifno, serr);
4787 if (retc != OK)
4788 goto return_error;
4789 if (nplan > 256) {
4790 nbytes_ipl = 4;
4791 nplan %= 256;
4792 }
4793 if (nplan < 1 || nplan > 20) {
4794 smsg = "i";
4795 goto file_damage;
4796 }
4797 fdp->npl = nplan;
4798 /* which ones? */
4799 retc = do_fread((void *) fdp->ipl, nbytes_ipl, (int) nplan, sizeof(int), fp, SEI_CURR_FPOS,
4800 freord, fendian, ifno, serr);
4801 if (retc != OK)
4802 goto return_error;
4803 /*************************************
4804 * asteroid name *
4805 *************************************/
4806 if (ifno == SEI_FILE_ANY_AST) {
4807 char sastno[12];
4808 int j;
4809 /* name of asteroid is taken from orbital elements record
4810 * read above */
4811 j = 4; /* old astorb.dat had only 4 characters for MPC# */
4812 while (sastnam[j] != ' ' && j < 10) /* new astorb.dat has 5 */
4813 j++;
4814 strncpy(sastno, sastnam, j);
4815 sastno[j] = '\0';
4816 i = (int) atol(sastno);
4817 if (i == fdp->ipl[0] - SE_AST_OFFSET ||
4818 i == fdp->ipl[0] // planetary moon
4819 ) {
4820 /* element record is from bowell database */
4821 strncpy(fdp->astnam, sastnam+j+1, lastnam);
4822 fdp->astnam[lastnam] = '\0';
4823 /* overread old ast. name field */
4824 if (fread((void *) s, 30, 1, fp) != 1) {
4825 smsg = "j";
4826 goto file_damage;
4827 }
4828 } else {
4829 /* older elements record structure: the name
4830 * is taken from old name field */
4831 if (fread((void *) fdp->astnam, 30, 1, fp) != 1) {
4832 smsg = "k";
4833 goto file_damage;
4834 }
4835 }
4836 /* in worst case strlen of not null terminated area! */
4837 i = (int) (strlen(fdp->astnam) - 1);
4838 if (i < 0)
4839 i = 0;
4840 sp = fdp->astnam + i;
4841 while(*sp == ' ') {
4842 sp--;
4843 }
4844 sp[1] = '\0';
4845 if ((sp = strstr(fdp->astnam, " ")) != NULL)
4846 *sp = '\0';
4847 }
4848 /*************************************
4849 * check CRC *
4850 *************************************/
4851 fpos = ftell(fp);
4852 /* read CRC from file */
4853 retc = do_fread((void *) &ulng, 4, 1, 4, fp, SEI_CURR_FPOS, freord,
4854 fendian, ifno, serr);
4855 if (retc != OK)
4856 goto return_error;
4857 /* read check area from file */
4858 fseek(fp, 0L, SEEK_SET);
4859 /* must check that defined length of s is less than fpos */
4860 if (fpos - 1 > 2 * AS_MAXCH) {
4861 smsg = "l";
4862 goto file_damage;
4863 }
4864 if (fread((void *) s, (size_t) fpos, 1, fp) != 1) {
4865 smsg = "m";
4866 goto file_damage;
4867 }
4868 #if 1
4869 if (swi_crc32((unsigned char *) s, (int) fpos) != ulng) {
4870 smsg = "n";
4871 goto file_damage;
4872 }
4873 #endif
4874 fseek(fp, fpos+4, SEEK_SET);
4875 /*************************************
4876 * read general constants *
4877 *************************************/
4878 /* clight, aunit, helgravconst, ratme, sunradius
4879 * these constants are currently not in use */
4880 retc = do_fread((void *) &doubles[0], 8, 5, 8, fp, SEI_CURR_FPOS, freord,
4881 fendian, ifno, serr);
4882 if (retc != OK)
4883 goto return_error;
4884 swed.gcdat.clight = doubles[0];
4885 swed.gcdat.aunit = doubles[1];
4886 swed.gcdat.helgravconst = doubles[2];
4887 swed.gcdat.ratme = doubles[3];
4888 swed.gcdat.sunradius = doubles[4];
4889 /*************************************
4890 * read constants of planets *
4891 *************************************/
4892 for (kpl = 0; kpl < fdp->npl; kpl++) {
4893 /* get SEI_ planet number */
4894 ipli = fdp->ipl[kpl];
4895 if (ipli >= SE_AST_OFFSET)
4896 pdp = &swed.pldat[SEI_ANYBODY];
4897 else if (ipli >= SE_PLMOON_OFFSET)
4898 pdp = &swed.pldat[SEI_ANYBODY];
4899 else
4900 pdp = &swed.pldat[ipli];
4901 pdp->ibdy = ipli;
4902 /* file position of planet's index */
4903 retc = do_fread((void *) &pdp->lndx0, 4, 1, 4, fp, SEI_CURR_FPOS,
4904 freord, fendian, ifno, serr);
4905 if (retc != OK)
4906 goto return_error;
4907 /* flags: helio/geocentric, rotation, reference ellipse */
4908 retc = do_fread((void *) &pdp->iflg, 1, 1, sizeof(int32), fp,
4909 SEI_CURR_FPOS, freord, fendian, ifno, serr);
4910 if (retc != OK)
4911 goto return_error;
4912 /* number of chebyshew coefficients / segment */
4913 /* = interpolation order +1 */
4914 retc = do_fread((void *) &pdp->ncoe, 1, 1, sizeof(int), fp,
4915 SEI_CURR_FPOS, freord, fendian, ifno, serr);
4916 if (retc != OK)
4917 goto return_error;
4918 /* rmax = normalisation factor */
4919 retc = do_fread((void *) &lng, 4, 1, 4, fp, SEI_CURR_FPOS, freord,
4920 fendian, ifno, serr);
4921 if (retc != OK)
4922 goto return_error;
4923 pdp->rmax = lng / 1000.0;
4924 // planet's center of body, e.g. 9599 for Jupiter or Mars moons
4925 if (ipli >= SE_PLMOON_OFFSET && ipli < SE_AST_OFFSET) {
4926 if ((ipli % 100) == 99 || (ipli - 9000) / 100 == SE_MARS)
4927 pdp->rmax = lng / 1000000.0;
4928 }
4929 /* start and end epoch of planetary ephemeris, */
4930 /* segment length, and orbital elements */
4931 retc = do_fread((void *) doubles, 8, 10, 8, fp, SEI_CURR_FPOS, freord,
4932 fendian, ifno, serr);
4933 if (retc != OK)
4934 goto return_error;
4935 pdp->tfstart = doubles[0];
4936 pdp->tfend = doubles[1];
4937 pdp->dseg = doubles[2];
4938 pdp->nndx = (int32) ((doubles[1] - doubles[0] + 0.1) /doubles[2]);
4939 pdp->telem = doubles[3];
4940 pdp->prot = doubles[4];
4941 pdp->dprot = doubles[5];
4942 pdp->qrot = doubles[6];
4943 pdp->dqrot = doubles[7];
4944 pdp->peri = doubles[8];
4945 pdp->dperi = doubles[9];
4946 /* alloc space for chebyshew coefficients */
4947 /* if reference ellipse is used, read its coefficients */
4948 if (pdp->iflg & SEI_FLG_ELLIPSE) {
4949 if (pdp->refep != NULL) { /* if switch to other eph. file */
4950 free((void *) pdp->refep);
4951 pdp->refep = NULL; /* 2015-may-5 */
4952 if (pdp->segp != NULL) {
4953 free((void *) pdp->segp); /* array of coefficients of */
4954 pdp->segp = NULL; /* ephemeris segment */
4955 }
4956 }
4957 pdp->refep = (double *) malloc((size_t) pdp->ncoe * 2 * 8);
4958 retc = do_fread((void *) pdp->refep, 8, 2*pdp->ncoe, 8, fp,
4959 SEI_CURR_FPOS, freord, fendian, ifno, serr);
4960 if (retc != OK) {
4961 free(pdp->refep); /* 2015-may-5 */
4962 pdp->refep = NULL; /* 2015-may-5 */
4963 goto return_error;
4964 }
4965 }/**/
4966 }
4967 return(OK);
4968 file_damage:
4969 if (serr != NULL) {
4970 *serr = '\0';
4971 if (strlen(serr_file_damage) + strlen(fdp->fnam) + strlen(smsg) < AS_MAXCH) {
4972 sprintf(serr, serr_file_damage, fdp->fnam, smsg);
4973 }
4974 }
4975 return_error:
4976 fclose(fdp->fptr);
4977 // free(fdp->fptr); is not from malloc(), must not be freed by us
4978 fdp->fptr = NULL;
4979 free_planets();
4980 return(ERR);
4981 }
4982
4983 /* SWISSEPH
4984 * reads from a file and, if necessary, reorders bytes
4985 * targ target pointer
4986 * size size of item to be read
4987 * count number of items
4988 * corrsize in what size should it be returned
4989 * (e.g. 3 byte int -> 4 byte int)
4990 * fp file pointer
4991 * fpos file position: if (fpos >= 0) then fseek
4992 * freord reorder bytes or no
4993 * fendian little/bigendian
4994 * ifno file number
4995 * serr error string
4996 */
do_fread(void * trg,int size,int count,int corrsize,FILE * fp,int32 fpos,int freord,int fendian,int ifno,char * serr)4997 static int do_fread(void *trg, int size, int count, int corrsize, FILE *fp, int32 fpos, int freord, int fendian, int ifno, char *serr)
4998 {
4999 int i, j, k;
5000 int totsize;
5001 unsigned char space[1000];
5002 unsigned char *targ = (unsigned char *) trg;
5003 totsize = size * count;
5004 if (fpos >= 0)
5005 fseek(fp, fpos, SEEK_SET);
5006 /* if no byte reorder has to be done, and read size == return size */
5007 if (!freord && size == corrsize) {
5008 if (fread((void *) targ, (size_t) totsize, 1, fp) == 0) {
5009 if (serr != NULL) {
5010 strcpy(serr, "Ephemeris file is damaged (1). ");
5011 if (strlen(serr) + strlen(swed.fidat[ifno].fnam) < AS_MAXCH - 1) {
5012 sprintf(serr, "Ephemeris file %s is damaged (2).", swed.fidat[ifno].fnam);
5013 }
5014 }
5015 return(ERR);
5016 } else
5017 return(OK);
5018 } else {
5019 if (fread((void *) &space[0], (size_t) totsize, 1, fp) == 0) {
5020 if (serr != NULL) {
5021 strcpy(serr, "Ephemeris file is damaged (3). ");
5022 if (strlen(serr) + strlen(swed.fidat[ifno].fnam) < AS_MAXCH - 1) {
5023 sprintf(serr, "Ephemeris file %s is damaged (4).", swed.fidat[ifno].fnam);
5024 }
5025 }
5026 return(ERR);
5027 }
5028 if (size != corrsize) {
5029 memset((void *) targ, 0, (size_t) count * corrsize);
5030 }
5031 for(i = 0; i < count; i++) {
5032 for (j = size-1; j >= 0; j--) {
5033 if (freord)
5034 k = size-j-1;
5035 else
5036 k = j;
5037 if (size != corrsize)
5038 if ((fendian == SEI_FILE_BIGENDIAN && !freord) ||
5039 (fendian == SEI_FILE_LITENDIAN && freord))
5040 k += corrsize - size;
5041 targ[i*corrsize+k] = space[i*size+j];
5042 }
5043 }
5044 }
5045 return(OK);
5046 }
5047
5048 /* SWISSEPH
5049 * adds reference orbit to chebyshew series (if SEI_FLG_ELLIPSE),
5050 * rotates series to mean equinox of J2000
5051 *
5052 * ipli planet number
5053 */
rot_back(int ipli)5054 static void rot_back(int ipli)
5055 {
5056 int i;
5057 double t, tdiff;
5058 double qav, pav, dn;
5059 double omtild, com, som, cosih2;
5060 double x[MAXORD+1][3];
5061 double uix[3], uiy[3], uiz[3];
5062 double xrot, yrot, zrot;
5063 double *chcfx, *chcfy, *chcfz;
5064 double *refepx, *refepy;
5065 // epsilon as used in chopt.c
5066 // double eps2000 = 0.409092804; // eps 2000 in radians
5067 double seps2000 = 0.39777715572793088; // sin(eps2000)
5068 double ceps2000 = 0.91748206215761929; // cos(eps2000)
5069 struct plan_data *pdp = &swed.pldat[ipli];
5070 int nco = pdp->ncoe;
5071 t = pdp->tseg0 + pdp->dseg / 2;
5072 chcfx = pdp->segp;
5073 chcfy = chcfx + nco;
5074 chcfz = chcfx + 2 * nco;
5075 tdiff= (t - pdp->telem) / 365250.0;
5076 if (ipli == SEI_MOON) {
5077 dn = pdp->prot + tdiff * pdp->dprot;
5078 i = (int) (dn / TWOPI);
5079 dn -= i * TWOPI;
5080 qav = (pdp->qrot + tdiff * pdp->dqrot) * cos(dn);
5081 pav = (pdp->qrot + tdiff * pdp->dqrot) * sin(dn);
5082 } else {
5083 qav = pdp->qrot + tdiff * pdp->dqrot;
5084 pav = pdp->prot + tdiff * pdp->dprot;
5085 }
5086 /*calculate cosine and sine of average perihelion longitude. */
5087 for (i = 0; i < nco; i++) {
5088 x[i][0] = chcfx[i];
5089 x[i][1] = chcfy[i];
5090 x[i][2] = chcfz[i];
5091 }
5092 if (pdp->iflg & SEI_FLG_ELLIPSE) {
5093 refepx = pdp->refep;
5094 refepy = refepx + nco;
5095 omtild = pdp->peri + tdiff * pdp->dperi;
5096 i = (int) (omtild / TWOPI);
5097 omtild -= i * TWOPI;
5098 com = cos(omtild);
5099 som = sin(omtild);
5100 /*add reference orbit. */
5101 for (i = 0; i < nco; i++) {
5102 x[i][0] = chcfx[i] + com * refepx[i] - som * refepy[i];
5103 x[i][1] = chcfy[i] + com * refepy[i] + som * refepx[i];
5104 }
5105 }
5106 /* construct right handed orthonormal system with first axis along
5107 origin of longitudes and third axis along angular momentum
5108 this uses the standard formulas for equinoctal variables
5109 (see papers by broucke and by cefola). */
5110 cosih2 = 1.0 / (1.0 + qav * qav + pav * pav);
5111 /* calculate orbit pole. */
5112 uiz[0] = 2.0 * pav * cosih2;
5113 uiz[1] = -2.0 * qav * cosih2;
5114 uiz[2] = (1.0 - qav * qav - pav * pav) * cosih2;
5115 /* calculate origin of longitudes vector. */
5116 uix[0] = (1.0 + qav * qav - pav * pav) * cosih2;
5117 uix[1] = 2.0 * qav * pav * cosih2;
5118 uix[2] = -2.0 * pav * cosih2;
5119 /* calculate vector in orbital plane orthogonal to origin of
5120 longitudes. */
5121 uiy[0] =2.0 * qav * pav * cosih2;
5122 uiy[1] =(1.0 - qav * qav + pav * pav) * cosih2;
5123 uiy[2] =2.0 * qav * cosih2;
5124 /* rotate to actual orientation in space. */
5125 for (i = 0; i < nco; i++) {
5126 xrot = x[i][0] * uix[0] + x[i][1] * uiy[0] + x[i][2] * uiz[0];
5127 yrot = x[i][0] * uix[1] + x[i][1] * uiy[1] + x[i][2] * uiz[1];
5128 zrot = x[i][0] * uix[2] + x[i][1] * uiy[2] + x[i][2] * uiz[2];
5129 if (fabs(xrot) + fabs(yrot) + fabs(zrot) >= 1e-14)
5130 pdp->neval = i;
5131 x[i][0] = xrot;
5132 x[i][1] = yrot;
5133 x[i][2] = zrot;
5134 if (ipli == SEI_MOON) {
5135 /* rotate to j2000 equator */
5136 x[i][1] = ceps2000 * yrot - seps2000 * zrot;
5137 x[i][2] = seps2000 * yrot + ceps2000 * zrot;
5138 }
5139 }
5140 for (i = 0; i < nco; i++) {
5141 chcfx[i] = x[i][0];
5142 chcfy[i] = x[i][1];
5143 chcfz[i] = x[i][2];
5144 }
5145 }
5146
5147 /* Adjust position from Earth-Moon barycenter to Earth
5148 *
5149 * xemb = hel./bar. position or velocity vectors of emb (input)
5150 * earth (output)
5151 * xmoon= geocentric position or velocity vector of moon
5152 */
embofs(double * xemb,double * xmoon)5153 static void embofs(double *xemb, double *xmoon)
5154 {
5155 int i;
5156 for (i = 0; i <= 2; i++)
5157 xemb[i] -= xmoon[i] / (EARTH_MOON_MRAT + 1.0);
5158 }
5159
5160 /* calculates the nutation matrix
5161 * nu pointer to nutation data structure
5162 * oe pointer to epsilon data structure
5163 */
nut_matrix(struct nut * nu,struct epsilon * oe)5164 static void nut_matrix(struct nut *nu, struct epsilon *oe)
5165 {
5166 double psi, eps;
5167 double sinpsi, cospsi, sineps, coseps, sineps0, coseps0;
5168 psi = nu->nutlo[0];
5169 eps = oe->eps + nu->nutlo[1];
5170 sinpsi = sin(psi);
5171 cospsi = cos(psi);
5172 sineps0 = oe->seps;
5173 coseps0 = oe->ceps;
5174 sineps = sin(eps);
5175 coseps = cos(eps);
5176 nu->matrix[0][0] = cospsi;
5177 nu->matrix[0][1] = sinpsi * coseps;
5178 nu->matrix[0][2] = sinpsi * sineps;
5179 nu->matrix[1][0] = -sinpsi * coseps0;
5180 nu->matrix[1][1] = cospsi * coseps * coseps0 + sineps * sineps0;
5181 nu->matrix[1][2] = cospsi * sineps * coseps0 - coseps * sineps0;
5182 nu->matrix[2][0] = -sinpsi * sineps0;
5183 nu->matrix[2][1] = cospsi * coseps * sineps0 - sineps * coseps0;
5184 nu->matrix[2][2] = cospsi * sineps * sineps0 + coseps * coseps0;
5185 }
5186
5187 /* lunar osculating elements, i.e.
5188 * osculating node ('true' node) and
5189 * osculating apogee ('black moon', 'lilith').
5190 * tjd julian day
5191 * ipl body number, i.e. SEI_TRUE_NODE or SEI_OSCU_APOG
5192 * iflag flags (which ephemeris, nutation, etc.)
5193 * serr error string
5194 *
5195 * definitions and remarks:
5196 * the osculating node and the osculating apogee are defined
5197 * as the orbital elements of the momentary lunar orbit.
5198 * their advantage is that when the moon crosses the ecliptic,
5199 * it is really at the osculating node, and when it passes
5200 * its greatest distance from earth it is really at the
5201 * osculating apogee. with the mean elements this is not
5202 * the case. (some define the apogee as the second focus of
5203 * the lunar ellipse. but, as seen from the geocenter, both
5204 * points are in the same direction.)
5205 * problems:
5206 * the osculating apogee is given in the 'New International
5207 * Ephemerides' (Editions St. Michel) as the 'True Lilith'.
5208 * however, this name is misleading. this point is based on
5209 * the idea that the lunar orbit can be approximated by an
5210 * ellipse.
5211 * arguments against this:
5212 * 1. this procedure considers celestial motions as two body
5213 * problems. this is quite good for planets, but not for
5214 * the moon. the strong gravitational attraction of the sun
5215 * destroys the idea of an ellipse.
5216 * 2. the NIE 'True Lilith' has strong oscillations around the
5217 * mean one with an amplitude of about 30 degrees. however,
5218 * when the moon is in apogee, its distance from the mean
5219 * apogee never exceeds 5 degrees.
5220 * besides, the computation of NIE is INACCURATE. the mistake
5221 * reaches 20 arc minutes.
5222 * According to Santoni, the point was calculated using 'les 58
5223 * premiers termes correctifs au Perigee moyen' published by
5224 * Chapront and Chapront-Touze. And he adds: "Nous constatons
5225 * que meme en utilisant ces 58 termes CORRECTIFS, l'erreur peut
5226 * atteindre 0,5d!" (p. 13) We avoid this error, computing the
5227 * orbital elements directly from the position and the speed vector.
5228 *
5229 * how about the node? it is less problematic, because we
5230 * we needn't derive it from an orbital ellipse. we can say:
5231 * the axis of the osculating nodes is the intersection line of
5232 * the actual orbital plane of the moon and the plane of the
5233 * ecliptic. or: the osculating nodes are the intersections of
5234 * the two great circles representing the momentary apparent
5235 * orbit of the moon and the ecliptic. in this way they make
5236 * some sense. then, the nodes are really an axis, and they
5237 * have no geocentric distance. however, in this routine
5238 * we give a distance derived from the osculating ellipse.
5239 * the node could also be defined as the intersection axis
5240 * of the lunar orbital plane and the solar orbital plane,
5241 * which is not precisely identical to the ecliptic. this
5242 * would make a difference of several arcseconds.
5243 *
5244 * is it possible to keep the idea of a continuously moving
5245 * apogee that is exact at the moment when the moon passes
5246 * its greatest distance from earth?
5247 * to achieve this, we would probably have to interpolate between
5248 * the actual apogees.
5249 * the nodes could also be computed by interpolation. the resulting
5250 * nodes would deviate from the so-called 'true node' by less than
5251 * 30 arc minutes.
5252 *
5253 * sidereal and j2000 true node are first computed for the ecliptic
5254 * of epoch and then precessed to ecliptic of t0(ayanamsa) or J2000.
5255 * there is another procedure that computes the node for the ecliptic
5256 * of t0(ayanamsa) or J2000. it is excluded by
5257 * #ifdef SID_TNODE_FROM_ECL_T0
5258 */
lunar_osc_elem(double tjd,int ipl,int32 iflag,char * serr)5259 static int lunar_osc_elem(double tjd, int ipl, int32 iflag, char *serr)
5260 {
5261 int i, j, istart;
5262 int ipli = SEI_MOON;
5263 int32 epheflag = SEFLG_DEFAULTEPH;
5264 int retc = ERR;
5265 int32 flg1, flg2;
5266 double daya[2];
5267 #if 0
5268 struct node_data *ndp, *ndnp, *ndap;
5269 #else
5270 struct plan_data *ndp, *ndnp, *ndap;
5271 #endif
5272 struct epsilon *oe;
5273 double speed_intv = NODE_CALC_INTV; /* to silence gcc warning */
5274 double a, b;
5275 double xpos[3][6], xx[3][6], xxa[3][6], xnorm[6], r[6];
5276 double *xp;
5277 double rxy, rxyz, t, dt, fac, sgn;
5278 double sinnode, cosnode, sinincl, cosincl, sinu, cosu, sinE, cosE;
5279 double uu, ny, sema, ecce, Gmsm, c2, v2, pp;
5280 int32 speedf1, speedf2;
5281 #ifdef SID_TNODE_FROM_ECL_T0
5282 struct sid_data *sip = &swed.sidd;
5283 struct epsilon oectmp;
5284 if (iflag & SEFLG_SIDEREAL) {
5285 calc_epsilon(sip->t0, iflag, &oectmp);
5286 oe = &oectmp;
5287 } else if (iflag & SEFLG_J2000)
5288 oe = &swed.oec2000;
5289 else
5290 #endif
5291 oe = &swed.oec;
5292 ndp = &swed.nddat[ipl];
5293 /* if elements have already been computed for this date, return
5294 * if speed flag has been turned on, recompute */
5295 flg1 = iflag & ~SEFLG_EQUATORIAL & ~SEFLG_XYZ;
5296 flg2 = ndp->xflgs & ~SEFLG_EQUATORIAL & ~SEFLG_XYZ;
5297 speedf1 = ndp->xflgs & SEFLG_SPEED;
5298 speedf2 = iflag & SEFLG_SPEED;
5299 if (tjd == ndp->teval
5300 && tjd != 0
5301 && flg1 == flg2
5302 && (!speedf2 || speedf1)) {
5303 ndp->xflgs = iflag;
5304 ndp->iephe = iflag & SEFLG_EPHMASK;
5305 return OK;
5306 }
5307 /* the geocentric position vector and the speed vector of the
5308 * moon make up the lunar orbital plane. the position vector
5309 * of the node is along the intersection line of the orbital
5310 * plane and the plane of the ecliptic.
5311 * to calculate the osculating node, we need one lunar position
5312 * with speed.
5313 * to calculate the speed of the osculating node, we need
5314 * three lunar positions and the speed of each of them.
5315 * this is relatively cheap, if the jpl-moon or the swisseph
5316 * moon is used. with the moshier moon this is much more
5317 * expensive, because then we need 9 lunar positions for
5318 * three speeds. but one position and speed can normally
5319 * be taken from swed.pldat[moon], which corresponds to
5320 * three moshier moon calculations.
5321 * the same is also true for the osculating apogee: we need
5322 * three lunar positions and speeds.
5323 */
5324 /*********************************************
5325 * now three lunar positions with speeds *
5326 *********************************************/
5327 if (iflag & SEFLG_MOSEPH)
5328 epheflag = SEFLG_MOSEPH;
5329 else if (iflag & SEFLG_SWIEPH)
5330 epheflag = SEFLG_SWIEPH;
5331 else if (iflag & SEFLG_JPLEPH)
5332 epheflag = SEFLG_JPLEPH;
5333 /* there may be a moon of wrong ephemeris in save area
5334 * force new computation: */
5335 swed.pldat[SEI_MOON].teval = 0;
5336 if (iflag & SEFLG_SPEED)
5337 istart = 0;
5338 else
5339 istart = 2;
5340 if (serr != NULL)
5341 *serr = '\0';
5342 three_positions:
5343 switch(epheflag) {
5344 case SEFLG_JPLEPH:
5345 speed_intv = NODE_CALC_INTV;
5346 for (i = istart; i <= 2; i++) {
5347 if (i == 0)
5348 t = tjd - speed_intv;
5349 else if (i == 1)
5350 t = tjd + speed_intv;
5351 else
5352 t = tjd;
5353 xp = xpos[i];
5354 retc = jplplan(t, ipli, iflag, NO_SAVE, xp, NULL, NULL, serr);
5355 /* read error or corrupt file */
5356 if (retc == ERR)
5357 return(ERR);
5358 /* light-time-corrected moon for apparent node
5359 * this makes a difference of several milliarcseconds with
5360 * the node and 0.1" with the apogee.
5361 * the simple formual 'x[j] -= dt * speed' should not be
5362 * used here. the error would be greater than the advantage
5363 * of computation speed. */
5364 if ((iflag & SEFLG_TRUEPOS) == 0 && retc >= OK) {
5365 dt = sqrt(square_sum(xpos[i])) * AUNIT / CLIGHT / 86400.0;
5366 retc = jplplan(t-dt, ipli, iflag, NO_SAVE, xpos[i], NULL, NULL, serr);/**/
5367 /* read error or corrupt file */
5368 if (retc == ERR)
5369 return(ERR);
5370 }
5371 /* jpl ephemeris not on disk, or date beyond ephemeris range */
5372 if (retc == NOT_AVAILABLE) {
5373 iflag = (iflag & ~SEFLG_JPLEPH) | SEFLG_SWIEPH;
5374 epheflag = SEFLG_SWIEPH;
5375 if (serr != NULL && strlen(serr) + 30 < AS_MAXCH)
5376 strcat(serr, " \ntrying Swiss Eph; ");
5377 break;
5378 } else if (retc == BEYOND_EPH_LIMITS) {
5379 if (tjd > MOSHLUEPH_START && tjd < MOSHLUEPH_END) {
5380 iflag = (iflag & ~SEFLG_JPLEPH) | SEFLG_MOSEPH;
5381 epheflag = SEFLG_MOSEPH;
5382 if (serr != NULL && strlen(serr) + 30 < AS_MAXCH)
5383 strcat(serr, " \nusing Moshier Eph; ");
5384 break;
5385 } else
5386 return ERR;
5387 }
5388 /* precession and nutation etc. */
5389 retc = swi_plan_for_osc_elem(iflag|SEFLG_SPEED, t, xpos[i]); /* retc is always ok */
5390 }
5391 break;
5392 case SEFLG_SWIEPH:
5393 #if 0
5394 sweph_moon:
5395 #endif
5396 speed_intv = NODE_CALC_INTV;
5397 for (i = istart; i <= 2; i++) {
5398 if (i == 0)
5399 t = tjd - speed_intv;
5400 else if (i == 1)
5401 t = tjd + speed_intv;
5402 else
5403 t = tjd;
5404 retc = swemoon(t, iflag | SEFLG_SPEED, NO_SAVE, xpos[i], serr);/**/
5405 if (retc == ERR)
5406 return(ERR);
5407 /* light-time-corrected moon for apparent node (~ 0.006") */
5408 if ((iflag & SEFLG_TRUEPOS) == 0 && retc >= OK) {
5409 dt = sqrt(square_sum(xpos[i])) * AUNIT / CLIGHT / 86400.0;
5410 retc = swemoon(t-dt, iflag | SEFLG_SPEED, NO_SAVE, xpos[i], serr);/**/
5411 if (retc == ERR)
5412 return(ERR);
5413 }
5414 if (retc == NOT_AVAILABLE) {
5415 if (tjd > MOSHPLEPH_START && tjd < MOSHPLEPH_END) {
5416 iflag = (iflag & ~SEFLG_SWIEPH) | SEFLG_MOSEPH;
5417 epheflag = SEFLG_MOSEPH;
5418 if (serr != NULL && strlen(serr) + 30 < AS_MAXCH)
5419 strcat(serr, " \nusing Moshier eph.; ");
5420 break;
5421 } else
5422 return ERR;
5423 }
5424 /* precession and nutation etc. */
5425 retc = swi_plan_for_osc_elem(iflag|SEFLG_SPEED, t, xpos[i]); /* retc is always ok */
5426 }
5427 break;
5428 case SEFLG_MOSEPH:
5429 #if 0
5430 moshier_moon:
5431 #endif
5432 /* with moshier moon, we need a greater speed_intv, because here the
5433 * node and apogee oscillate wildly within small intervals */
5434 speed_intv = NODE_CALC_INTV_MOSH;
5435 for (i = istart; i <= 2; i++) {
5436 if (i == 0)
5437 t = tjd - speed_intv;
5438 else if (i == 1)
5439 t = tjd + speed_intv;
5440 else
5441 t = tjd;
5442 retc = swi_moshmoon(t, NO_SAVE, xpos[i], serr);/**/
5443 if (retc == ERR)
5444 return(retc);
5445 #if 0
5446 /* light-time-corrected moon for apparent node.
5447 * can be neglected with moshier */
5448 if ((iflag & SEFLG_TRUEPOS) == 0 && retc >= OK) {
5449 dt = sqrt(square_sum(xpos[i])) * AUNIT / CLIGHT / 86400;
5450 retc = swi_moshmoon(t-dt, NO_SAVE, xpos[i], serr);/**/
5451 }
5452 #endif
5453 /* precession and nutation etc. */
5454 retc = swi_plan_for_osc_elem(iflag|SEFLG_SPEED, t, xpos[i]); /* retc is always ok */
5455 }
5456 break;
5457 default:
5458 break;
5459 }
5460 if (retc == NOT_AVAILABLE || retc == BEYOND_EPH_LIMITS)
5461 goto three_positions;
5462 /*********************************************
5463 * node with speed *
5464 *********************************************/
5465 /* node is always needed, even if apogee is wanted */
5466 ndnp = &swed.nddat[SEI_TRUE_NODE];
5467 /* three nodes */
5468 for (i = istart; i <= 2; i++) {
5469 if (fabs(xpos[i][5]) < 1e-15)
5470 xpos[i][5] = 1e-15;
5471 fac = xpos[i][2] / xpos[i][5];
5472 sgn = xpos[i][5] / fabs(xpos[i][5]);
5473 for (j = 0; j <= 2; j++)
5474 xx[i][j] = (xpos[i][j] - fac * xpos[i][j+3]) * sgn;
5475 }
5476 /* now we have the correct direction of the node, the
5477 * intersection of the lunar plane and the ecliptic plane.
5478 * the distance is the distance of the point where the tangent
5479 * of the lunar motion penetrates the ecliptic plane.
5480 * this can be very large, e.g. j2415080.37372.
5481 * below, a new distance will be derived from the osculating
5482 * ellipse.
5483 */
5484 /* save position and speed */
5485 for (i = 0; i <= 2; i++) {
5486 ndnp->x[i] = xx[2][i];
5487 if (iflag & SEFLG_SPEED) {
5488 b = (xx[1][i] - xx[0][i]) / 2;
5489 a = (xx[1][i] + xx[0][i]) / 2 - xx[2][i];
5490 ndnp->x[i+3] = (2 * a + b) / speed_intv;
5491 } else
5492 ndnp->x[i+3] = 0;
5493 ndnp->teval = tjd;
5494 ndnp->iephe = epheflag;
5495 }
5496 /************************************************************
5497 * apogee with speed *
5498 * must be computed anyway to get the node's distance *
5499 ************************************************************/
5500 ndap = &swed.nddat[SEI_OSCU_APOG];
5501 Gmsm = GEOGCONST * (1 + 1 / EARTH_MOON_MRAT) /AUNIT/AUNIT/AUNIT*86400.0*86400.0;
5502 /* three apogees */
5503 for (i = istart; i <= 2; i++) {
5504 /* node */
5505 rxy = sqrt(xx[i][0] * xx[i][0] + xx[i][1] * xx[i][1]);
5506 cosnode = xx[i][0] / rxy;
5507 sinnode = xx[i][1] / rxy;
5508 /* inclination */
5509 swi_cross_prod(xpos[i], xpos[i]+3, xnorm);
5510 rxy = xnorm[0] * xnorm[0] + xnorm[1] * xnorm[1];
5511 c2 = (rxy + xnorm[2] * xnorm[2]);
5512 rxyz = sqrt(c2);
5513 rxy = sqrt(rxy);
5514 sinincl = rxy / rxyz;
5515 cosincl = sqrt(1 - sinincl * sinincl);
5516 /* argument of latitude */
5517 cosu = xpos[i][0] * cosnode + xpos[i][1] * sinnode;
5518 sinu = xpos[i][2] / sinincl;
5519 uu = atan2(sinu, cosu);
5520 /* semi-axis */
5521 rxyz = sqrt(square_sum(xpos[i]));
5522 v2 = square_sum((xpos[i]+3));
5523 sema = 1 / (2 / rxyz - v2 / Gmsm);
5524 /* eccentricity */
5525 pp = c2 / Gmsm;
5526 ecce = sqrt(1 - pp / sema);
5527 /* eccentric anomaly */
5528 cosE = 1 / ecce * (1 - rxyz / sema);
5529 sinE = 1 / ecce / sqrt(sema * Gmsm) * dot_prod(xpos[i], (xpos[i]+3));
5530 /* true anomaly */
5531 ny = 2 * atan(sqrt((1+ecce)/(1-ecce)) * sinE / (1 + cosE));
5532 /* distance of apogee from ascending node */
5533 xxa[i][0] = swi_mod2PI(uu - ny + PI);
5534 xxa[i][1] = 0; /* latitude */
5535 xxa[i][2] = sema * (1 + ecce); /* distance */
5536 /* transformation to ecliptic coordinates */
5537 swi_polcart(xxa[i], xxa[i]);
5538 swi_coortrf2(xxa[i], xxa[i], -sinincl, cosincl);
5539 swi_cartpol(xxa[i], xxa[i]);
5540 /* adding node, we get apogee in ecl. coord. */
5541 xxa[i][0] += atan2(sinnode, cosnode);
5542 swi_polcart(xxa[i], xxa[i]);
5543 /* new distance of node from orbital ellipse:
5544 * true anomaly of node: */
5545 ny = swi_mod2PI(ny - uu);
5546 /* eccentric anomaly */
5547 cosE = cos(2 * atan(tan(ny / 2) / sqrt((1+ecce) / (1-ecce))));
5548 /* new distance */
5549 r[0] = sema * (1 - ecce * cosE);
5550 /* old node distance */
5551 r[1] = sqrt(square_sum(xx[i]));
5552 /* correct length of position vector */
5553 for (j = 0; j <= 2; j++)
5554 xx[i][j] *= r[0] / r[1];
5555 }
5556 /* save position and speed */
5557 for (i = 0; i <= 2; i++) {
5558 /* apogee */
5559 ndap->x[i] = xxa[2][i];
5560 if (iflag & SEFLG_SPEED)
5561 ndap->x[i+3] = (xxa[1][i] - xxa[0][i]) / speed_intv / 2;
5562 else
5563 ndap->x[i+3] = 0;
5564 ndap->teval = tjd;
5565 ndap->iephe = epheflag;
5566 /* node */
5567 ndnp->x[i] = xx[2][i];
5568 if (iflag & SEFLG_SPEED)
5569 ndnp->x[i+3] = (xx[1][i] - xx[0][i]) / speed_intv / 2;/**/
5570 else
5571 ndnp->x[i+3] = 0;
5572 }
5573 /**********************************************************************
5574 * precession and nutation have already been taken into account
5575 * because the computation is on the basis of lunar positions
5576 * that have gone through swi_plan_for_osc_elem.
5577 * light-time is already contained in lunar positions.
5578 * now compute polar and equatorial coordinates:
5579 **********************************************************************/
5580 for (j = 0; j <= 1; j++) {
5581 double x[6];
5582 if (j == 0)
5583 ndp = &swed.nddat[SEI_TRUE_NODE];
5584 else
5585 ndp = &swed.nddat[SEI_OSCU_APOG];
5586 memset((void *) ndp->xreturn, 0, 24 * sizeof(double));
5587 /* cartesian ecliptic */
5588 for (i = 0; i <= 5; i++)
5589 ndp->xreturn[6+i] = ndp->x[i];
5590 /* polar ecliptic */
5591 swi_cartpol_sp(ndp->xreturn+6, ndp->xreturn);
5592 /* cartesian equatorial */
5593 swi_coortrf2(ndp->xreturn+6, ndp->xreturn+18, -oe->seps, oe->ceps);
5594 if (iflag & SEFLG_SPEED)
5595 swi_coortrf2(ndp->xreturn+9, ndp->xreturn+21, -oe->seps, oe->ceps);
5596 #ifdef SID_TNODE_FROM_ECL_T0
5597 /* sideral: we return NORMAL equatorial coordinates, there are no
5598 * sidereal ones */
5599 if (iflag & SEFLG_SIDEREAL) {
5600 /* to J2000 */
5601 swi_precess(ndp->xreturn+18, sip->t0, iflag, J_TO_J2000);
5602 if (iflag & SEFLG_SPEED)
5603 swi_precess_speed(ndp->xreturn+21, sip->t0, iflag, J_TO_J2000);
5604 if (!(iflag & SEFLG_J2000)) {
5605 /* to tjd */
5606 swi_precess(ndp->xreturn+18, tjd, iflag, J2000_TO_J);
5607 if (iflag & SEFLG_SPEED)
5608 swi_precess_speed(ndp->xreturn+21, tjd, iflag, J2000_TO_J);
5609 }
5610 }
5611 #endif
5612 if (!(iflag & SEFLG_NONUT)) {
5613 swi_coortrf2(ndp->xreturn+18, ndp->xreturn+18, -swed.nut.snut, swed.nut.cnut);
5614 if (iflag & SEFLG_SPEED)
5615 swi_coortrf2(ndp->xreturn+21, ndp->xreturn+21, -swed.nut.snut, swed.nut.cnut);
5616 }
5617 /* polar equatorial */
5618 swi_cartpol_sp(ndp->xreturn+18, ndp->xreturn+12);
5619 ndp->xflgs = iflag;
5620 ndp->iephe = iflag & SEFLG_EPHMASK;
5621 #ifdef SID_TNODE_FROM_ECL_T0
5622 /* node and apogee are already referred to t0;
5623 * nothing has to be done */
5624 #else
5625 if (iflag & SEFLG_SIDEREAL) {
5626 /* node and apogee are referred to t;
5627 * the ecliptic position must be transformed to t0 */
5628 /* rigorous algorithm */
5629 if ((swed.sidd.sid_mode & SE_SIDBIT_ECL_T0)
5630 || (swed.sidd.sid_mode & SE_SIDBIT_SSY_PLANE)) {
5631 for (i = 0; i <= 5; i++)
5632 x[i] = ndp->xreturn[18+i];
5633 /* remove nutation */
5634 if (!(iflag & SEFLG_NONUT))
5635 swi_nutate(x, iflag, TRUE);
5636 /* precess to J2000 */
5637 swi_precess(x, tjd, iflag, J_TO_J2000);
5638 if (iflag & SEFLG_SPEED)
5639 swi_precess_speed(x, tjd, iflag, J_TO_J2000);
5640 if (swed.sidd.sid_mode & SE_SIDBIT_ECL_T0)
5641 swi_trop_ra2sid_lon(x, ndp->xreturn+6, ndp->xreturn+18, iflag);
5642 /* project onto solar system equator */
5643 else if (swed.sidd.sid_mode & SE_SIDBIT_SSY_PLANE)
5644 swi_trop_ra2sid_lon_sosy(x, ndp->xreturn+6, iflag);
5645 /* to polar */
5646 swi_cartpol_sp(ndp->xreturn+6, ndp->xreturn);
5647 swi_cartpol_sp(ndp->xreturn+18, ndp->xreturn+12);
5648 /* traditional algorithm;
5649 * this is a bit clumsy, but allows us to keep the
5650 * sidereal code together */
5651 } else {
5652 swi_cartpol_sp(ndp->xreturn+6, ndp->xreturn);
5653 if (swi_get_ayanamsa_with_speed(ndp->teval, iflag, daya, serr) == ERR)
5654 return ERR;
5655 ndp->xreturn[0] -= daya[0] * DEGTORAD;
5656 ndp->xreturn[3] -= daya[1] * DEGTORAD;
5657 swi_polcart_sp(ndp->xreturn, ndp->xreturn+6);
5658 }
5659 } else if (iflag & SEFLG_J2000) {
5660 /* node and apogee are referred to t;
5661 * the ecliptic position must be transformed to J2000 */
5662 for (i = 0; i <= 5; i++)
5663 x[i] = ndp->xreturn[18+i];
5664 /* precess to J2000 */
5665 swi_precess(x, tjd, iflag, J_TO_J2000);
5666 if (iflag & SEFLG_SPEED)
5667 swi_precess_speed(x, tjd, iflag, J_TO_J2000);
5668 for (i = 0; i <= 5; i++)
5669 ndp->xreturn[18+i] = x[i];
5670 swi_cartpol_sp(ndp->xreturn+18, ndp->xreturn+12);
5671 swi_coortrf2(ndp->xreturn+18, ndp->xreturn+6, swed.oec2000.seps, swed.oec2000.ceps);
5672 if (iflag & SEFLG_SPEED)
5673 swi_coortrf2(ndp->xreturn+21, ndp->xreturn+9, swed.oec2000.seps, swed.oec2000.ceps);
5674 swi_cartpol_sp(ndp->xreturn+6, ndp->xreturn);
5675 }
5676 #endif
5677 /**********************
5678 * radians to degrees *
5679 **********************/
5680 /*if (!(iflag & SEFLG_RADIANS)) {*/
5681 for (i = 0; i < 2; i++) {
5682 ndp->xreturn[i] *= RADTODEG; /* ecliptic */
5683 ndp->xreturn[i+3] *= RADTODEG;
5684 ndp->xreturn[i+12] *= RADTODEG; /* equator */
5685 ndp->xreturn[i+15] *= RADTODEG;
5686 }
5687 ndp->xreturn[0] = swe_degnorm(ndp->xreturn[0]);
5688 ndp->xreturn[12] = swe_degnorm(ndp->xreturn[12]);
5689 /*}*/
5690 }
5691 return OK;
5692 }
5693
5694 /* lunar osculating elements, i.e.
5695 */
intp_apsides(double tjd,int ipl,int32 iflag,char * serr)5696 static int intp_apsides(double tjd, int ipl, int32 iflag, char *serr)
5697 {
5698 int i;
5699 int32 flg1, flg2;
5700 struct plan_data *ndp;
5701 struct epsilon *oe;
5702 struct nut *nut;
5703 double daya[2];
5704 double speed_intv = 0.1;
5705 double t, dt;
5706 double xpos[3][6], xx[6], x[6];
5707 int32 speedf1, speedf2;
5708 oe = &swed.oec;
5709 nut = &swed.nut;
5710 ndp = &swed.nddat[ipl];
5711 /* if same calculation was done before, return
5712 * if speed flag has been turned on, recompute */
5713 flg1 = iflag & ~SEFLG_EQUATORIAL & ~SEFLG_XYZ;
5714 flg2 = ndp->xflgs & ~SEFLG_EQUATORIAL & ~SEFLG_XYZ;
5715 speedf1 = ndp->xflgs & SEFLG_SPEED;
5716 speedf2 = iflag & SEFLG_SPEED;
5717 if (tjd == ndp->teval
5718 && tjd != 0
5719 && flg1 == flg2
5720 && (!speedf2 || speedf1)) {
5721 ndp->xflgs = iflag;
5722 ndp->iephe = iflag & SEFLG_MOSEPH;
5723 return OK;
5724 }
5725 /*********************************************
5726 * now three apsides *
5727 *********************************************/
5728 for (t = tjd - speed_intv, i = 0; i < 3; t += speed_intv, i++) {
5729 if (! (iflag & SEFLG_SPEED) && i != 1) continue;
5730 swi_intp_apsides(t, xpos[i], ipl);
5731 }
5732 /************************************************************
5733 * apsis with speed *
5734 ************************************************************/
5735 for (i = 0; i < 3; i++) {
5736 xx[i] = xpos[1][i];
5737 xx[i+3] = 0;
5738 }
5739 if (iflag & SEFLG_SPEED) {
5740 xx[3] = swe_difrad2n(xpos[2][0], xpos[0][0]) / speed_intv / 2.0;
5741 xx[4] = (xpos[2][1] - xpos[0][1]) / speed_intv / 2.0;
5742 xx[5] = (xpos[2][2] - xpos[0][2]) / speed_intv / 2.0;
5743 }
5744 memset((void *) ndp->xreturn, 0, 24 * sizeof(double));
5745 /* ecliptic polar to cartesian */
5746 swi_polcart_sp(xx, xx);
5747 /* light-time */
5748 if (!(iflag & SEFLG_TRUEPOS)) {
5749 dt = sqrt(square_sum(xx)) * AUNIT / CLIGHT / 86400.0;
5750 for (i = 1; i < 3; i++)
5751 xx[i] -= dt * xx[i+3];
5752 }
5753 for (i = 0; i <= 5; i++)
5754 ndp->xreturn[i+6] = xx[i];
5755 /*printf("%.10f, %.10f, %.10f, %.10f\n", xx[0] /DEGTORAD, xx[1] / DEGTORAD, xx [2], xx[3] /DEGTORAD);*/
5756 /* equatorial cartesian */
5757 swi_coortrf2(ndp->xreturn+6, ndp->xreturn+18, -oe->seps, oe->ceps);
5758 if (iflag & SEFLG_SPEED)
5759 swi_coortrf2(ndp->xreturn+9, ndp->xreturn+21, -oe->seps, oe->ceps);
5760 ndp->teval = tjd;
5761 ndp->xflgs = iflag;
5762 ndp->iephe = iflag & SEFLG_EPHMASK;
5763 if (iflag & SEFLG_SIDEREAL) {
5764 /* apogee is referred to t;
5765 * the ecliptic position must be transformed to t0 */
5766 /* rigorous algorithm */
5767 if ((swed.sidd.sid_mode & SE_SIDBIT_ECL_T0)
5768 || (swed.sidd.sid_mode & SE_SIDBIT_SSY_PLANE)) {
5769 for (i = 0; i <= 5; i++)
5770 x[i] = ndp->xreturn[18+i];
5771 /* precess to J2000 */
5772 swi_precess(x, tjd, iflag, J_TO_J2000);
5773 if (iflag & SEFLG_SPEED)
5774 swi_precess_speed(x, tjd, iflag, J_TO_J2000);
5775 if (swed.sidd.sid_mode & SE_SIDBIT_ECL_T0)
5776 swi_trop_ra2sid_lon(x, ndp->xreturn+6, ndp->xreturn+18, iflag);
5777 /* project onto solar system equator */
5778 else if (swed.sidd.sid_mode & SE_SIDBIT_SSY_PLANE)
5779 swi_trop_ra2sid_lon_sosy(x, ndp->xreturn+6, iflag);
5780 /* to polar */
5781 swi_cartpol_sp(ndp->xreturn+6, ndp->xreturn);
5782 swi_cartpol_sp(ndp->xreturn+18, ndp->xreturn+12);
5783 } else {
5784 /* traditional algorithm */
5785 swi_cartpol_sp(ndp->xreturn+6, ndp->xreturn);
5786 if (swi_get_ayanamsa_with_speed(ndp->teval, iflag, daya, serr) == ERR)
5787 return ERR;
5788 ndp->xreturn[0] -= daya[0] * DEGTORAD;
5789 ndp->xreturn[3] -= daya[1] * DEGTORAD;
5790 swi_polcart_sp(ndp->xreturn, ndp->xreturn+6);
5791 swi_cartpol_sp(ndp->xreturn+18, ndp->xreturn+12);
5792 }
5793 } else if (iflag & SEFLG_J2000) {
5794 /* node and apogee are referred to t;
5795 * the ecliptic position must be transformed to J2000 */
5796 for (i = 0; i <= 5; i++)
5797 x[i] = ndp->xreturn[18+i];
5798 /* precess to J2000 */
5799 swi_precess(x, tjd, iflag, J_TO_J2000);
5800 if (iflag & SEFLG_SPEED)
5801 swi_precess_speed(x, tjd, iflag, J_TO_J2000);
5802 for (i = 0; i <= 5; i++)
5803 ndp->xreturn[18+i] = x[i];
5804 swi_cartpol_sp(ndp->xreturn+18, ndp->xreturn+12);
5805 swi_coortrf2(ndp->xreturn+18, ndp->xreturn+6, swed.oec2000.seps, swed.oec2000.ceps);
5806 if (iflag & SEFLG_SPEED)
5807 swi_coortrf2(ndp->xreturn+21, ndp->xreturn+9, swed.oec2000.seps, swed.oec2000.ceps);
5808 swi_cartpol_sp(ndp->xreturn+6, ndp->xreturn);
5809 } else {
5810 /* tropical ecliptic positions */
5811 /* precession has already been taken into account, but not nutation */
5812 if (!(iflag & SEFLG_NONUT)) {
5813 swi_nutate(ndp->xreturn+18, iflag, FALSE);
5814 }
5815 /* equatorial polar */
5816 swi_cartpol_sp(ndp->xreturn+18, ndp->xreturn+12);
5817 /* ecliptic cartesian */
5818 swi_coortrf2(ndp->xreturn+18, ndp->xreturn+6, oe->seps, oe->ceps);
5819 if (iflag & SEFLG_SPEED)
5820 swi_coortrf2(ndp->xreturn+21, ndp->xreturn+9, oe->seps, oe->ceps);
5821 if (!(iflag & SEFLG_NONUT)) {
5822 swi_coortrf2(ndp->xreturn+6, ndp->xreturn+6, nut->snut, nut->cnut);
5823 if (iflag & SEFLG_SPEED)
5824 swi_coortrf2(ndp->xreturn+9, ndp->xreturn+9, nut->snut, nut->cnut);
5825 }
5826 /* ecliptic polar */
5827 swi_cartpol_sp(ndp->xreturn+6, ndp->xreturn);
5828 }
5829 /**********************
5830 * radians to degrees *
5831 **********************/
5832 /*if (!(iflag & SEFLG_RADIANS)) {*/
5833 for (i = 0; i < 2; i++) {
5834 ndp->xreturn[i] *= RADTODEG; /* ecliptic */
5835 ndp->xreturn[i+3] *= RADTODEG;
5836 ndp->xreturn[i+12] *= RADTODEG; /* equator */
5837 ndp->xreturn[i+15] *= RADTODEG;
5838 }
5839 ndp->xreturn[0] = swe_degnorm(ndp->xreturn[0]);
5840 ndp->xreturn[12] = swe_degnorm(ndp->xreturn[12]);
5841 /*}*/
5842 return OK;
5843 }
5844
5845 /* transforms the position of the moon in a way we can use it
5846 * for calculation of osculating node and apogee:
5847 * precession and nutation (attention to speed vector!)
5848 * according to flags
5849 * iflag flags
5850 * tjd time for which the element is computed
5851 * i.e. date of ecliptic
5852 * xx array equatorial cartesian position and speed
5853 * serr error string
5854 */
swi_plan_for_osc_elem(int32 iflag,double tjd,double * xx)5855 int swi_plan_for_osc_elem(int32 iflag, double tjd, double *xx)
5856 {
5857 int i;
5858 double x[6];
5859 struct nut nuttmp;
5860 struct nut *nutp = &nuttmp; /* dummy assign, to silence gcc warning */
5861 struct epsilon *oe = &swed.oec;
5862 struct epsilon oectmp;
5863 /* ICRS to J2000 */
5864 if (!(iflag & SEFLG_ICRS) && swi_get_denum(SEI_SUN, iflag) >= 403) {
5865 swi_bias(xx, tjd, iflag, FALSE);
5866 }/**/
5867 /************************************************
5868 * precession, equator 2000 -> equator of date *
5869 * attention: speed vector has to be rotated, *
5870 * but daily precession 0.137" may not be added!*/
5871 #ifdef SID_TNODE_FROM_ECL_T0
5872 struct sid_data *sip = &swed.sidd;
5873 /* For sidereal calculation we need node refered*
5874 * to ecliptic of t0 of ayanamsa *
5875 ************************************************/
5876 if (iflag & SEFLG_SIDEREAL) {
5877 tjd = sip->t0;
5878 swi_precess(xx, tjd, iflag, J2000_TO_J);
5879 swi_precess(xx+3, tjd, iflag, J2000_TO_J);
5880 calc_epsilon(tjd, iflag, &oectmp);
5881 oe = &oectmp;
5882 } else if (!(iflag & SEFLG_J2000)) {
5883 #endif
5884 swi_precess(xx, tjd, iflag, J2000_TO_J);
5885 swi_precess(xx+3, tjd, iflag, J2000_TO_J);
5886 /* epsilon */
5887 if (tjd == swed.oec.teps)
5888 oe = &swed.oec;
5889 else if (tjd == J2000)
5890 oe = &swed.oec2000;
5891 else {
5892 calc_epsilon(tjd, iflag, &oectmp);
5893 oe = &oectmp;
5894 }
5895 #ifdef SID_TNODE_FROM_ECL_T0
5896 } else /* if SEFLG_J2000 */
5897 oe = &swed.oec2000;
5898 #endif
5899 /************************************************
5900 * nutation *
5901 * again: speed vector must be rotated, but not *
5902 * added 'speed' of nutation *
5903 ************************************************/
5904 if (!(iflag & SEFLG_NONUT)) {
5905 if (tjd == swed.nut.tnut) {
5906 nutp = &swed.nut;
5907 } else if (tjd == J2000) {
5908 nutp = &swed.nut2000;
5909 } else if (tjd == swed.nutv.tnut) {
5910 nutp = &swed.nutv;
5911 } else {
5912 nutp = &nuttmp;
5913 swi_nutation(tjd, iflag, nutp->nutlo);
5914 nutp->tnut = tjd;
5915 nutp->snut = sin(nutp->nutlo[1]);
5916 nutp->cnut = cos(nutp->nutlo[1]);
5917 nut_matrix(nutp, oe);
5918 }
5919 for (i = 0; i <= 2; i++) {
5920 x[i] = xx[0] * nutp->matrix[0][i] +
5921 xx[1] * nutp->matrix[1][i] +
5922 xx[2] * nutp->matrix[2][i];
5923 }
5924 /* speed:
5925 * rotation only */
5926 for (i = 0; i <= 2; i++) {
5927 x[i+3] = xx[3] * nutp->matrix[0][i] +
5928 xx[4] * nutp->matrix[1][i] +
5929 xx[5] * nutp->matrix[2][i];
5930 }
5931 for (i = 0; i <= 5; i++)
5932 xx[i] = x[i];
5933 }
5934 /************************************************
5935 * transformation to ecliptic *
5936 ************************************************/
5937 swi_coortrf2(xx, xx, oe->seps, oe->ceps);
5938 swi_coortrf2(xx+3, xx+3, oe->seps, oe->ceps);
5939 #ifdef SID_TNODE_FROM_ECL_T0
5940 if (iflag & SEFLG_SIDEREAL) {
5941 /* subtract ayan_t0 */
5942 swi_cartpol_sp(xx, xx);
5943 xx[0] -= sip->ayan_t0;
5944 swi_polcart_sp(xx, xx);
5945 } else
5946 #endif
5947 if (!(iflag & SEFLG_NONUT)) {
5948 swi_coortrf2(xx, xx, nutp->snut, nutp->cnut);
5949 swi_coortrf2(xx+3, xx+3, nutp->snut, nutp->cnut);
5950 }
5951 return(OK);
5952 }
5953
5954 static const struct meff_ele eff_arr[] = {
5955 /*
5956 * r , m_eff for photon passing the sun at min distance r (fraction of Rsun)
5957 * the values where computed with sun_model.c, which is a classic
5958 * treatment of a photon passing a gravity field, multiplied by 2.
5959 * The sun mass distribution m(r) is from Michael Stix, The Sun, p. 47.
5960 */
5961 {1.000, 1.000000},
5962 {0.990, 0.999979},
5963 {0.980, 0.999940},
5964 {0.970, 0.999881},
5965 {0.960, 0.999811},
5966 {0.950, 0.999724},
5967 {0.940, 0.999622},
5968 {0.930, 0.999497},
5969 {0.920, 0.999354},
5970 {0.910, 0.999192},
5971 {0.900, 0.999000},
5972 {0.890, 0.998786},
5973 {0.880, 0.998535},
5974 {0.870, 0.998242},
5975 {0.860, 0.997919},
5976 {0.850, 0.997571},
5977 {0.840, 0.997198},
5978 {0.830, 0.996792},
5979 {0.820, 0.996316},
5980 {0.810, 0.995791},
5981 {0.800, 0.995226},
5982 {0.790, 0.994625},
5983 {0.780, 0.993991},
5984 {0.770, 0.993326},
5985 {0.760, 0.992598},
5986 {0.750, 0.991770},
5987 {0.740, 0.990873},
5988 {0.730, 0.989919},
5989 {0.720, 0.988912},
5990 {0.710, 0.987856},
5991 {0.700, 0.986755},
5992 {0.690, 0.985610},
5993 {0.680, 0.984398},
5994 {0.670, 0.982986},
5995 {0.660, 0.981437},
5996 {0.650, 0.979779},
5997 {0.640, 0.978024},
5998 {0.630, 0.976182},
5999 {0.620, 0.974256},
6000 {0.610, 0.972253},
6001 {0.600, 0.970174},
6002 {0.590, 0.968024},
6003 {0.580, 0.965594},
6004 {0.570, 0.962797},
6005 {0.560, 0.959758},
6006 {0.550, 0.956515},
6007 {0.540, 0.953088},
6008 {0.530, 0.949495},
6009 {0.520, 0.945741},
6010 {0.510, 0.941838},
6011 {0.500, 0.937790},
6012 {0.490, 0.933563},
6013 {0.480, 0.928668},
6014 {0.470, 0.923288},
6015 {0.460, 0.917527},
6016 {0.450, 0.911432},
6017 {0.440, 0.905035},
6018 {0.430, 0.898353},
6019 {0.420, 0.891022},
6020 {0.410, 0.882940},
6021 {0.400, 0.874312},
6022 {0.390, 0.865206},
6023 {0.380, 0.855423},
6024 {0.370, 0.844619},
6025 {0.360, 0.833074},
6026 {0.350, 0.820876},
6027 {0.340, 0.808031},
6028 {0.330, 0.793962},
6029 {0.320, 0.778931},
6030 {0.310, 0.763021},
6031 {0.300, 0.745815},
6032 {0.290, 0.727557},
6033 {0.280, 0.708234},
6034 {0.270, 0.687583},
6035 {0.260, 0.665741},
6036 {0.250, 0.642597},
6037 {0.240, 0.618252},
6038 {0.230, 0.592586},
6039 {0.220, 0.565747},
6040 {0.210, 0.537697},
6041 {0.200, 0.508554},
6042 {0.190, 0.478420},
6043 {0.180, 0.447322},
6044 {0.170, 0.415454},
6045 {0.160, 0.382892},
6046 {0.150, 0.349955},
6047 {0.140, 0.316691},
6048 {0.130, 0.283565},
6049 {0.120, 0.250431},
6050 {0.110, 0.218327},
6051 {0.100, 0.186794},
6052 {0.090, 0.156287},
6053 {0.080, 0.128421},
6054 {0.070, 0.102237},
6055 {0.060, 0.077393},
6056 {0.050, 0.054833},
6057 {0.040, 0.036361},
6058 {0.030, 0.020953},
6059 {0.020, 0.009645},
6060 {0.010, 0.002767},
6061 {0.000, 0.000000}
6062 };
meff(double r)6063 static double meff(double r)
6064 {
6065 double f, m;
6066 int i;
6067 if (r <= 0)
6068 return 0.0;
6069 else if (r >= 1)
6070 return 1.0;
6071 for (i = 0; eff_arr[i].r > r; i++)
6072 ; /* empty body */
6073 f = (r - eff_arr[i-1].r) / (eff_arr[i].r - eff_arr[i-1].r);
6074 m = eff_arr[i-1].m + f * (eff_arr[i].m - eff_arr[i-1].m);
6075 return m;
6076 }
6077
denormalize_positions(double * x0,double * x1,double * x2)6078 static void denormalize_positions(double *x0, double *x1, double *x2)
6079 {
6080 int i;
6081 /* x*[0] = ecliptic longitude, x*[12] = rectascension */
6082 for (i = 0; i <= 12; i += 12) {
6083 if (x1[i] - x0[i] < -180)
6084 x0[i] -= 360;
6085 if (x1[i] - x0[i] > 180)
6086 x0[i] += 360;
6087 if (x1[i] - x2[i] < -180)
6088 x2[i] -= 360;
6089 if (x1[i] - x2[i] > 180)
6090 x2[i] += 360;
6091 }
6092 }
6093
calc_speed(double * x0,double * x1,double * x2,double dt)6094 static void calc_speed(double *x0, double *x1, double *x2, double dt)
6095 {
6096 int i, j, k;
6097 double a, b;
6098 for (j = 0; j <= 18; j += 6) {
6099 for (i = 0; i < 3; i++) {
6100 k = j + i;
6101 b = (x2[k] - x0[k]) / 2;
6102 a = (x2[k] + x0[k]) / 2 - x1[k];
6103 x1[k+3] = (2 * a + b) / dt;
6104 }
6105 }
6106 }
6107
swi_check_ecliptic(double tjd,int32 iflag)6108 void swi_check_ecliptic(double tjd, int32 iflag)
6109 {
6110 if (swed.oec2000.teps != J2000) {
6111 calc_epsilon(J2000, iflag, &swed.oec2000);
6112 }
6113 if (tjd == J2000) {
6114 swed.oec.teps = swed.oec2000.teps;
6115 swed.oec.eps = swed.oec2000.eps;
6116 swed.oec.seps = swed.oec2000.seps;
6117 swed.oec.ceps = swed.oec2000.ceps;
6118 return;
6119 }
6120 if (swed.oec.teps != tjd || tjd == 0) {
6121 calc_epsilon(tjd, iflag, &swed.oec);
6122 }
6123 }
6124
6125 /* computes nutation, if it is wanted and has not yet been computed.
6126 * if speed flag has been turned on since last computation,
6127 * nutation is recomputed */
swi_check_nutation(double tjd,int32 iflag)6128 void swi_check_nutation(double tjd, int32 iflag)
6129 {
6130 int32 speedf1, speedf2;
6131 static TLS int32 nutflag = 0;
6132 double t;
6133 speedf1 = nutflag & SEFLG_SPEED;
6134 speedf2 = iflag & SEFLG_SPEED;
6135 if (!(iflag & SEFLG_NONUT)
6136 && (tjd != swed.nut.tnut || tjd == 0
6137 || (!speedf1 && speedf2))) {
6138 swi_nutation(tjd, iflag, swed.nut.nutlo);
6139 swed.nut.tnut = tjd;
6140 swed.nut.snut = sin(swed.nut.nutlo[1]);
6141 swed.nut.cnut = cos(swed.nut.nutlo[1]);
6142 nutflag = iflag;
6143 nut_matrix(&swed.nut, &swed.oec);
6144 if (iflag & SEFLG_SPEED) {
6145 /* once more for 'speed' of nutation, which is needed for
6146 * planetary speeds */
6147 t = tjd - NUT_SPEED_INTV;
6148 swi_nutation(t, iflag, swed.nutv.nutlo);
6149 swed.nutv.tnut = t;
6150 swed.nutv.snut = sin(swed.nutv.nutlo[1]);
6151 swed.nutv.cnut = cos(swed.nutv.nutlo[1]);
6152 nut_matrix(&swed.nutv, &swed.oec);
6153 }
6154 }
6155 }
6156
6157 /* function
6158 * - corrects nonsensical iflags
6159 * - completes incomplete iflags
6160 */
plaus_iflag(int32 iflag,int32 ipl,double tjd,char * serr)6161 static int32 plaus_iflag(int32 iflag, int32 ipl, double tjd, char *serr)
6162 {
6163 int32 epheflag = 0;
6164 int jplhor_model = swed.astro_models[SE_MODEL_JPLHOR_MODE];
6165 int jplhora_model = swed.astro_models[SE_MODEL_JPLHORA_MODE];
6166 if (jplhor_model == 0) jplhor_model = SEMOD_JPLHOR_DEFAULT;
6167 if (jplhora_model == 0) jplhora_model = SEMOD_JPLHORA_DEFAULT;
6168 /* either Horizons mode or simplified Horizons mode, not both */
6169 if (iflag & SEFLG_JPLHOR)
6170 iflag &= ~SEFLG_JPLHOR_APPROX;
6171 /* if topocentric bit, turn helio- and barycentric bits off;
6172 */
6173 if (iflag & SEFLG_TOPOCTR) {
6174 iflag = iflag & ~(SEFLG_HELCTR | SEFLG_BARYCTR);
6175 }
6176 /* if barycentric bit, turn heliocentric bit off */
6177 if (iflag & SEFLG_BARYCTR)
6178 iflag = iflag & ~(SEFLG_HELCTR);
6179 if (iflag & SEFLG_HELCTR)
6180 iflag = iflag & ~(SEFLG_BARYCTR);
6181 /* if heliocentric bit, turn aberration and deflection off */
6182 if (iflag & (SEFLG_HELCTR|SEFLG_BARYCTR))
6183 iflag |= SEFLG_NOABERR | SEFLG_NOGDEFL; /*iflag |= SEFLG_TRUEPOS;*/
6184 /* if no_precession bit is set, set also no_nutation bit */
6185 if (iflag & SEFLG_J2000)
6186 iflag |= SEFLG_NONUT;
6187 /* if sidereal bit is set, set also no_nutation bit *
6188 * also turn JPL Horizons mode off */
6189 if (iflag & SEFLG_SIDEREAL) {
6190 iflag |= SEFLG_NONUT;
6191 iflag = iflag & ~(SEFLG_JPLHOR | SEFLG_JPLHOR_APPROX);
6192 }
6193 /* if truepos is set, turn off grav. defl. and aberration */
6194 if (iflag & SEFLG_TRUEPOS)
6195 iflag |= (SEFLG_NOGDEFL | SEFLG_NOABERR);
6196 if (iflag & SEFLG_MOSEPH)
6197 epheflag = SEFLG_MOSEPH;
6198 if (iflag & SEFLG_SWIEPH)
6199 epheflag = SEFLG_SWIEPH;
6200 if (iflag & SEFLG_JPLEPH)
6201 epheflag = SEFLG_JPLEPH;
6202 if (epheflag == 0)
6203 epheflag = SEFLG_DEFAULTEPH;
6204 iflag = (iflag & ~SEFLG_EPHMASK) | epheflag;
6205 /* SEFLG_JPLHOR only with JPL and Swiss Ephemeeris */
6206 if (!(epheflag & SEFLG_JPLEPH))
6207 iflag = iflag & ~(SEFLG_JPLHOR | SEFLG_JPLHOR_APPROX);
6208 /* planets that have no JPL Horizons mode */
6209 if (ipl == SE_OSCU_APOG || ipl == SE_TRUE_NODE
6210 || ipl == SE_MEAN_APOG || ipl == SE_MEAN_NODE
6211 || ipl == SE_INTP_APOG || ipl == SE_INTP_PERG)
6212 iflag = iflag & ~(SEFLG_JPLHOR | SEFLG_JPLHOR_APPROX);
6213 if (ipl >= SE_FICT_OFFSET && ipl <= SE_FICT_MAX)
6214 iflag = iflag & ~(SEFLG_JPLHOR | SEFLG_JPLHOR_APPROX);
6215 /* SEFLG_JPLHOR requires SEFLG_ICRS, if calculated with * precession/nutation IAU 1980 and corrections dpsi, deps */
6216 if (iflag & SEFLG_JPLHOR) {
6217 if (swed.eop_dpsi_loaded <= 0) {
6218 if (serr != NULL) {
6219 switch (swed.eop_dpsi_loaded) {
6220 case 0:
6221 strcpy(serr, "you did not call swe_set_jpl_file(); default to SEFLG_JPLHOR_APPROX");
6222 break;
6223 case -1:
6224 strcpy(serr, "file eop_1962_today.txt not found; default to SEFLG_JPLHOR_APPROX");
6225 break;
6226 case -2:
6227 strcpy(serr, "file eop_1962_today.txt corrupt; default to SEFLG_JPLHOR_APPROX");
6228 break;
6229 case -3:
6230 strcpy(serr, "file eop_finals.txt corrupt; default to SEFLG_JPLHOR_APPROX");
6231 break;
6232 }
6233 }
6234 iflag &= ~SEFLG_JPLHOR;
6235 iflag |= SEFLG_JPLHOR_APPROX;
6236 }
6237 }
6238 if (iflag & SEFLG_JPLHOR)
6239 iflag |= SEFLG_ICRS;
6240 if ((iflag & SEFLG_JPLHOR_APPROX) && jplhora_model == SEMOD_JPLHORA_2)
6241 iflag |= SEFLG_ICRS;
6242 return iflag;
6243 }
6244
6245 /* function formats the input search name of a star:
6246 * - remove white spaces
6247 * - traditional name to lower case (Bayer designation remains as it is)
6248 */
fixstar_format_search_name(char * star,char * sstar,char * serr)6249 static int32 fixstar_format_search_name(char *star, char *sstar, char *serr)
6250 {
6251 char *sp;
6252 size_t cmplen;
6253 strncpy(sstar, star, SWI_STAR_LENGTH);
6254 sstar[SWI_STAR_LENGTH] = '\0';
6255 // remove whitespaces from search name
6256 while ((sp = strchr(sstar, ' ')) != NULL)
6257 swi_strcpy(sp, sp+1);
6258 /* traditional name of star to lower case;
6259 * keep uppercase with Bayer/Flamsteed designations after comma */
6260 for (sp = sstar; *sp != '\0' && *sp != ','; sp++)
6261 *sp = tolower((int) *sp);
6262 cmplen = strlen(sstar);
6263 if (cmplen == 0) {
6264 if (serr != NULL)
6265 sprintf(serr, "swe_fixstar(): star name empty");
6266 return ERR;
6267 }
6268 return OK;
6269 }
6270
6271 /* function saves a fixstar in fixed stars list
6272 */
save_star_in_struct(int nrecs,struct fixed_star * fstp,char * serr)6273 static int32 save_star_in_struct(int nrecs, struct fixed_star *fstp, char *serr)
6274 {
6275 int sizestru = sizeof(struct fixed_star);
6276 struct fixed_star *ftarget;
6277 char *serr_alloc = "error in function load_all_fixed_stars(): could not resize fixed stars array";
6278 if ((swed.fixed_stars = (struct fixed_star *) realloc(swed.fixed_stars, nrecs * sizestru)) == NULL) {
6279 if (serr != NULL) strcpy(serr, serr_alloc);
6280 return ERR;
6281 }
6282 ftarget = swed.fixed_stars + (nrecs - 1);
6283 memcpy((void *) ftarget, (void *) fstp, sizestru);
6284 return OK;
6285 }
6286
6287 /* function for sorting fixed stars with qsort() */
fixedstar_name_compare(const void * star1,const void * star2)6288 static int CMP_CALL_CONV fixedstar_name_compare(const void *star1, const void *star2)
6289 {
6290 const struct fixed_star *fs1 = (const struct fixed_star *) star1;
6291 const struct fixed_star *fs2 = (const struct fixed_star *) star2;
6292 return strcmp(fs1->skey, fs2->skey);
6293 }
6294
6295 /* help function for finding a fixed star with bsearch() */
fstar_node_compare(const void * node1,const void * node2)6296 static int CMP_CALL_CONV fstar_node_compare(const void *node1, const void *node2)
6297 {
6298 const struct fixed_star *n1 = (const struct fixed_star *) node1;
6299 const struct fixed_star *n2 = (const struct fixed_star *) node2;
6300 return strcmp(n1->skey, n2->skey);
6301 }
6302
6303 /* function cuts a comma-separated fixed star data record from sefstars.txt
6304 * and fills it into a struct fixed_star.
6305 */
fixstar_cut_string(char * srecord,char * star,struct fixed_star * stardata,char * serr)6306 int32 fixstar_cut_string(char *srecord, char *star, struct fixed_star *stardata, char *serr)
6307 {
6308 int i;
6309 char s[AS_MAXCH];
6310 char *sde_d;
6311 char *cpos[20];
6312 double epoch, radv, parall, mag;
6313 double ra_s, ra_pm, de_pm, ra, de;
6314 double ra_h, ra_m, de_d, de_m, de_s;
6315 strcpy(s, srecord);
6316 i = swi_cutstr(s, ",", cpos, 20);
6317 /* return trad. name, nomeclature name */
6318 swi_right_trim(cpos[0]);
6319 swi_right_trim(cpos[1]);
6320 if (i < 14) {
6321 if (serr != NULL) {
6322 if (i >= 2) {
6323 sprintf(serr, "data of star '%s,%s' incomplete", cpos[0], cpos[1]);
6324 } else {
6325 if (strlen(s) > 200) s[200] = '\0';
6326 sprintf(serr, "invalid line in fixed stars file: '%s'", s);
6327 }
6328 }
6329 return ERR;
6330 }
6331 if (strlen(cpos[0]) > SWI_STAR_LENGTH)
6332 cpos[0][SWI_STAR_LENGTH] = '\0';
6333 if (strlen(cpos[1]) > SWI_STAR_LENGTH-1)
6334 cpos[1][SWI_STAR_LENGTH-1] = '\0';
6335 if (star != NULL) {
6336 strcpy(star, cpos[0]);
6337 if (strlen(cpos[0]) + strlen(cpos[1]) + 1 < SWI_STAR_LENGTH - 1)
6338 sprintf(star + strlen(star), ",%s", cpos[1]);
6339 }
6340 strcpy(stardata->starname, cpos[0]);
6341 strcpy(stardata->starbayer, cpos[1]);
6342 // star data
6343 epoch = atof(cpos[2]);
6344 ra_h = atof(cpos[3]);
6345 ra_m = atof(cpos[4]);
6346 ra_s = atof(cpos[5]);
6347 de_d = atof(cpos[6]);
6348 sde_d = cpos[6];
6349 de_m = atof(cpos[7]);
6350 de_s = atof(cpos[8]);
6351 ra_pm = atof(cpos[9]);
6352 de_pm = atof(cpos[10]);
6353 radv = atof(cpos[11]);
6354 parall = atof(cpos[12]);
6355 mag = atof(cpos[13]);
6356 /****************************************
6357 * position and speed (equinox)
6358 ****************************************/
6359 /* ra and de in degrees */
6360 ra = (ra_s / 3600.0 + ra_m / 60.0 + ra_h) * 15.0;
6361 if (strchr(sde_d, '-') == NULL)
6362 de = de_s / 3600.0 + de_m / 60.0 + de_d;
6363 else
6364 de = -de_s / 3600.0 - de_m / 60.0 + de_d;
6365 /* speed in ra and de, degrees per century */
6366 if (swed.is_old_starfile == TRUE) {
6367 ra_pm = ra_pm * 15 / 3600.0;
6368 de_pm = de_pm / 3600.0;
6369 } else {
6370 ra_pm = ra_pm / 10.0 / 3600.0;
6371 de_pm = de_pm / 10.0 / 3600.0;
6372 parall /= 1000.0;
6373 }
6374 /* parallax, degrees */
6375 if (parall > 1)
6376 parall = (1 / parall / 3600.0);
6377 else
6378 parall /= 3600;
6379 /* radial velocity in AU per century */
6380 radv *= KM_S_TO_AU_CTY;
6381 /*printf("ra=%.17f,de=%.17f,ma=%.17f,md=%.17f,pa=%.17f,rv=%.17f\n",ra,de,ra_pm,de_pm,parall,radv);*/
6382 /* radians */
6383 ra *= DEGTORAD;
6384 de *= DEGTORAD;
6385 ra_pm *= DEGTORAD;
6386 de_pm *= DEGTORAD;
6387 ra_pm /= cos(de); /* catalogues give proper motion in RA as great circle */
6388 parall *= DEGTORAD;
6389 stardata->epoch = epoch;
6390 stardata->ra = ra;
6391 stardata->de = de;
6392 stardata->ramot = ra_pm;
6393 stardata->demot = de_pm;
6394 stardata->parall = parall;
6395 stardata->radvel = radv;
6396 stardata->mag = mag;
6397 return OK;
6398 }
6399
6400 /* function loads all fixed stars from file sefstars.txt,
6401 * into swed.fixed_stars, which is a pointer to an array
6402 * of struct fixed_stars.
6403 * Every star has a record with its Bayer/Flamsteed designation
6404 * as its search key.
6405 * Every star also has a record with its sequential number in
6406 * the file as its search key. (Good for calculating all stars in a loop.)
6407 * If a star has a traditional name, we create a record that has
6408 * this name as its search key.
6409 * The array is sorted in ascending order by search key.
6410 *
6411 * If an error occurs, the function returns value ERR.
6412 * If the stars were loaded at an earlier time the function returns
6413 * value -2, without doing anything and without error string.
6414 * On success, the function returns value OK.
6415 * */
load_all_fixed_stars(char * serr)6416 static int32 load_all_fixed_stars(char *serr)
6417 {
6418 int32 retc = OK;
6419 int nstars = 0, line = 0, fline = 0, nrecs = 0, nnamed = 0;
6420 char s[AS_MAXCH], *sp;
6421 char srecord[AS_MAXCH];
6422 struct fixed_star fstdata;
6423 char last_starbayer[SWI_STAR_LENGTH + 1];
6424 *last_starbayer = '\0';
6425 if (swed.n_fixstars_records > 0) {
6426 return -2;
6427 }
6428 if (swed.fixfp == NULL) {
6429 if ((swed.fixfp = swi_fopen(SEI_FILE_FIXSTAR, SE_STARFILE, swed.ephepath, serr)) == NULL) {
6430 swed.is_old_starfile = TRUE;
6431 if ((swed.fixfp = swi_fopen(SEI_FILE_FIXSTAR, SE_STARFILE_OLD, swed.ephepath, NULL)) == NULL) {
6432 swed.is_old_starfile = FALSE;
6433 /* no fixed star file available, error message is already in serr. */
6434 return ERR;
6435 }
6436 }
6437 }
6438 rewind(swed.fixfp);
6439 swed.fixed_stars = NULL;
6440 while (fgets(s, AS_MAXCH, swed.fixfp) != NULL) {
6441 fline++;
6442 // skip comment lines
6443 if (*s == '#') continue;
6444 if (*s == '\n') continue;
6445 if (*s == '\r') continue;
6446 if (*s == '\0') continue;
6447 line++;
6448 strcpy(srecord, s);
6449 retc = fixstar_cut_string(srecord, NULL, &fstdata, serr);
6450 if (retc == ERR) return ERR;
6451 // if star has a traditional name, save it with that name as its search key
6452 if (*fstdata.starname != '\0') {
6453 nrecs++;
6454 nnamed++;
6455 strcpy(fstdata.skey, fstdata.starname);
6456 // remove white spaces from star name
6457 while ((sp = strchr(fstdata.skey, ' ')) != NULL)
6458 swi_strcpy(sp, sp+1);
6459 // star name to lowercase and compare with search string
6460 for (sp = fstdata.skey; *sp != '\0'; sp++)
6461 *sp = tolower((int) *sp);
6462 if ((retc = save_star_in_struct(nrecs, &fstdata, serr)) == ERR) return ERR;
6463 }
6464 // also save it with Bayer designation as search key;
6465 // only if it has not been saved already
6466 if (strcmp(fstdata.starbayer, last_starbayer) == 0)
6467 continue;
6468 nstars++;
6469 nrecs++;
6470 //sprintf(fstdata.skey, "~%s", fstdata.starbayer); // ~ sorts after alnum
6471 sprintf(fstdata.skey, ",%s", fstdata.starbayer); // , sorts before alnum
6472 // remove white spaces from star bayer name
6473 while ((sp = strchr(fstdata.skey, ' ')) != NULL)
6474 swi_strcpy(sp, sp+1);
6475 strcpy(last_starbayer, fstdata.starbayer);
6476 if ((retc = save_star_in_struct(nrecs, &fstdata, serr)) == ERR) return ERR;
6477 // also save it with sequential star number as search key (NO!!!!)
6478 // nrecs++;
6479 // sprintf(fstdata.skey, "%07d", nstars);
6480 // if ((retc = save_star_in_struct(nrecs, &fstdata, serr)) == ERR) return ERR;
6481 }
6482 swed.n_fixstars_real = nstars;
6483 swed.n_fixstars_named = nnamed;
6484 swed.n_fixstars_records = nrecs;
6485 //printf("nstars=%d, nrecords=%d\n", nstars, nrecs);
6486 (void) qsort ((void *) swed.fixed_stars, (size_t) nrecs, sizeof (struct fixed_star),
6487 (int (CMP_CALL_CONV *)(const void *,const void *))(fixedstar_name_compare));
6488 return retc;
6489 }
6490
6491 /* function calculates a fixstar from a star data struct
6492 * input:
6493 * struct fixed_star stardata fixed star data struct
6494 * double tjd julian daynumber
6495 * int32 iflag SEFLG_ specifications
6496 * output:
6497 * char *star star name, Bayer designation
6498 * double xx[6] position and speed
6499 * char *serr error return string
6500 */
fixstar_calc_from_struct(struct fixed_star * stardata,double tjd,int32 iflag,char * star,double * xx,char * serr)6501 static int32 fixstar_calc_from_struct(struct fixed_star *stardata, double tjd, int32 iflag, char *star, double *xx, char *serr)
6502 {
6503 int i;
6504 int32 retc = OK;
6505 double epoch, radv, parall;
6506 double ra_pm, de_pm, ra, de, t;
6507 double daya[2], rdist;
6508 double x[6], xxsv[6], xobs[6], xobs_dt[6], *xpo = NULL, *xpo_dt = NULL;
6509 static TLS double xearth[6], xearth_dt[6], xsun[6], xsun_dt[6];
6510 double dt = PLAN_SPEED_INTV * 0.1;
6511 int32 epheflag, iflgsave;
6512 struct epsilon *oe = &swed.oec2000;
6513 iflgsave = iflag;
6514 iflag |= SEFLG_SPEED; /* we need this in order to work correctly */
6515 if (serr != NULL)
6516 *serr = '\0';
6517 iflag = plaus_iflag(iflag, -1, tjd, serr);
6518 epheflag = iflag & SEFLG_EPHMASK;
6519 if (swi_init_swed_if_start() == 1 && !(epheflag & SEFLG_MOSEPH) && serr != NULL) {
6520 strcpy(serr, "Please call swe_set_ephe_path() or swe_set_jplfile() before calling swe_fixstar() or swe_fixstar_ut()");
6521 }
6522 if (swed.last_epheflag != epheflag) {
6523 free_planets();
6524 /* close and free ephemeris files */
6525 if (swed.jpl_file_is_open) {
6526 swi_close_jpl_file();
6527 swed.jpl_file_is_open = FALSE;
6528 }
6529 for (i = 0; i < SEI_NEPHFILES; i ++) {
6530 if (swed.fidat[i].fptr != NULL)
6531 fclose(swed.fidat[i].fptr);
6532 memset((void *) &swed.fidat[i], 0, sizeof(struct file_data));
6533 }
6534 swed.last_epheflag = epheflag;
6535 }
6536 /* high precision speed prevails fast speed */
6537 /* JPL Horizons is only reproduced with SEFLG_JPLEPH */
6538 if (iflag & SEFLG_SIDEREAL && !swed.ayana_is_set)
6539 swe_set_sid_mode(SE_SIDM_FAGAN_BRADLEY, 0, 0);
6540 /******************************************
6541 * obliquity of ecliptic 2000 and of date *
6542 ******************************************/
6543 swi_check_ecliptic(tjd, iflag);
6544 /******************************************
6545 * nutation *
6546 ******************************************/
6547 swi_check_nutation(tjd, iflag);
6548 sprintf(star, "%s,%s", stardata->starname, stardata->starbayer);
6549 epoch = stardata->epoch;
6550 ra_pm = stardata->ramot; de_pm = stardata->demot;
6551 radv = stardata->radvel; parall = stardata->parall;
6552 ra = stardata->ra; de = stardata->de;
6553 if (epoch == 1950)
6554 t= (tjd - B1950); /* days since 1950.0 */
6555 else /* epoch == 2000 */
6556 t= (tjd - J2000); /* days since 2000.0 */
6557 x[0] = ra;
6558 x[1] = de;
6559 x[2] = 1;
6560 if (parall == 0) {
6561 rdist = 1000000000;
6562 } else {
6563 rdist = 1.0 / (parall * RADTODEG * 3600) * PARSEC_TO_AUNIT;
6564 //rdist += t * radv / 36525.0;
6565 }
6566 // rdist = 10000; // to reproduce pre-SE2.07 star positions
6567 x[2] = rdist;
6568 x[3] = ra_pm / 36525.0;
6569 x[4] = de_pm / 36525.0;
6570 x[5] = radv / 36525.0;
6571 // Cartesian space motion vector
6572 swi_polcart_sp(x, x);
6573 /******************************************
6574 * FK5
6575 ******************************************/
6576 if (epoch == 1950) {
6577 swi_FK4_FK5(x, B1950);
6578 swi_precess(x, B1950, 0, J_TO_J2000);
6579 swi_precess(x+3, B1950, 0, J_TO_J2000);
6580 }
6581 /* FK5 to ICRF, if jpl ephemeris is referred to ICRF.
6582 * With data that are already ICRF, epoch = 0 */
6583 if (epoch != 0) {
6584 swi_icrs2fk5(x, iflag, TRUE); /* backward, i. e. to icrf */
6585 /* with ephemerides < DE403, we now convert to J2000 */
6586 if (swi_get_denum(SEI_SUN, iflag) >= 403) {
6587 swi_bias(x, J2000, SEFLG_SPEED, FALSE);
6588 }
6589 }
6590 /****************************************************
6591 * earth/sun
6592 * for parallax, light deflection, and aberration,
6593 ****************************************************/
6594 if (!(iflag & SEFLG_BARYCTR) && (!(iflag & SEFLG_HELCTR) || !(iflag & SEFLG_MOSEPH))) {
6595 if ((retc = main_planet_bary(tjd - dt, SEI_EARTH, epheflag, iflag, NO_SAVE, xearth_dt, xearth_dt, xsun_dt, NULL, serr)) != OK) {
6596 return ERR;
6597 }
6598 if ((retc = main_planet_bary(tjd, SEI_EARTH, epheflag, iflag, DO_SAVE, xearth, xearth, xsun, NULL, serr)) != OK) {
6599 return ERR;
6600 }
6601 }
6602 /************************************
6603 * observer: geocenter or topocenter
6604 ************************************/
6605 /* if topocentric position is wanted */
6606 if (iflag & SEFLG_TOPOCTR) {
6607 if (swi_get_observer(tjd - dt, iflag | SEFLG_NONUT, NO_SAVE, xobs_dt, serr) != OK)
6608 return ERR;
6609 if (swi_get_observer(tjd, iflag | SEFLG_NONUT, NO_SAVE, xobs, serr) != OK)
6610 return ERR;
6611 /* barycentric position of observer */
6612 for (i = 0; i <= 5; i++) {
6613 xobs[i] = xobs[i] + xearth[i];
6614 xobs_dt[i] = xobs_dt[i] + xearth_dt[i];
6615 }
6616 } else if (!(iflag & SEFLG_BARYCTR) && (!(iflag & SEFLG_HELCTR) || !(iflag & SEFLG_MOSEPH))) {
6617 /* barycentric position of geocenter */
6618 for (i = 0; i <= 5; i++) {
6619 xobs[i] = xearth[i];
6620 xobs_dt[i] = xearth_dt[i];
6621 }
6622 }
6623 /************************************
6624 * position and speed at tjd *
6625 ************************************/
6626 /* for parallax */
6627 if ((iflag & SEFLG_HELCTR) && (iflag & SEFLG_MOSEPH)) {
6628 xpo = NULL; /* no parallax, if moshier and heliocentric */
6629 xpo_dt = NULL; /* no parallax, if moshier and heliocentric */
6630 } else if (iflag & SEFLG_HELCTR) {
6631 xpo = xsun;//psdp->x;
6632 xpo_dt = xsun_dt;
6633 } else if (iflag & SEFLG_BARYCTR) {
6634 xpo = NULL; /* no parallax, if barycentric */
6635 xpo_dt = NULL; /* no parallax, if moshier and heliocentric */
6636 } else {
6637 xpo = xobs;
6638 xpo_dt = xobs_dt;
6639 }
6640 if (xpo == NULL) {
6641 for (i = 0; i <= 2; i++) {
6642 x[i] += t * x[i+3];
6643 }
6644 } else {
6645 for (i = 0; i <= 2; i++) {
6646 x[i] += t * x[i+3];
6647 x[i] -= xpo[i];
6648 x[i+3] -= xpo[i+3];
6649 }
6650 }
6651 /************************************
6652 * relativistic deflection of light *
6653 ************************************/
6654 if ((iflag & SEFLG_TRUEPOS) == 0 && (iflag & SEFLG_NOGDEFL) == 0) {
6655 swi_deflect_light(x, 0, iflag & SEFLG_SPEED);
6656 }
6657 /**********************************
6658 * 'annual' aberration of light *
6659 * speed is incorrect !!! *
6660 **********************************/
6661 if ((iflag & SEFLG_TRUEPOS) == 0 && (iflag & SEFLG_NOABERR) == 0)
6662 swi_aberr_light_ex(x, xpo, xpo_dt, dt, iflag & SEFLG_SPEED);
6663 /* ICRS to J2000 */
6664 if (!(iflag & SEFLG_ICRS) && (swi_get_denum(SEI_SUN, iflag) >= 403 || (iflag & SEFLG_BARYCTR))) {
6665 swi_bias(x, tjd, iflag, FALSE);
6666 }/**/
6667 /* save J2000 coordinates; required for sidereal positions */
6668 for (i = 0; i <= 5; i++)
6669 xxsv[i] = x[i];
6670 /************************************************
6671 * precession, equator 2000 -> equator of date *
6672 ************************************************/
6673 /*x[0] = -0.374018403; x[1] = -0.312548592; x[2] = -0.873168719;*/
6674 if ((iflag & SEFLG_J2000) == 0) {
6675 swi_precess(x, tjd, iflag, J2000_TO_J);
6676 if (iflag & SEFLG_SPEED)
6677 swi_precess_speed(x, tjd, iflag, J2000_TO_J);
6678 oe = &swed.oec;
6679 } else
6680 oe = &swed.oec2000;
6681 /************************************************
6682 * nutation *
6683 ************************************************/
6684 if (!(iflag & SEFLG_NONUT))
6685 swi_nutate(x, iflag, FALSE);
6686 if ((0)) {
6687 double r = sqrt(x[0] * x[0] + x[1] * x[1] + x[2] * x[2]);
6688 printf("%.17f %.17f %f\n", x[0]/r, x[1]/r, x[2]/r);
6689 }
6690 /************************************************
6691 * transformation to ecliptic. *
6692 * with sidereal calc. this will be overwritten *
6693 * afterwards. *
6694 ************************************************/
6695 if ((iflag & SEFLG_EQUATORIAL) == 0) {
6696 swi_coortrf2(x, x, oe->seps, oe->ceps);
6697 if (iflag & SEFLG_SPEED)
6698 swi_coortrf2(x+3, x+3, oe->seps, oe->ceps);
6699 if (!(iflag & SEFLG_NONUT)) {
6700 swi_coortrf2(x, x, swed.nut.snut, swed.nut.cnut);
6701 if (iflag & SEFLG_SPEED)
6702 swi_coortrf2(x+3, x+3, swed.nut.snut, swed.nut.cnut);
6703 }
6704 }
6705 // printf("%.17f, %.17f\n", x[0], x[3]);
6706 /************************************
6707 * sidereal positions *
6708 ************************************/
6709 if (iflag & SEFLG_SIDEREAL) {
6710 /* rigorous algorithm */
6711 if (swed.sidd.sid_mode & SE_SIDBIT_ECL_T0) {
6712 if (swi_trop_ra2sid_lon(xxsv, x, xxsv, iflag) != OK)
6713 return ERR;
6714 if (iflag & SEFLG_EQUATORIAL) {
6715 for (i = 0; i <= 5; i++)
6716 x[i] = xxsv[i];
6717 }
6718 /* project onto solar system equator */
6719 } else if (swed.sidd.sid_mode & SE_SIDBIT_SSY_PLANE) {
6720 if (swi_trop_ra2sid_lon_sosy(xxsv, x, iflag) != OK)
6721 return ERR;
6722 if (iflag & SEFLG_EQUATORIAL) {
6723 for (i = 0; i <= 5; i++)
6724 x[i] = xxsv[i];
6725 }
6726 /* traditional algorithm */
6727 } else {
6728 swi_cartpol_sp(x, x);
6729 // ACHTUNG: siehe Z. 2770!!!!!
6730 if (swi_get_ayanamsa_with_speed(tjd, iflag, daya, serr) == ERR)
6731 return ERR;
6732 x[0] -= daya[0] * DEGTORAD;
6733 x[3] -= daya[1] * DEGTORAD;
6734 swi_polcart_sp(x, x);
6735 }
6736 }
6737 /************************************************
6738 * transformation to polar coordinates *
6739 ************************************************/
6740 if ((iflag & SEFLG_XYZ) == 0)
6741 swi_cartpol_sp(x, x);
6742 /**********************
6743 * radians to degrees *
6744 **********************/
6745 if ((iflag & SEFLG_RADIANS) == 0 && (iflag & SEFLG_XYZ) == 0) {
6746 for (i = 0; i < 2; i++) {
6747 x[i] *= RADTODEG;
6748 x[i+3] *= RADTODEG;
6749 }
6750 }
6751 for (i = 0; i <= 5; i++)
6752 xx[i] = x[i];
6753 if (!(iflgsave & SEFLG_SPEED)) {
6754 for (i = 3; i <= 5; i++)
6755 xx[i] = 0;
6756 }
6757 /* if no ephemeris has been specified, do not return chosen ephemeris */
6758 if ((iflgsave & SEFLG_EPHMASK) == 0)
6759 iflag = iflag & ~SEFLG_DEFAULTEPH;
6760 iflag = iflag & ~SEFLG_SPEED;
6761 return iflag;
6762 }
6763
6764 /* function searches a star in fixed stars list, i.e. the data loaded from file
6765 * sefstars.txt
6766 */
search_star_in_list(char * sstar,struct fixed_star * stardata,char * serr)6767 static int32 search_star_in_list(char *sstar, struct fixed_star *stardata, char *serr)
6768 {
6769 int i, star_nr = 0, ndata = 0, len;
6770 char *sp;
6771 char searchkey[AS_MAXCH];
6772 AS_BOOL is_bayer = FALSE;
6773 struct fixed_star *stardatap;
6774 struct fixed_star *stardatabegp;
6775 if (*sstar == ',') {
6776 is_bayer = TRUE;
6777 } else if (isdigit((int) *sstar)) {
6778 star_nr = atoi(sstar);
6779 } else {
6780 if ((sp = strchr(sstar, ',')) != NULL) {
6781 swi_strcpy(sstar, sp);
6782 is_bayer = TRUE;
6783 }
6784 }
6785 if (star_nr > 0) {
6786 if (star_nr > swed.n_fixstars_real) {
6787 if (serr != NULL)
6788 sprintf(serr, "error, swe_fixstar(): sequential fixed star number %d is not available", star_nr);
6789 return ERR;
6790 }
6791 *stardata = swed.fixed_stars[star_nr - 1]; // keys start from 1
6792 //printf("seq.number: %s, %s, %s, %f\n", stardata.skey, stardata.starname, stardata.starbayer, stardata.mag);
6793 return OK;
6794 /* traditional name with wildcard '%' at end of string */
6795 } else if (!is_bayer && (sp = strchr(sstar, '%')) != NULL) {
6796 stardatabegp = &(swed.fixed_stars[swed.n_fixstars_real]);
6797 ndata = swed.n_fixstars_named;
6798 if (sp - sstar != strlen(sstar) - 1) {
6799 if (serr != NULL)
6800 sprintf(serr, "error, swe_fixstar(): invalid search string %s", sstar);
6801 return ERR;
6802 }
6803 strcpy(searchkey, sstar);
6804 len = (int) (strlen(sstar) - 1);
6805 searchkey[len] = '\0';
6806 for (i = 0; i < ndata; i++) {
6807 if (strncmp(stardatabegp[i].skey, sstar, len) == 0) {
6808 *stardata = stardatabegp[i];
6809 return OK;
6810 }
6811 }
6812 if (serr != NULL)
6813 sprintf(serr, "error, swe_fixstar(): star search string %s did not match", sstar);
6814 return ERR;
6815 /* traditional name or Bayer/Flamsteed: find it with binary search */
6816 } else {
6817 strcpy(searchkey, sstar);
6818 if (is_bayer) {
6819 //*searchkey = '~';
6820 //stardatabegp = &(swed.fixed_stars[swed.n_fixstars_real + swed.n_fixstars_named]);
6821 //stardatabegp = &(swed.fixed_stars[0]);
6822 stardatabegp = swed.fixed_stars;
6823 ndata = swed.n_fixstars_real;
6824 } else {
6825 stardatabegp = &(swed.fixed_stars[swed.n_fixstars_real]);
6826 ndata = swed.n_fixstars_named;
6827 }
6828 stardatap = (struct fixed_star *) bsearch((void *) searchkey,
6829 (void *) stardatabegp, (size_t) ndata,
6830 sizeof (struct fixed_star),
6831 fstar_node_compare);
6832 if (stardatap == NULL) {
6833 if (serr != NULL)
6834 sprintf(serr, "error, swe_fixstar(): could not find star name %s", sstar);
6835 return ERR;
6836 }
6837 *stardata = *stardatap;
6838 //printf("name search: %s, %s, %s, %f\n", stardata.skey, stardata.starname, stardata.starbayer, stardata.mag);
6839 return OK;
6840 }
6841 }
6842
get_builtin_star(char * star,char * sstar,char * srecord)6843 static AS_BOOL get_builtin_star(char *star, char *sstar, char *srecord)
6844 {
6845 /* some stars are built-in, because they are required for Hindu
6846 * sidereal ephemerides */
6847 /* Ayanamsha SE_SIDM_TRUE_CITRA */
6848 if (strncmp(star, "spica", 5) == 0 || strncmp(star, "Spica", 5) == 0) {
6849 strcpy(srecord, "Spica,alVir,ICRS,13,25,11.57937,-11,09,40.7501,-42.35,-30.67,1,13.06,0.97,-10,3672");
6850 strcpy(sstar, "spica");
6851 return TRUE;
6852 /* Ayanamsha SE_SIDM_TRUE_REVATI */
6853 } else if (strstr(star, ",zePsc") != NULL || strncmp(star, "revati", 6) == 0 || strncmp(star, "Revati", 6) == 0) {
6854 strcpy(srecord, "Revati,zePsc,ICRS,01,13,43.88735,+07,34,31.2745,145,-55.69,15,18.76,5.187,06,174");
6855 strcpy(sstar, "revati");
6856 return TRUE;
6857 /* Ayanamsha SE_SIDM_TRUE_PUSHYA */
6858 } else if (strstr(star, ",deCnc") != NULL || strncmp(star, "pushya", 6) == 0 || strncmp(star, "Pushya", 6) == 0 ) {
6859 strcpy(srecord, "Pushya,deCnc,ICRS,08,44,41.09921,+18,09,15.5034,-17.67,-229.26,17.14,24.98,3.94,18,2027");
6860 strcpy(sstar, "pushya");
6861 return TRUE;
6862 /* Ayanamsha SE_SIDM_TRUE_SHEORAN */
6863 } else if (strstr(star, ",deCnc") != NULL) {
6864 strcpy(srecord, "Pushya,deCnc,ICRS,08,44,41.09921,+18,09,15.5034,-17.67,-229.26,17.14,24.98,3.94,18,2027");
6865 strcpy(sstar, "pushya");
6866 return TRUE;
6867 /* Ayanamsha SE_SIDM_TRUE_MULA */
6868 } else if (strstr(star, ",laSco") != NULL || strncmp(star, "mula", 6) == 0 || strncmp(star, "Mula", 6) == 0) {
6869 strcpy(srecord, "Mula,laSco,ICRS,17,33,36.52012,-37,06,13.7648,-8.53,-30.8,-3,5.71,1.62,-37,11673");
6870 strcpy(sstar, "mula");
6871 return TRUE;
6872 /* Ayanamsha SE_SIDM_GALCENT_0SAG */
6873 /* Ayanamsha SE_SIDM_GALCENT_COCHRANE */
6874 /* Ayanamsha SE_SIDM_GALCENT_RGILBRAND */
6875 } else if (strstr(star, ",SgrA*") != NULL) {
6876 strcpy(srecord, "Gal. Center,SgrA*,2000,17,45,40.03599,-29,00,28.1699,-2.755718425,-5.547,0.0,0.125,999.99,0,0");
6877 strcpy(sstar, ",SgrA*");
6878 return TRUE;
6879 /* Ayanamsha SE_SIDM_GALEQU_IAU1958 */
6880 } else if (strstr(star, ",GP1958") != NULL) {
6881 strcpy(srecord, "Gal. Pole IAU1958,GP1958,1950,12,49,0.0,27,24,0.0,0.0,0.0,0.0,0.0,0.0,0,0");
6882 strcpy(sstar, ",GP1958");
6883 return TRUE;
6884 /* Ayanamsha SE_SIDM_GALEQU_TRUE */
6885 } else if (strstr(star, ",GPol") != NULL) {
6886 strcpy(srecord, "Gal. Pole,GPol,ICRS,12,51,36.7151981,27,06,11.193172,0.0,0.0,0.0,0.0,0.0,0,0");
6887 strcpy(sstar, ",GPol");
6888 return TRUE;
6889 /* Ayanamsha SE_SIDM_GALEQU_MULA */
6890 } else if (strstr(star, ",GPol") != NULL) {
6891 strcpy(srecord, "Gal. Pole,GPol,ICRS,12,51,36.7151981,27,06,11.193172,0.0,0.0,0.0,0.0,0.0,0,0");
6892 strcpy(sstar, ",GPol");
6893 return TRUE;
6894 }
6895 return FALSE;
6896 }
6897
6898 /**********************************************************
6899 * function gets fixstar positions
6900 * parameters:
6901 * star name of star or line number in star file
6902 * (start from 1, don't count comment).
6903 * If no error occurs, the name of the star is returned
6904 * in the format trad_name, nomeclat_name
6905 *
6906 * tjd absolute julian day
6907 * iflag s. swecalc(); speed bit does not function
6908 * x pointer to 6 doubles for returning position coordinates
6909 * serr error return string
6910 **********************************************************/
swe_fixstar2(char * star,double tjd,int32 iflag,double * xx,char * serr)6911 int32 CALL_CONV swe_fixstar2(char *star, double tjd, int32 iflag,
6912 double *xx, char *serr)
6913 {
6914 int i;
6915 AS_BOOL is_builtin_star = FALSE;
6916 char sstar[SWI_STAR_LENGTH + 1];
6917 //static TLS char slast_stardata[AS_MAXCH];
6918 static TLS char slast_starname[AS_MAXCH];
6919 static TLS struct fixed_star last_stardata;
6920 char srecord[AS_MAXCH + 20]; /* 20 byte for SE_STARFILE */
6921 int retc;
6922 struct fixed_star stardata;
6923 if (serr != NULL)
6924 *serr = '\0';
6925 #ifdef TRACE
6926 swi_open_trace(serr);
6927 trace_swe_fixstar(1, star, tjd, iflag, xx, serr);
6928 #endif /* TRACE */
6929 load_all_fixed_stars(serr); // loads stars unless loaded with an earlier call of function
6930 #if 0
6931 for (i = 0; i < swed.n_fixstars_records; i++) {
6932 printf("%s, %s, %s, %f\n", swed.fixed_stars[i].skey, swed.fixed_stars[i].starname, swed.fixed_stars[i].starbayer, swed.fixed_stars[i].mag);
6933 }
6934 exit(0);
6935 #endif
6936 retc = fixstar_format_search_name(star, sstar, serr);
6937 if (retc == ERR)
6938 goto return_err;
6939 /* star elements from last call: */
6940 if (swed.n_fixstars_records > 0 && strcmp(slast_starname, sstar) == 0) {
6941 // strcpy(srecord, slast_stardata);
6942 stardata = last_stardata;
6943 goto found;
6944 }
6945 if (get_builtin_star(star, sstar, srecord)) {
6946 is_builtin_star = TRUE;
6947 }
6948 if (is_builtin_star) {
6949 retc = fixstar_cut_string(srecord, star, &stardata, serr);
6950 //printf("builtin: %s, %s, %s, %f\n", stardata.skey, stardata.starname, stardata.starbayer, stardata.mag);
6951 goto found;
6952 /* sequential fixed star number: get it from array directly */
6953 }
6954 retc = search_star_in_list(sstar, &stardata, serr);
6955 if (retc == ERR)
6956 goto return_err;
6957 /******************************************************/
6958 found:
6959 //strcpy(slast_stardata, srecord);
6960 last_stardata = stardata;
6961 strcpy(slast_starname, sstar);
6962 if ((retc = fixstar_calc_from_struct(&stardata, tjd, iflag, star, xx, serr)) == ERR)
6963 goto return_err;
6964 #ifdef TRACE
6965 trace_swe_fixstar(2, star, tjd, iflag, xx, serr);
6966 #endif
6967 return iflag;
6968 return_err:
6969 for (i = 0; i <= 5; i++)
6970 xx[i] = 0;
6971 #ifdef TRACE
6972 trace_swe_fixstar(2, star, tjd, iflag, xx, serr);
6973 #endif
6974 return retc;
6975 }
6976
swe_fixstar2_ut(char * star,double tjd_ut,int32 iflag,double * xx,char * serr)6977 int32 CALL_CONV swe_fixstar2_ut(char *star, double tjd_ut, int32 iflag,
6978 double *xx, char *serr)
6979 {
6980 double deltat;
6981 int32 retflag;
6982 int32 epheflag = 0;
6983 iflag = plaus_iflag(iflag, -1, tjd_ut, serr);
6984 epheflag = iflag & SEFLG_EPHMASK;
6985 if (epheflag == 0) {
6986 epheflag = SEFLG_SWIEPH;
6987 iflag |= SEFLG_SWIEPH;
6988 }
6989 deltat = swe_deltat_ex(tjd_ut, iflag, serr);
6990 /* if ephe required is not ephe returned, adjust delta t: */
6991 retflag = swe_fixstar2(star, tjd_ut + deltat, iflag, xx, serr);
6992 if (retflag != ERR && (retflag & SEFLG_EPHMASK) != epheflag) {
6993 deltat = swe_deltat_ex(tjd_ut, retflag, NULL);
6994 retflag = swe_fixstar2(star, tjd_ut + deltat, iflag, xx, NULL);
6995 }
6996 return retflag;
6997 }
6998
6999 /**********************************************************
7000 * get fixstar magnitude
7001 * parameters:
7002 * star name of star or line number in star file
7003 * (start from 1, don't count comment).
7004 * If no error occurs, the name of the star is returned
7005 * in the format trad_name, nomeclat_name
7006 *
7007 * mag pointer to a double, for star magnitude
7008 * serr error return string
7009 **********************************************************/
swe_fixstar2_mag(char * star,double * mag,char * serr)7010 int32 CALL_CONV swe_fixstar2_mag(char *star, double *mag, char *serr)
7011 {
7012 char sstar[SWI_STAR_LENGTH + 1];
7013 //static TLS char slast_stardata[AS_MAXCH];
7014 static TLS char slast_starname[AS_MAXCH];
7015 static TLS struct fixed_star last_stardata;
7016 int retc;
7017 struct fixed_star stardata;
7018 if (serr != NULL)
7019 *serr = '\0';
7020 load_all_fixed_stars(serr); // loads stars unless loaded with an earlier call of function
7021 retc = fixstar_format_search_name(star, sstar, serr);
7022 if (retc == ERR)
7023 goto return_err;
7024 /* star elements from last call: */
7025 if (swed.n_fixstars_records > 0 && strcmp(slast_starname, sstar) == 0) {
7026 // strcpy(srecord, slast_stardata);
7027 stardata = last_stardata;
7028 goto found;
7029 }
7030 retc = search_star_in_list(sstar, &stardata, serr);
7031 if (retc == ERR)
7032 goto return_err;
7033 /******************************************************/
7034 found:
7035 last_stardata = stardata;
7036 strcpy(slast_starname, sstar);
7037 *mag = stardata.mag;
7038 sprintf(star, "%s,%s", stardata.starname, stardata.starbayer);
7039 return OK;
7040 return_err:
7041 *mag = 0;
7042 return retc;
7043 }
7044
swe_get_planet_name(int ipl,char * s)7045 char *CALL_CONV swe_get_planet_name(int ipl, char *s)
7046 {
7047 int i;
7048 int32 retc;
7049 double xp[6];
7050 #ifdef TRACE
7051 swi_open_trace(NULL);
7052 trace_swe_get_planet_name(1, ipl, s);
7053 #endif
7054 swi_init_swed_if_start();
7055 /* function calls for Pluto with asteroid number 134340
7056 * are treated as calls for Pluto as main body SE_PLUTO */
7057 if (ipl == SE_AST_OFFSET + 134340)
7058 ipl = SE_PLUTO;
7059 if (ipl != 0 && ipl == swed.i_saved_planet_name) {
7060 strcpy(s, swed.saved_planet_name);
7061 return s;
7062 }
7063 switch(ipl) {
7064 case SE_SUN:
7065 strcpy(s, SE_NAME_SUN);
7066 break;
7067 case SE_MOON:
7068 strcpy(s, SE_NAME_MOON);
7069 break;
7070 case SE_MERCURY:
7071 strcpy(s, SE_NAME_MERCURY);
7072 break;
7073 case SE_VENUS:
7074 strcpy(s, SE_NAME_VENUS);
7075 break;
7076 case SE_MARS:
7077 strcpy(s, SE_NAME_MARS);
7078 break;
7079 case SE_JUPITER:
7080 strcpy(s, SE_NAME_JUPITER);
7081 break;
7082 case SE_SATURN:
7083 strcpy(s, SE_NAME_SATURN);
7084 break;
7085 case SE_URANUS:
7086 strcpy(s, SE_NAME_URANUS);
7087 break;
7088 case SE_NEPTUNE:
7089 strcpy(s, SE_NAME_NEPTUNE);
7090 break;
7091 case SE_PLUTO:
7092 strcpy(s, SE_NAME_PLUTO);
7093 break;
7094 case SE_MEAN_NODE:
7095 strcpy(s, SE_NAME_MEAN_NODE);
7096 break;
7097 case SE_TRUE_NODE:
7098 strcpy(s, SE_NAME_TRUE_NODE);
7099 break;
7100 case SE_MEAN_APOG:
7101 strcpy(s, SE_NAME_MEAN_APOG);
7102 break;
7103 case SE_OSCU_APOG:
7104 strcpy(s, SE_NAME_OSCU_APOG);
7105 break;
7106 case SE_INTP_APOG:
7107 strcpy(s, SE_NAME_INTP_APOG);
7108 break;
7109 case SE_INTP_PERG:
7110 strcpy(s, SE_NAME_INTP_PERG);
7111 break;
7112 case SE_EARTH:
7113 strcpy(s, SE_NAME_EARTH);
7114 break;
7115 case SE_CHIRON:
7116 case SE_AST_OFFSET + MPC_CHIRON:
7117 strcpy(s, SE_NAME_CHIRON);
7118 break;
7119 case SE_PHOLUS:
7120 case SE_AST_OFFSET + MPC_PHOLUS:
7121 strcpy(s, SE_NAME_PHOLUS);
7122 break;
7123 case SE_CERES:
7124 case SE_AST_OFFSET + MPC_CERES:
7125 strcpy(s, SE_NAME_CERES);
7126 break;
7127 case SE_PALLAS:
7128 case SE_AST_OFFSET + MPC_PALLAS:
7129 strcpy(s, SE_NAME_PALLAS);
7130 break;
7131 case SE_JUNO:
7132 case SE_AST_OFFSET + MPC_JUNO:
7133 strcpy(s, SE_NAME_JUNO);
7134 break;
7135 case SE_VESTA:
7136 case SE_AST_OFFSET + MPC_VESTA:
7137 strcpy(s, SE_NAME_VESTA);
7138 break;
7139 default:
7140 /* fictitious planets */
7141 if (ipl >= SE_FICT_OFFSET && ipl <= SE_FICT_MAX) {
7142 swi_get_fict_name(ipl - SE_FICT_OFFSET, s);
7143 break;
7144 }
7145 /* asteroids */
7146 if (ipl > SE_PLMOON_OFFSET || ipl > SE_AST_OFFSET) { // 2nd condition obsolete
7147 /* if name is already available */
7148 if (ipl == swed.fidat[SEI_FILE_ANY_AST].ipl[0]) {
7149 strcpy(s, swed.fidat[SEI_FILE_ANY_AST].astnam);
7150 /* else try to get it from ephemeris file */
7151 } else {
7152 retc = sweph(J2000, ipl, SEI_FILE_ANY_AST, 0, NULL, NO_SAVE, xp, NULL);
7153 if (retc != ERR && retc != NOT_AVAILABLE) {
7154 strcpy(s, swed.fidat[SEI_FILE_ANY_AST].astnam);
7155 } else {
7156 if (ipl > SE_AST_OFFSET)
7157 sprintf(s, "%d: not found (asteroid)", ipl - SE_AST_OFFSET);
7158 else
7159 sprintf(s, "%d: not found (planetary moon)", ipl);
7160 }
7161 }
7162 /* If there is a provisional designation only in ephemeris file,
7163 * we look for a name in seasnam.txt, which can be updated by
7164 * the user.
7165 * Some old ephemeris files return a '?' in the first position.
7166 * There are still a couple of unnamed bodies that got their
7167 * provisional designation before 1925, when the current method
7168 * of provisional designations was introduced. They have an 'A'
7169 * as the first character, e.g. A924 RC.
7170 * The file seasnam.txt may contain comments starting with '#'.
7171 * There must be at least two columns:
7172 * 1. asteroid catalog number
7173 * 2. asteroid name
7174 * The asteroid number may or may not be in brackets
7175 */
7176 if (ipl > SE_AST_OFFSET && (s[0] == '?' || isdigit((int) s[1]))) {
7177 int ipli = (int) (ipl - SE_AST_OFFSET), iplf = 0;
7178 FILE *fp;
7179 char si[AS_MAXCH], *sp, *sp2;
7180 if ((fp = swi_fopen(-1, SE_ASTNAMFILE, swed.ephepath, NULL)) != NULL) {
7181 while(ipli != iplf && (sp = fgets(si, AS_MAXCH, fp)) != NULL) {
7182 while (*sp == ' ' || *sp == '\t'
7183 || *sp == '(' || *sp == '[' || *sp == '{')
7184 sp++;
7185 if (*sp == '#' || *sp == '\r' || *sp == '\n' || *sp == '\0')
7186 continue;
7187 /* catalog number of body of current line */
7188 iplf = atoi(sp);
7189 if (ipli != iplf)
7190 continue;
7191 /* set pointer after catalog number */
7192 sp = strpbrk(sp, " \t");
7193 if (sp == NULL)
7194 continue; /* there is no name */
7195 while (*sp == ' ' || *sp == '\t')
7196 sp++;
7197 sp2 = strpbrk(sp, "#\r\n");
7198 if (sp2 != NULL)
7199 *sp2 = '\0';
7200 if (*sp == '\0')
7201 continue;
7202 swi_right_trim(sp);
7203 strcpy(s, sp);
7204 }
7205 fclose(fp);
7206 }
7207 }
7208 } else {
7209 i = ipl;
7210 sprintf(s, "%d", i);
7211 }
7212 break;
7213 }
7214 #ifdef TRACE
7215 swi_open_trace(NULL);
7216 trace_swe_get_planet_name(2, ipl, s);
7217 #endif
7218 if (strlen(s) < 80) {
7219 swed.i_saved_planet_name = ipl;
7220 strcpy(swed.saved_planet_name, s);
7221 }
7222 return s;
7223 }
7224
swe_get_ayanamsa_name(int32 isidmode)7225 const char *CALL_CONV swe_get_ayanamsa_name(int32 isidmode)
7226 {
7227 isidmode %= SE_SIDBITS;
7228 if (isidmode < SE_NSIDM_PREDEF)
7229 return ayanamsa_name[isidmode];
7230 return NULL;
7231 }
7232
7233 #ifdef TRACE
trace_swe_calc(int swtch,double tjd,int ipl,int32 iflag,double * xx,char * serr)7234 static void trace_swe_calc(int swtch, double tjd, int ipl, int32 iflag, double *xx, char *serr)
7235 {
7236 if (swi_trace_count >= TRACE_COUNT_MAX)
7237 return;
7238 switch(swtch) {
7239 case 1:
7240 if (swi_fp_trace_c != NULL) {
7241 fputs("\n/*SWE_CALC*/\n", swi_fp_trace_c);
7242 fprintf(swi_fp_trace_c, " tjd = %.9f;", tjd);
7243 fprintf(swi_fp_trace_c, " ipl = %d;", ipl);
7244 fprintf(swi_fp_trace_c, " iflag = %d;\n", iflag);
7245 fprintf(swi_fp_trace_c, " iflgret = swe_calc(tjd, ipl, iflag, xx, serr);");
7246 fprintf(swi_fp_trace_c, " /* xx = %p */\n", xx);
7247 fflush(swi_fp_trace_c);
7248 }
7249 break;
7250 case 2:
7251 if (swi_fp_trace_c != NULL) {
7252 fputs(" printf(\"swe_calc: %f\\t%d\\t%d\\t%f\\t%f\\t%f\\t%f\\t%f\\t%f\\t\", ", swi_fp_trace_c);
7253 fputs("\n\ttjd, ipl, iflgret, xx[0], xx[1], xx[2], xx[3], xx[4], xx[5]);\n", swi_fp_trace_c);
7254 fputs(" if (*serr != '\\0')", swi_fp_trace_c);
7255 fputs(" printf(serr);", swi_fp_trace_c);
7256 fputs(" printf(\"\\n\");\n", swi_fp_trace_c);
7257 fflush(swi_fp_trace_c);
7258 }
7259 if (swi_fp_trace_out != NULL) {
7260 fprintf(swi_fp_trace_out, "swe_calc: %f\t%d\t%d\t%f\t%f\t%f\t%f\t%f\t%f\t",
7261 tjd, ipl, iflag, xx[0], xx[1], xx[2], xx[3], xx[4], xx[5]);
7262 if (serr != NULL && *serr != '\0') {
7263 fputs(serr, swi_fp_trace_out);
7264 }
7265 fputs("\n", swi_fp_trace_out);
7266 fflush(swi_fp_trace_out);
7267 }
7268 break;
7269 default:
7270 break;
7271 }
7272 }
7273
trace_swe_fixstar(int swtch,char * star,double tjd,int32 iflag,double * xx,char * serr)7274 static void trace_swe_fixstar(int swtch, char *star, double tjd, int32 iflag, double *xx, char *serr)
7275 {
7276 if (swi_trace_count >= TRACE_COUNT_MAX)
7277 return;
7278 switch(swtch) {
7279 case 1:
7280 if (swi_fp_trace_c != NULL) {
7281 fputs("\n/*SWE_FIXSTAR*/\n", swi_fp_trace_c);
7282 fprintf(swi_fp_trace_c, " strcpy(star, \"%s\");", star);
7283 fprintf(swi_fp_trace_c, " tjd = %.9f;", tjd);
7284 fprintf(swi_fp_trace_c, " iflag = %d;\n", iflag);
7285 fprintf(swi_fp_trace_c, " iflgret = swe_fixstar(star, tjd, iflag, xx, serr);");
7286 fprintf(swi_fp_trace_c, " /* xx = %p */\n", xx);
7287 fflush(swi_fp_trace_c);
7288 }
7289 break;
7290 case 2:
7291 if (swi_fp_trace_c != NULL) {
7292 fputs(" printf(\"swe_fixstar: %s\\t%f\\t%d\\t%f\\t%f\\t%f\\t%f\\t%f\\t%f\\t\", ", swi_fp_trace_c);
7293 fputs("\n\tstar, tjd, iflgret, xx[0], xx[1], xx[2], xx[3], xx[4], xx[5]);\n", swi_fp_trace_c);/**/
7294 fputs(" if (*serr != '\\0')", swi_fp_trace_c);
7295 fputs(" printf(serr);", swi_fp_trace_c);
7296 fputs(" printf(\"\\n\");\n", swi_fp_trace_c);
7297 fflush(swi_fp_trace_c);
7298 }
7299 if (swi_fp_trace_out != NULL) {
7300 fprintf(swi_fp_trace_out, "swe_fixstar: %s\t%f\t%d\t%f\t%f\t%f\t%f\t%f\t%f\t",
7301 star, tjd, iflag, xx[0], xx[1], xx[2], xx[3], xx[4], xx[5]);
7302 if (serr != NULL && *serr != '\0') {
7303 fputs(serr, swi_fp_trace_out);
7304 }
7305 fputs("\n", swi_fp_trace_out);
7306 fflush(swi_fp_trace_out);
7307 }
7308 break;
7309 default:
7310 break;
7311 }
7312 }
7313
trace_swe_get_planet_name(int swtch,int ipl,char * s)7314 static void trace_swe_get_planet_name(int swtch, int ipl, char *s)
7315 {
7316 if (swi_trace_count >= TRACE_COUNT_MAX)
7317 return;
7318 switch(swtch) {
7319 case 1:
7320 if (swi_fp_trace_c != NULL) {
7321 fputs("\n/*SWE_GET_PLANET_NAME*/\n", swi_fp_trace_c);
7322 fprintf(swi_fp_trace_c, " ipl = %d;\n", ipl);
7323 fprintf(swi_fp_trace_c, " swe_get_planet_name(ipl, s);");
7324 fprintf(swi_fp_trace_c, " /* s = %p */\n", s);
7325 fflush(swi_fp_trace_c);
7326 }
7327 break;
7328 case 2:
7329 if (swi_fp_trace_c != NULL) {
7330 fputs(" printf(\"swe_get_planet_name: %d\\t%s\\t\\n\", ", swi_fp_trace_c);
7331 fputs("ipl, s);\n", swi_fp_trace_c);/**/
7332 fflush(swi_fp_trace_c);
7333 }
7334 if (swi_fp_trace_out != NULL) {
7335 fprintf(swi_fp_trace_out, "swe_get_planet_name: %d\t%s\t\n", ipl, s);
7336 fflush(swi_fp_trace_out);
7337 }
7338 break;
7339 default:
7340 break;
7341 }
7342 }
7343
7344 #endif
7345
7346 /* set geographic position and altitude of observer */
swe_set_topo(double geolon,double geolat,double geoalt)7347 void CALL_CONV swe_set_topo(double geolon, double geolat, double geoalt)
7348 {
7349 swi_init_swed_if_start();
7350 if (swed.geopos_is_set == TRUE
7351 && swed.topd.geolon == geolon
7352 && swed.topd.geolat == geolat
7353 && swed.topd.geoalt == geoalt) {
7354 return;
7355 }
7356 swed.topd.geolon = geolon;
7357 swed.topd.geolat = geolat;
7358 swed.topd.geoalt = geoalt;
7359 swed.geopos_is_set = TRUE;
7360 /* to force new calculation of observer position vector */
7361 swed.topd.teval = 0;
7362 /* to force new calculation of light-time etc.
7363 */
7364 swi_force_app_pos_etc();
7365 }
7366
swi_force_app_pos_etc()7367 void swi_force_app_pos_etc()
7368 {
7369 int i;
7370 for (i = 0; i < SEI_NPLANETS; i++)
7371 swed.pldat[i].xflgs = -1;
7372 for (i = 0; i < SEI_NNODE_ETC; i++)
7373 swed.nddat[i].xflgs = -1;
7374 for (i = 0; i <= SE_NPLANETS; i++) { // "=" because save area for asteroids > SE_AST_OFFSET is at i == SE_NPLANETS
7375 swed.savedat[i].tsave = 0;
7376 swed.savedat[i].iflgsave = -1;
7377 }
7378 }
7379
swi_get_observer(double tjd,int32 iflag,AS_BOOL do_save,double * xobs,char * serr)7380 int swi_get_observer(double tjd, int32 iflag,
7381 AS_BOOL do_save, double *xobs, char *serr)
7382 {
7383 int i;
7384 double sidt, delt, tjd_ut, eps, nut, nutlo[2];
7385 double f = EARTH_OBLATENESS;
7386 double re = EARTH_RADIUS;
7387 double cosfi, sinfi, cc, ss, cosl, sinl, h;
7388 if (!swed.geopos_is_set) {
7389 if (serr != NULL)
7390 strcpy(serr, "geographic position has not been set");
7391 return ERR;
7392 }
7393 /* geocentric position of observer depends on sidereal time,
7394 * which depends on UT.
7395 * compute UT from ET. this UT will be slightly different
7396 * from the user's UT, but this difference is extremely small.
7397 */
7398 delt = swe_deltat_ex(tjd, iflag, serr);
7399 tjd_ut = tjd - delt;
7400 if (swed.oec.teps == tjd && swed.nut.tnut == tjd) {
7401 eps = swed.oec.eps;
7402 nutlo[1] = swed.nut.nutlo[1];
7403 nutlo[0] = swed.nut.nutlo[0];
7404 } else {
7405 eps = swi_epsiln(tjd, iflag);
7406 if (!(iflag & SEFLG_NONUT))
7407 swi_nutation(tjd, iflag, nutlo);
7408 }
7409 if (iflag & SEFLG_NONUT) {
7410 nut = 0;
7411 } else {
7412 eps += nutlo[1];
7413 nut = nutlo[0];
7414 }
7415 /* mean or apparent sidereal time, depending on whether or
7416 * not SEFLG_NONUT is set */
7417 sidt = swe_sidtime0(tjd_ut, eps * RADTODEG, nut * RADTODEG);
7418 sidt *= 15; /* in degrees */
7419 /* length of position and speed vectors;
7420 * the height above sea level must be taken into account.
7421 * with the moon, an altitude of 3000 m makes a difference
7422 * of about 2 arc seconds.
7423 * height is referred to the average sea level. however,
7424 * the spheroid (geoid), which is defined by the average
7425 * sea level (or rather by all points of same gravitational
7426 * potential), is of irregular shape and cannot easily
7427 * be taken into account. therefore, we refer height to
7428 * the surface of the ellipsoid. the resulting error
7429 * is below 500 m, i.e. 0.2 - 0.3 arc seconds with the moon.
7430 */
7431 cosfi = cos(swed.topd.geolat * DEGTORAD);
7432 sinfi = sin(swed.topd.geolat * DEGTORAD);
7433 cc= 1 / sqrt(cosfi * cosfi + (1-f) * (1-f) * sinfi * sinfi);
7434 ss= (1-f) * (1-f) * cc;
7435 /* neglect polar motion (displacement of a few meters), as long as
7436 * we use the earth ellipsoid */
7437 /* ... */
7438 /* add sidereal time */
7439 cosl = cos((swed.topd.geolon + sidt) * DEGTORAD);
7440 sinl = sin((swed.topd.geolon + sidt) * DEGTORAD);
7441 h = swed.topd.geoalt;
7442 xobs[0] = (re * cc + h) * cosfi * cosl;
7443 xobs[1] = (re * cc + h) * cosfi * sinl;
7444 xobs[2] = (re * ss + h) * sinfi;
7445 /* polar coordinates */
7446 swi_cartpol(xobs, xobs);
7447 /* speed */
7448 xobs[3] = EARTH_ROT_SPEED;
7449 xobs[4] = xobs[5] = 0;
7450 swi_polcart_sp(xobs, xobs);
7451 /* to AUNIT */
7452 for (i = 0; i <= 5; i++)
7453 xobs[i] /= AUNIT;
7454 /* subtract nutation, set backward flag */
7455 if (!(iflag & SEFLG_NONUT)) {
7456 swi_coortrf2(xobs, xobs, -swed.nut.snut, swed.nut.cnut);
7457 /* speed of xobs is always required, namely for aberration!!! */
7458 /*if (iflag & SEFLG_SPEED)*/
7459 swi_coortrf2(xobs+3, xobs+3, -swed.nut.snut, swed.nut.cnut);
7460 swi_nutate(xobs, iflag | SEFLG_SPEED, TRUE);
7461 }
7462 /* precess to J2000 */
7463 swi_precess(xobs, tjd, iflag, J_TO_J2000);
7464 /*if (iflag & SEFLG_SPEED)*/
7465 swi_precess_speed(xobs, tjd, iflag, J_TO_J2000);
7466 /* neglect frame bias (displacement of 45cm) */
7467 /* ... */
7468 /* save */
7469 if (do_save) {
7470 for (i = 0; i <= 5; i++)
7471 swed.topd.xobs[i] = xobs[i];
7472 swed.topd.teval = tjd;
7473 swed.topd.tjd_ut = tjd_ut; /* -> save area */
7474 }
7475 return OK;
7476 }
7477
7478 /* Equation of Time
7479 *
7480 * The function returns the difference between
7481 * local apparent and local mean time in days.
7482 * E = LAT - LMT
7483 * Input variable tjd is UT.
7484 */
swe_time_equ(double tjd_ut,double * E,char * serr)7485 int32 CALL_CONV swe_time_equ(double tjd_ut, double *E, char *serr)
7486 {
7487 int32 retval;
7488 double t, dt, x[6];
7489 double sidt = swe_sidtime(tjd_ut);
7490 int32 iflag = SEFLG_EQUATORIAL;
7491 iflag = plaus_iflag(iflag, -1, tjd_ut, serr);
7492 if (swi_init_swed_if_start() == 1 && !(iflag & SEFLG_MOSEPH) && serr != NULL) {
7493 strcpy(serr, "Please call swe_set_ephe_path() or swe_set_jplfile() before calling swe_time_equ(), swe_lmt_to_lat() or swe_lat_to_lmt()");
7494 }
7495 if (swed.jpl_file_is_open)
7496 iflag |= SEFLG_JPLEPH;
7497 t = tjd_ut + 0.5;
7498 dt = t - floor(t);
7499 sidt -= dt * 24;
7500 sidt *= 15;
7501 if ((retval = swe_calc_ut(tjd_ut, SE_SUN, iflag, x, serr)) == ERR) {
7502 *E = 0;
7503 return ERR;
7504 }
7505 dt = swe_degnorm(sidt - x[0] - 180);
7506 if (dt > 180)
7507 dt -= 360;
7508 dt *= 4;
7509 *E = dt / 1440.0;
7510 return OK;
7511 }
7512
swe_lmt_to_lat(double tjd_lmt,double geolon,double * tjd_lat,char * serr)7513 int32 CALL_CONV swe_lmt_to_lat(double tjd_lmt, double geolon, double *tjd_lat, char *serr)
7514 {
7515 int32 retval;
7516 double E, tjd_lmt0;
7517 tjd_lmt0 = tjd_lmt - geolon / 360.0;
7518 retval = swe_time_equ(tjd_lmt0, &E, serr);
7519 *tjd_lat = tjd_lmt + E;
7520 return retval;
7521 }
7522
swe_lat_to_lmt(double tjd_lat,double geolon,double * tjd_lmt,char * serr)7523 int32 CALL_CONV swe_lat_to_lmt(double tjd_lat, double geolon, double *tjd_lmt, char *serr)
7524 {
7525 int32 retval;
7526 double E, tjd_lmt0;
7527 tjd_lmt0 = tjd_lat - geolon / 360.0;
7528 retval = swe_time_equ(tjd_lmt0, &E, serr);
7529 /* iteration */
7530 retval = swe_time_equ(tjd_lmt0 - E, &E, serr);
7531 retval = swe_time_equ(tjd_lmt0 - E, &E, serr);
7532 *tjd_lmt = tjd_lat - E;
7533 return retval;
7534 }
7535
open_jpl_file(double * ss,char * fname,char * fpath,char * serr)7536 static int open_jpl_file(double *ss, char *fname, char *fpath, char *serr)
7537 {
7538 int retc;
7539 char serr2[AS_MAXCH];
7540 retc = swi_open_jpl_file(ss, fname, fpath, serr);
7541 /* If we fail with default JPL ephemeris (DE431), we try the second default
7542 * (DE406), but only if serr is not NULL and an warning message can be
7543 * returned. */
7544 if (retc != OK && strstr(fname, SE_FNAME_DFT) != NULL && serr != NULL) {
7545 retc = swi_open_jpl_file(ss, SE_FNAME_DFT2, fpath, serr2);
7546 if (retc == OK) {
7547 strcpy(swed.jplfnam, SE_FNAME_DFT2);
7548 if (serr != NULL) {
7549 strcpy(serr2, "Error with JPL ephemeris file ");
7550 if (strlen(serr2) + strlen(SE_FNAME_DFT) < AS_MAXCH)
7551 strcat(serr2, SE_FNAME_DFT);
7552 if (strlen(serr2) + strlen(serr) + 2 < AS_MAXCH)
7553 sprintf(serr2 + strlen(serr2), ": %s", serr);
7554 if (strlen(serr2) + 17 < AS_MAXCH)
7555 strcat(serr2, ". Defaulting to ");
7556 if (strlen(serr2) + strlen(SE_FNAME_DFT2) < AS_MAXCH)
7557 strcat(serr2, SE_FNAME_DFT2);
7558 strcpy(serr, serr2);
7559 }
7560 }
7561 }
7562 if (retc == OK) {
7563 swed.jpldenum = swi_get_jpl_denum();
7564 swed.jpl_file_is_open = TRUE;
7565 swi_set_tid_acc(0, 0, swed.jpldenum, serr);
7566 }
7567 return retc;
7568 }
7569
7570 #if 1
swi_fixstar_load_record(char * star,char * srecord,char * sname,char * sbayer,double * dparams,char * serr)7571 static int32 swi_fixstar_load_record(char *star, char *srecord, char *sname, char *sbayer, double *dparams, char *serr)
7572 {
7573 char s[AS_MAXCH + 20], *sp, *sp2; /* 20 byte for SE_STARFILE */
7574 char sstar[SWI_STAR_LENGTH + 1];
7575 char fstar[SWI_STAR_LENGTH + 1];
7576 int i, star_nr = 0;
7577 int line = 0;
7578 int fline = 0;
7579 int32 retc = OK;
7580 AS_BOOL is_bayer = FALSE;
7581 size_t cmplen;
7582 size_t slen;
7583 struct fixed_star stardata;
7584 /* function formats the input search name of a star:
7585 * - remove white spaces
7586 * - traditional name to lower case (Bayer designation remains as it is)
7587 */
7588 retc = fixstar_format_search_name(star, sstar, serr);
7589 if (retc == ERR)
7590 return ERR;
7591 // search name is Bayer designation
7592 if (*sstar == ',') {
7593 is_bayer = TRUE;
7594 // search name star number in sefstars.txt
7595 } else if (isdigit((int) *sstar)) {
7596 star_nr = atoi(sstar);
7597 // traditional name: cut off Bayer designation
7598 } else {
7599 if ((sp = strchr(sstar, ',')) != NULL)
7600 *sp = '\0';
7601 }
7602 cmplen = strlen(sstar);
7603 /******************************************************
7604 * Star file
7605 * close to the beginning, a few stars selected by Astrodienst.
7606 * These can be accessed by giving their number instead of a name.
7607 * All other stars can be accessed by name.
7608 * Comment lines start with # and are ignored.
7609 ******************************************************/
7610 if (swed.fixfp == NULL) {
7611 if ((swed.fixfp = swi_fopen(SEI_FILE_FIXSTAR, SE_STARFILE, swed.ephepath, serr)) == NULL) {
7612 swed.is_old_starfile = TRUE;
7613 if ((swed.fixfp = swi_fopen(SEI_FILE_FIXSTAR, SE_STARFILE_OLD, swed.ephepath, NULL)) == NULL) {
7614 swed.is_old_starfile = FALSE;
7615 /* no fixed star file available, error message is already in serr. */
7616 return ERR;
7617 }
7618 }
7619 }
7620 rewind(swed.fixfp);
7621 while (fgets(s, AS_MAXCH, swed.fixfp) != NULL) {
7622 fline++;
7623 // skip comment lines
7624 if (*s == '#') continue;
7625 line++;
7626 // search string is star number in sefstars.txt
7627 if (star_nr == line)
7628 goto found;
7629 else if (star_nr > 0)
7630 continue;
7631 // invalid line without comma
7632 if ((sp = strchr(s, ',')) == NULL) {
7633 if (serr != NULL) {
7634 sprintf(serr, "star file %s damaged at line %d", SE_STARFILE, fline);
7635 }
7636 return ERR;
7637 }
7638 // search string is Bayer or Flamsteed designation
7639 if (is_bayer) {
7640 if (strncmp(sp, sstar, cmplen) == 0)
7641 goto found;
7642 else
7643 continue;
7644 }
7645 // search string is traditional name
7646 *sp = '\0'; /* cut off after first field to get star name, ',' -> '\0' */
7647 //strncpy(fstar, s, SWI_STAR_LENGTH);
7648 slen = swi_strnlen(s, SE_MAX_STNAME);
7649 memcpy(fstar, s, slen);
7650 fstar[slen] = '\0'; /* force termination */
7651 *sp = ','; /* add comma again */
7652 //fstar[SWI_STAR_LENGTH] = '\0'; /* force termination */
7653 // remove white spaces from star name
7654 while ((sp = strchr(fstar, ' ')) != NULL)
7655 swi_strcpy(sp, sp+1);
7656 i = (int) strlen(fstar);
7657 // length of star name differs from length of search string: continue
7658 if (i < (int) cmplen)
7659 continue;
7660 // star name to lowercase and compare with search string
7661 for (sp2 = fstar; *sp2 != '\0'; sp2++) {
7662 *sp2 = tolower((int) *sp2);
7663 }
7664 if (strncmp(fstar, sstar, cmplen) == 0)
7665 goto found;
7666 }
7667 if (serr != NULL) {
7668 sprintf(serr, "star not found");
7669 if (strlen(serr) + strlen(star) < AS_MAXCH) {
7670 sprintf(serr, "star %s not found", star);
7671 }
7672 return ERR;
7673 }
7674 found:
7675 strcpy(srecord, s);
7676 retc = fixstar_cut_string(srecord, star, &stardata, serr);
7677 if (retc == ERR) return ERR;
7678 if (dparams != NULL) {
7679 dparams[0] = stardata.epoch; // epoch
7680 // RA(epoch)
7681 dparams[1] = stardata.ra;
7682 // Decl(epoch)
7683 dparams[2] = stardata.de;
7684 // RA proper motion
7685 dparams[3] = stardata.ramot;
7686 // decl proper motion
7687 dparams[4] = stardata.demot;
7688 // radial velocity
7689 dparams[5] = stardata.radvel;
7690 // parallax
7691 dparams[6] = stardata.parall;
7692 // magnitude V
7693 dparams[7] = stardata.mag;
7694 }
7695 return OK;
7696 }
7697
7698 /* function calculates a fixstar from a record from sefstars.txt
7699 * input:
7700 * char *srecord fixed star data record from sefstars.txt
7701 * double tjd julian daynumber
7702 * int32 iflag SEFLG_ specifications
7703 * output:
7704 * char *star star name, Bayer designation
7705 * double xx[6] position and speed
7706 * char *serr error return string
7707 */
swi_fixstar_calc_from_record(char * srecord,double tjd,int32 iflag,char * star,double * xx,char * serr)7708 static int32 swi_fixstar_calc_from_record(char *srecord, double tjd, int32 iflag, char *star, double *xx, char *serr)
7709 {
7710 int i;
7711 int32 retc = OK;
7712 double epoch, radv, parall;
7713 double ra_pm, de_pm, ra, de, t;
7714 struct fixed_star stardata;
7715 double daya, rdist;
7716 double x[6], xxsv[6], xobs[6], xobs_dt[6], *xpo = NULL, *xpo_dt = NULL;
7717 static TLS double xearth[6], xearth_dt[6], xsun[6], xsun_dt[6];
7718 double dt = PLAN_SPEED_INTV * 0.1;
7719 int32 epheflag, iflgsave;
7720 // char s[AS_MAXCH];
7721 struct epsilon *oe = &swed.oec2000;
7722 iflag |= SEFLG_SPEED; /* we need this in order to work correctly */
7723 iflgsave = iflag;
7724 if (serr != NULL)
7725 *serr = '\0';
7726 iflag = plaus_iflag(iflag, -1, tjd, serr);
7727 epheflag = iflag & SEFLG_EPHMASK;
7728 if (swi_init_swed_if_start() == 1 && !(epheflag & SEFLG_MOSEPH) && serr != NULL) {
7729 strcpy(serr, "Please call swe_set_ephe_path() or swe_set_jplfile() before calling swe_fixstar() or swe_fixstar_ut()");
7730 }
7731 if (swed.last_epheflag != epheflag) {
7732 free_planets();
7733 /* close and free ephemeris files */
7734 if (swed.jpl_file_is_open) {
7735 swi_close_jpl_file();
7736 swed.jpl_file_is_open = FALSE;
7737 }
7738 for (i = 0; i < SEI_NEPHFILES; i ++) {
7739 if (swed.fidat[i].fptr != NULL)
7740 fclose(swed.fidat[i].fptr);
7741 memset((void *) &swed.fidat[i], 0, sizeof(struct file_data));
7742 }
7743 swed.last_epheflag = epheflag;
7744 }
7745 /* high precision speed prevails fast speed */
7746 /* JPL Horizons is only reproduced with SEFLG_JPLEPH */
7747 if (iflag & SEFLG_SIDEREAL && !swed.ayana_is_set)
7748 swe_set_sid_mode(SE_SIDM_FAGAN_BRADLEY, 0, 0);
7749 /******************************************
7750 * obliquity of ecliptic 2000 and of date *
7751 ******************************************/
7752 swi_check_ecliptic(tjd, iflag);
7753 /******************************************
7754 * nutation *
7755 ******************************************/
7756 swi_check_nutation(tjd, iflag);
7757 retc = fixstar_cut_string(srecord, star, &stardata, serr);
7758 if (retc == ERR) return ERR;
7759 epoch = stardata.epoch;
7760 ra_pm = stardata.ramot; de_pm = stardata.demot;
7761 radv = stardata.radvel; parall = stardata.parall;
7762 ra = stardata.ra; de = stardata.de;
7763 if (epoch == 1950)
7764 t= (tjd - B1950); /* days since 1950.0 */
7765 else /* epoch == 2000 */
7766 t= (tjd - J2000); /* days since 2000.0 */
7767 x[0] = ra;
7768 x[1] = de;
7769 x[2] = 1;
7770 if (parall == 0) {
7771 rdist = 1000000000;
7772 } else {
7773 rdist = 1.0 / (parall * RADTODEG * 3600) * PARSEC_TO_AUNIT;
7774 //rdist += t * radv / 36525.0;
7775 }
7776 // rdist = 10000; // to reproduce pre-SE2.07 star positions
7777 x[2] = rdist;
7778 x[3] = ra_pm / 36525.0;
7779 x[4] = de_pm / 36525.0;
7780 x[5] = radv / 36525.0;
7781 // Cartesian space motion vector
7782 swi_polcart_sp(x, x);
7783 /******************************************
7784 * FK5
7785 ******************************************/
7786 if (epoch == 1950) {
7787 swi_FK4_FK5(x, B1950);
7788 swi_precess(x, B1950, 0, J_TO_J2000);
7789 swi_precess(x+3, B1950, 0, J_TO_J2000);
7790 }
7791 /* FK5 to ICRF, if jpl ephemeris is referred to ICRF.
7792 * With data that are already ICRF, epoch = 0 */
7793 if (epoch != 0) {
7794 swi_icrs2fk5(x, iflag, TRUE); /* backward, i. e. to icrf */
7795 /* with ephemerides < DE403, we now convert to J2000 */
7796 if (swi_get_denum(SEI_SUN, iflag) >= 403) {
7797 swi_bias(x, J2000, SEFLG_SPEED, FALSE);
7798 }
7799 }
7800 /****************************************************
7801 * earth/sun
7802 * for parallax, light deflection, and aberration,
7803 ****************************************************/
7804 if (!(iflag & SEFLG_BARYCTR) && (!(iflag & SEFLG_HELCTR) || !(iflag & SEFLG_MOSEPH))) {
7805 if ((retc = main_planet_bary(tjd - dt, SEI_EARTH, epheflag, iflag, NO_SAVE, xearth_dt, xearth_dt, xsun_dt, NULL, serr)) != OK) {
7806 return ERR;
7807 }
7808 if ((retc = main_planet_bary(tjd, SEI_EARTH, epheflag, iflag, DO_SAVE, xearth, xearth, xsun, NULL, serr)) != OK) {
7809 return ERR;
7810 }
7811 }
7812 /************************************
7813 * observer: geocenter or topocenter
7814 ************************************/
7815 /* if topocentric position is wanted */
7816 if (iflag & SEFLG_TOPOCTR) {
7817 if (swi_get_observer(tjd - dt, iflag | SEFLG_NONUT, NO_SAVE, xobs_dt, serr) != OK)
7818 return ERR;
7819 if (swi_get_observer(tjd, iflag | SEFLG_NONUT, NO_SAVE, xobs, serr) != OK)
7820 return ERR;
7821 /* barycentric position of observer */
7822 for (i = 0; i <= 5; i++) {
7823 xobs[i] = xobs[i] + xearth[i];
7824 xobs_dt[i] = xobs_dt[i] + xearth_dt[i];
7825 }
7826 } else if (!(iflag & SEFLG_BARYCTR) && (!(iflag & SEFLG_HELCTR) || !(iflag & SEFLG_MOSEPH))) {
7827 /* barycentric position of geocenter */
7828 for (i = 0; i <= 5; i++) {
7829 xobs[i] = xearth[i];
7830 xobs_dt[i] = xearth_dt[i];
7831 }
7832 }
7833 /************************************
7834 * position and speed at tjd *
7835 ************************************/
7836 /* for parallax */
7837 if ((iflag & SEFLG_HELCTR) && (iflag & SEFLG_MOSEPH)) {
7838 xpo = NULL; /* no parallax, if moshier and heliocentric */
7839 xpo_dt = NULL; /* no parallax, if moshier and heliocentric */
7840 } else if (iflag & SEFLG_HELCTR) {
7841 xpo = xsun;//psdp->x;
7842 xpo_dt = xsun_dt;
7843 } else if (iflag & SEFLG_BARYCTR) {
7844 xpo = NULL; /* no parallax, if barycentric */
7845 xpo_dt = NULL; /* no parallax, if moshier and heliocentric */
7846 } else {
7847 xpo = xobs;
7848 xpo_dt = xobs_dt;
7849 }
7850 if (xpo == NULL) {
7851 for (i = 0; i <= 2; i++) {
7852 x[i] += t * x[i+3];
7853 }
7854 } else {
7855 for (i = 0; i <= 2; i++) {
7856 x[i] += t * x[i+3];
7857 x[i] -= xpo[i];
7858 x[i+3] -= xpo[i+3];
7859 }
7860 // rdist of date
7861 //rdist = sqrt(x[0] * x[0] + x[1] * x[1] + x[2] * x[2]);
7862 // parallax of date
7863 //parall = PARSEC_TO_AUNIT / rdist / RADTODEG / 3600.0;
7864 }
7865 /************************************
7866 * relativistic deflection of light *
7867 ************************************/
7868 if ((iflag & SEFLG_TRUEPOS) == 0 && (iflag & SEFLG_NOGDEFL) == 0) {
7869 swi_deflect_light(x, 0, iflag & SEFLG_SPEED);
7870 }
7871 /**********************************
7872 * 'annual' aberration of light *
7873 * speed is incorrect !!! *
7874 **********************************/
7875 if ((iflag & SEFLG_TRUEPOS) == 0 && (iflag & SEFLG_NOABERR) == 0)
7876 swi_aberr_light_ex(x, xpo, xpo_dt, dt, iflag & SEFLG_SPEED);
7877 /* ICRS to J2000 */
7878 if (!(iflag & SEFLG_ICRS) && (swi_get_denum(SEI_SUN, iflag) >= 403 || (iflag & SEFLG_BARYCTR))) {
7879 swi_bias(x, tjd, iflag, FALSE);
7880 }/**/
7881 /* save J2000 coordinates; required for sidereal positions */
7882 for (i = 0; i <= 5; i++)
7883 xxsv[i] = x[i];
7884 /************************************************
7885 * precession, equator 2000 -> equator of date *
7886 ************************************************/
7887 /*x[0] = -0.374018403; x[1] = -0.312548592; x[2] = -0.873168719;*/
7888 if ((iflag & SEFLG_J2000) == 0) {
7889 swi_precess(x, tjd, iflag, J2000_TO_J);
7890 if (iflag & SEFLG_SPEED) {
7891 swi_precess_speed(x, tjd, iflag, J2000_TO_J);
7892 }
7893 oe = &swed.oec;
7894 } else {
7895 oe = &swed.oec2000;
7896 }
7897 /************************************************
7898 * nutation *
7899 ************************************************/
7900 if (!(iflag & SEFLG_NONUT))
7901 swi_nutate(x, iflag, FALSE);
7902 if ((0)) {
7903 double r = sqrt(x[0] * x[0] + x[1] * x[1] + x[2] * x[2]);
7904 printf("%.17f %.17f %f\n", x[0]/r, x[1]/r, x[2]/r);
7905 }
7906 /************************************************
7907 * transformation to ecliptic. *
7908 * with sidereal calc. this will be overwritten *
7909 * afterwards. *
7910 ************************************************/
7911 if ((iflag & SEFLG_EQUATORIAL) == 0) {
7912 swi_coortrf2(x, x, oe->seps, oe->ceps);
7913 if (iflag & SEFLG_SPEED)
7914 swi_coortrf2(x+3, x+3, oe->seps, oe->ceps);
7915 if (!(iflag & SEFLG_NONUT)) {
7916 swi_coortrf2(x, x, swed.nut.snut, swed.nut.cnut);
7917 if (iflag & SEFLG_SPEED)
7918 swi_coortrf2(x+3, x+3, swed.nut.snut, swed.nut.cnut);
7919 }
7920 }
7921 /************************************
7922 * sidereal positions *
7923 ************************************/
7924 if (iflag & SEFLG_SIDEREAL) {
7925 /* rigorous algorithm */
7926 if (swed.sidd.sid_mode & SE_SIDBIT_ECL_T0) {
7927 if (swi_trop_ra2sid_lon(xxsv, x, xxsv, iflag) != OK)
7928 return ERR;
7929 if (iflag & SEFLG_EQUATORIAL) {
7930 for (i = 0; i <= 5; i++)
7931 x[i] = xxsv[i];
7932 }
7933 /* project onto solar system equator */
7934 } else if (swed.sidd.sid_mode & SE_SIDBIT_SSY_PLANE) {
7935 if (swi_trop_ra2sid_lon_sosy(xxsv, x, iflag) != OK)
7936 return ERR;
7937 if (iflag & SEFLG_EQUATORIAL) {
7938 for (i = 0; i <= 5; i++)
7939 x[i] = xxsv[i];
7940 }
7941 /* traditional algorithm */
7942 } else {
7943 swi_cartpol_sp(x, x);
7944 if (swi_get_ayanamsa_ex(tjd, iflag, &daya, serr) == ERR)
7945 return ERR;
7946 x[0] -= daya * DEGTORAD;
7947 swi_polcart_sp(x, x);
7948 }
7949 }
7950 /************************************************
7951 * transformation to polar coordinates *
7952 ************************************************/
7953 if ((iflag & SEFLG_XYZ) == 0)
7954 swi_cartpol_sp(x, x);
7955 /**********************
7956 * radians to degrees *
7957 **********************/
7958 if ((iflag & SEFLG_RADIANS) == 0 && (iflag & SEFLG_XYZ) == 0) {
7959 for (i = 0; i < 2; i++) {
7960 x[i] *= RADTODEG;
7961 x[i+3] *= RADTODEG;
7962 }
7963 }
7964 for (i = 0; i <= 5; i++)
7965 xx[i] = x[i];
7966 if (!(iflgsave & SEFLG_SPEED)) {
7967 for (i = 3; i <= 5; i++)
7968 xx[i] = 0;
7969 }
7970 /* if no ephemeris has been specified, do not return chosen ephemeris */
7971 if ((iflgsave & SEFLG_EPHMASK) == 0)
7972 iflag = iflag & ~SEFLG_DEFAULTEPH;
7973 iflag = iflag & ~SEFLG_SPEED;
7974 return iflag;
7975 }
7976
7977 /**********************************************************
7978 * get fixstar positions
7979 * parameters:
7980 * star name of star or line number in star file
7981 * (start from 1, don't count comment).
7982 * If no error occurs, the name of the star is returned
7983 * in the format trad_name, nomeclat_name
7984 *
7985 * tjd absolute julian day
7986 * iflag s. swecalc(); speed bit does not function
7987 * x pointer for returning the ecliptic coordinates
7988 * serr error return string
7989 **********************************************************/
swe_fixstar(char * star,double tjd,int32 iflag,double * xx,char * serr)7990 int32 CALL_CONV swe_fixstar(char *star, double tjd, int32 iflag,
7991 double *xx, char *serr)
7992 {
7993 int i;
7994 char sstar[SWI_STAR_LENGTH + 1];
7995 static TLS char slast_stardata[AS_MAXCH];
7996 static TLS char slast_starname[AS_MAXCH];
7997 char srecord[AS_MAXCH + 20], *sp; /* 20 byte for SE_STARFILE */
7998 int retc;
7999 if (serr != NULL)
8000 *serr = '\0';
8001 #ifdef TRACE
8002 swi_open_trace(serr);
8003 trace_swe_fixstar(1, star, tjd, iflag, xx, serr);
8004 #endif /* TRACE */
8005 retc = fixstar_format_search_name(star, sstar, serr);
8006 if (retc == ERR)
8007 goto return_err;
8008 if (*sstar == ',') {
8009 ; // is Bayer designation
8010 } else if (isdigit((int) *sstar)) {
8011 ; // is a sequential star number
8012 } else {
8013 if ((sp = strchr(sstar, ',')) != NULL) // cut off Bayer, if trad. name
8014 *sp = '\0';
8015 }
8016 /* star elements from last call: */
8017 if (*slast_stardata != '\0' && strcmp(slast_starname, sstar) == 0) {
8018 strcpy(srecord, slast_stardata);
8019 goto found;
8020 }
8021 if (get_builtin_star(star, sstar, srecord)) {
8022 goto found;
8023 }
8024 /******************************************************
8025 * Star file
8026 * close to the beginning, a few stars selected by Astrodienst.
8027 * These can be accessed by giving their number instead of a name.
8028 * All other stars can be accessed by name.
8029 * Comment lines start with # and are ignored.
8030 ******************************************************/
8031 if ((retc = swi_fixstar_load_record(star, srecord, NULL, NULL, NULL, serr)) != OK)
8032 goto return_err;
8033 found:
8034 strcpy(slast_stardata, srecord);
8035 strcpy(slast_starname, sstar);
8036 if ((retc = swi_fixstar_calc_from_record(srecord, tjd, iflag, star, xx, serr)) == ERR)
8037 goto return_err;
8038 #ifdef TRACE
8039 trace_swe_fixstar(2, star, tjd, iflag, xx, serr);
8040 #endif
8041 return iflag;
8042 return_err:
8043 for (i = 0; i <= 5; i++)
8044 xx[i] = 0;
8045 #ifdef TRACE
8046 trace_swe_fixstar(2, star, tjd, iflag, xx, serr);
8047 #endif
8048 return retc;
8049 }
8050
swe_fixstar_ut(char * star,double tjd_ut,int32 iflag,double * xx,char * serr)8051 int32 CALL_CONV swe_fixstar_ut(char *star, double tjd_ut, int32 iflag,
8052 double *xx, char *serr)
8053 {
8054 double deltat;
8055 int32 retflag;
8056 int32 epheflag = 0;
8057 iflag = plaus_iflag(iflag, -1, tjd_ut, serr);
8058 epheflag = iflag & SEFLG_EPHMASK;
8059 if (epheflag == 0) {
8060 epheflag = SEFLG_SWIEPH;
8061 iflag |= SEFLG_SWIEPH;
8062 }
8063 deltat = swe_deltat_ex(tjd_ut, iflag, serr);
8064 /* if ephe required is not ephe returned, adjust delta t: */
8065 retflag = swe_fixstar(star, tjd_ut + deltat, iflag, xx, serr);
8066 if (retflag != ERR && (retflag & SEFLG_EPHMASK) != epheflag) {
8067 deltat = swe_deltat_ex(tjd_ut, retflag, NULL);
8068 retflag = swe_fixstar(star, tjd_ut + deltat, iflag, xx, NULL);
8069 }
8070 return retflag;
8071 }
8072
8073 /**********************************************************
8074 * get fixstar magnitude
8075 * parameters:
8076 * star name of star or line number in star file
8077 * (start from 1, don't count comment).
8078 * If no error occurs, the name of the star is returned
8079 * in the format trad_name, nomeclat_name
8080 *
8081 * mag pointer to a double, for star magnitude
8082 * serr error return string
8083 **********************************************************/
swe_fixstar_mag(char * star,double * mag,char * serr)8084 int32 CALL_CONV swe_fixstar_mag(char *star, double *mag, char *serr)
8085 {
8086 char sstar[SWI_STAR_LENGTH + 1];
8087 static TLS char slast_stardata[AS_MAXCH];
8088 static TLS char slast_starname[AS_MAXCH];
8089 char srecord[AS_MAXCH + 20], *sp; /* 20 byte for SE_STARFILE */
8090 struct fixed_star stardata;
8091 int retc;
8092 double dparams[20];
8093 if (serr != NULL)
8094 *serr = '\0';
8095 retc = fixstar_format_search_name(star, sstar, serr);
8096 if (retc == ERR)
8097 goto return_err;
8098 if (*sstar == ',') {
8099 ; // is Bayer designation
8100 } else if (isdigit((int) *sstar)) {
8101 ; // is a sequential star number
8102 } else {
8103 if ((sp = strchr(sstar, ',')) != NULL) // cut off Bayer, if trad. name
8104 *sp = '\0';
8105 }
8106 /* star elements from last call: */
8107 if (*slast_stardata != '\0' && strcmp(slast_starname, sstar) == 0) {
8108 strcpy(srecord, slast_stardata);
8109 retc = fixstar_cut_string(srecord, star, &stardata, serr);
8110 if (retc == ERR) goto return_err;
8111 // magnitude V
8112 dparams[7] = stardata.mag;
8113 goto found;
8114 }
8115 /******************************************************
8116 * Star file
8117 * close to the beginning, a few stars selected by Astrodienst.
8118 * These can be accessed by giving their number instead of a name.
8119 * All other stars can be accessed by name.
8120 * Comment lines start with # and are ignored.
8121 ******************************************************/
8122 if ((retc = swi_fixstar_load_record(star, srecord, NULL, NULL, dparams, serr)) != OK)
8123 goto return_err;
8124 found:
8125 strcpy(slast_stardata, srecord);
8126 strcpy(slast_starname, sstar);
8127 *mag = dparams[7];
8128 return OK;
8129 return_err:
8130 *mag = 0;
8131 return retc;
8132 }
8133
8134 #endif
8135
swe_calc_pctr(double tjd,int32 ipl,int32 iplctr,int32 iflag,double * xxret,char * serr)8136 int32 CALL_CONV swe_calc_pctr(double tjd, int32 ipl, int32 iplctr, int32 iflag, double *xxret, char *serr)
8137 {
8138 double t = 0, dt, daya[2], dtsave_for_defl = 0;
8139 double xx[6], xxctr[6], xxctr2[6], xx0[6], xxsv[24], xxsp[6], dx[6], xreturn[24];
8140 double *xs;
8141 int i, j, niter;
8142 int32 iflag2, epheflag, retc;
8143 struct epsilon *oe;
8144 if (ipl == iplctr) {
8145 if (serr != NULL)
8146 sprintf(serr, "ipl and iplctr (= %d) must not be identical\n", ipl);
8147 return ERR;
8148 }
8149 iflag = plaus_iflag(iflag, ipl, tjd, serr);
8150 epheflag = iflag & SEFLG_EPHMASK;
8151 // this fills in obliquity and nutation values in swed
8152 swe_calc(tjd + swe_deltat_ex(tjd, epheflag, serr), SE_ECL_NUT, iflag, xx, serr);
8153 iflag &= ~(SEFLG_HELCTR|SEFLG_BARYCTR);
8154 iflag2 = epheflag;
8155 iflag2 |= (SEFLG_BARYCTR|SEFLG_J2000|SEFLG_ICRS|SEFLG_TRUEPOS|SEFLG_EQUATORIAL|SEFLG_XYZ|SEFLG_SPEED);
8156 iflag2 |= (SEFLG_NOABERR|SEFLG_NOGDEFL);
8157 retc = swe_calc(tjd, iplctr, iflag2, xxctr, serr);
8158 if (retc == ERR)
8159 return ERR;
8160 retc = swe_calc(tjd, ipl, iflag2, xx, serr);
8161 if (retc == ERR)
8162 return ERR;
8163 for (i = 0; i <= 5; i++) {
8164 xx0[i] = xx[i];
8165 //xx[i] -= xxctr[i];
8166 }
8167 /*******************************
8168 * light-time geocentric *
8169 *******************************/
8170 if (!(iflag & SEFLG_TRUEPOS)) {
8171 /* number of iterations - 1 */
8172 niter = 1;
8173 if (iflag & SEFLG_SPEED) {
8174 /*
8175 * Apparent speed is influenced by the fact that dt changes with
8176 * time. This makes a difference of several hundredths of an
8177 * arc second / day. To take this into account, we compute
8178 * 1. true position - apparent position at time t - 1.
8179 * 2. true position - apparent position at time t.
8180 * 3. the difference between the two is the part of the daily motion
8181 * that results from the change of dt.
8182 */
8183 for (i = 0; i <= 2; i++)
8184 xxsv[i] = xxsp[i] = xx[i] - xx[i+3];
8185 for (j = 0; j <= niter; j++) {
8186 for (i = 0; i <= 2; i++) {
8187 dx[i] = xxsp[i];
8188 dx[i] -= (xxctr[i] - xxctr[i+3]);
8189 }
8190 /* new dt */
8191 dt = sqrt(square_sum(dx)) * AUNIT / CLIGHT / 86400.0;
8192 for (i = 0; i <= 2; i++) /* rough apparent position at t-1 */
8193 xxsp[i] = xxsv[i] - dt * xx0[i+3];
8194 }
8195 /* true position - apparent position at time t-1 */
8196 for (i = 0; i <= 2; i++)
8197 xxsp[i] = xxsv[i] - xxsp[i];
8198 }
8199 /* dt and t(apparent) */
8200 for (j = 0; j <= niter; j++) {
8201 for (i = 0; i <= 2; i++) {
8202 dx[i] = xx[i];
8203 dx[i] -= xxctr[i];
8204 }
8205 dt = sqrt(square_sum(dx)) * AUNIT / CLIGHT / 86400.0;
8206 /* new t */
8207 t = tjd - dt;
8208 dtsave_for_defl = dt;
8209 for (i = 0; i <= 2; i++) /* rough apparent position at t*/
8210 xx[i] = xx0[i] - dt * xx0[i+3];
8211 }
8212 /* part of daily motion resulting from change of dt */
8213 if (iflag & SEFLG_SPEED) {
8214 for (i = 0; i <= 2; i++)
8215 xxsp[i] = xx0[i] - xx[i] - xxsp[i];
8216 }
8217 retc = swe_calc(t, iplctr, iflag2, xxctr2, serr);
8218 retc = swe_calc(t, ipl, iflag2, xx, serr);
8219 }
8220 /*******************************
8221 * conversion to planetocenter *
8222 *******************************/
8223 if (!(iflag & SEFLG_HELCTR) && !(iflag & SEFLG_BARYCTR)) {
8224 /* subtract earth */
8225 for (i = 0; i <= 5; i++)
8226 xx[i] -= xxctr[i];
8227 if ((iflag & SEFLG_TRUEPOS) == 0 ) {
8228 /*
8229 * Apparent speed is also influenced by
8230 * the change of dt during motion.
8231 * Neglect of this would result in an error of several 0.01"
8232 */
8233 if (iflag & SEFLG_SPEED)
8234 for (i = 3; i <= 5; i++)
8235 xx[i] -= xxsp[i-3];
8236 }
8237 }
8238 if (!(iflag & SEFLG_SPEED))
8239 for (i = 3; i <= 5; i++)
8240 xx[i] = 0;
8241 /************************************
8242 * relativistic deflection of light *
8243 ************************************/
8244 if (!(iflag & SEFLG_TRUEPOS) && !(iflag & SEFLG_NOGDEFL))
8245 /* SEFLG_NOGDEFL is on, if SEFLG_HELCTR or SEFLG_BARYCTR */
8246 swi_deflect_light(xx, dtsave_for_defl, iflag);
8247 /**********************************
8248 * 'annual' aberration of light *
8249 **********************************/
8250 if (!(iflag & SEFLG_TRUEPOS) && !(iflag & SEFLG_NOABERR)) {
8251 /* SEFLG_NOABERR is on, if SEFLG_HELCTR or SEFLG_BARYCTR */
8252 swi_aberr_light(xx, xxctr, iflag);
8253 /*
8254 * Apparent speed is also influenced by
8255 * the difference of speed of the earth between t and t-dt.
8256 * Neglecting this would involve an error of several 0.1"
8257 */
8258 if (iflag & SEFLG_SPEED) {
8259 for (i = 3; i <= 5; i++)
8260 xx[i] += xxctr[i] - xxctr2[i];
8261 }
8262 }
8263 if (!(iflag & SEFLG_SPEED))
8264 for (i = 3; i <= 5; i++)
8265 xx[i] = 0;
8266 /* ICRS to J2000 */
8267 if (!(iflag & SEFLG_ICRS) && swi_get_denum(ipl, epheflag) >= 403) {
8268 swi_bias(xx, t, iflag, FALSE);
8269 }/**/
8270 /* save J2000 coordinates; required for sidereal positions */
8271 for (i = 0; i <= 5; i++)
8272 xxsv[i] = xx[i];
8273 /************************************************
8274 * precession, equator 2000 -> equator of date *
8275 ************************************************/
8276 if (!(iflag & SEFLG_J2000)) {
8277 swi_precess(xx, tjd, iflag, J2000_TO_J);
8278 if (iflag & SEFLG_SPEED)
8279 swi_precess_speed(xx, tjd, iflag, J2000_TO_J);
8280 oe = &swed.oec;
8281 } else {
8282 oe = &swed.oec2000;
8283 }
8284 /************************************************
8285 * nutation *
8286 ************************************************/
8287 if (!(iflag & SEFLG_NONUT))
8288 swi_nutate(xx, iflag, FALSE);
8289 /* now we have equatorial cartesian coordinates; save them */
8290 for (i = 0; i <= 5; i++)
8291 xreturn[18+i] = xx[i];
8292 /************************************************
8293 * transformation to ecliptic. *
8294 * with sidereal calc. this will be overwritten *
8295 * afterwards. *
8296 ************************************************/
8297 swi_coortrf2(xx, xx, oe->seps, oe->ceps);
8298 if (iflag & SEFLG_SPEED)
8299 swi_coortrf2(xx+3, xx+3, oe->seps, oe->ceps);
8300 if (!(iflag & SEFLG_NONUT)) {
8301 swi_coortrf2(xx, xx, swed.nut.snut, swed.nut.cnut);
8302 if (iflag & SEFLG_SPEED)
8303 swi_coortrf2(xx+3, xx+3, swed.nut.snut, swed.nut.cnut);
8304 }
8305 /* now we have ecliptic cartesian coordinates */
8306 for (i = 0; i <= 5; i++)
8307 xreturn[6+i] = xx[i];
8308 /************************************
8309 * sidereal positions *
8310 ************************************/
8311 if (iflag & SEFLG_SIDEREAL) {
8312 /* project onto ecliptic t0 */
8313 if (swed.sidd.sid_mode & SE_SIDBIT_ECL_T0) {
8314 if (swi_trop_ra2sid_lon(xxsv, xreturn+6, xreturn+18, iflag) != OK)
8315 return ERR;
8316 /* project onto solar system equator */
8317 } else if (swed.sidd.sid_mode & SE_SIDBIT_SSY_PLANE) {
8318 if (swi_trop_ra2sid_lon_sosy(xxsv, xreturn+6, iflag) != OK)
8319 return ERR;
8320 } else {
8321 /* traditional algorithm */
8322 swi_cartpol_sp(xreturn+6, xreturn);
8323 /* note, swi_get_ayanamsa_ex() disturbs present calculations, if sun is calculated with
8324 * TRUE_CHITRA ayanamsha, because the ayanamsha also calculates the sun.
8325 * Therefore current values are saved... */
8326 for (i = 0; i < 24; i++)
8327 xxsv[i] = xreturn[i];
8328 if (swi_get_ayanamsa_with_speed(tjd, iflag, daya, serr) == ERR)
8329 return ERR;
8330 /* ... and restored */
8331 for (i = 0; i < 24; i++)
8332 xreturn[i] = xxsv[i];
8333 xreturn[0] -= daya[0] * DEGTORAD;
8334 xreturn[3] -= daya[1] * DEGTORAD;
8335 swi_polcart_sp(xreturn, xreturn+6);
8336 }
8337 }
8338 /************************************************
8339 * transformation to polar coordinates *
8340 ************************************************/
8341 swi_cartpol_sp(xreturn+18, xreturn+12);
8342 swi_cartpol_sp(xreturn+6, xreturn);
8343 /**********************
8344 * radians to degrees *
8345 **********************/
8346 for (i = 0; i < 2; i++) {
8347 xreturn[i] *= RADTODEG; /* ecliptic */
8348 xreturn[i+3] *= RADTODEG;
8349 xreturn[i+12] *= RADTODEG; /* equator */
8350 xreturn[i+15] *= RADTODEG;
8351 }
8352 // return values
8353 if (iflag & SEFLG_EQUATORIAL) {
8354 xs = xreturn+12; /* equatorial coordinates */
8355 } else {
8356 xs = xreturn; /* ecliptic coordinates */
8357 }
8358 if (iflag & SEFLG_XYZ)
8359 xs = xs+6; /* cartesian coordinates */
8360 for (i = 0; i < 6; i++)
8361 xxret[i] = xs[i];
8362 if (!(iflag & SEFLG_SPEED)) {
8363 for (i = 3; i < 6; i++)
8364 xxret[i] = 0;
8365 }
8366 if (iflag & SEFLG_RADIANS) {
8367 for (i = 0; i < 2; i++)
8368 xxret[i] *= DEGTORAD;
8369 if (iflag & SEFLG_SPEED) {
8370 for (i = 3; i < 5; i++)
8371 xxret[i] *= DEGTORAD;
8372 }
8373 }
8374 if (retc == ERR)
8375 return ERR;
8376 return(iflag);
8377 }
8378
8379 // returns data from internal file structures sweph.fidat
8380 // used in last call to swe_calc() or swe_fixstar()
8381 // ifno = 0 planet file sepl_xxx, used for Sun .. Pluto, or jpl file
8382 // ifno = 1 moon file semo_xxx
8383 // ifno = 2 main asteroid file seas_xxx if such an object was computed
8384 // ifno = 3 other asteroid or planetary moon file, if such object was computed
8385 // ifno = 4 star file
8386 // Return value: full file pathname, or NULL if no data
8387 // tfstart = start date of file,
8388 // tfend = end data of fila,
8389 // denum = jpl ephemeris number 406 or 431 from which file was derived
8390 // all three return values are zero for a jpl file or a star file.
swe_get_current_file_data(int ifno,double * tfstart,double * tfend,int * denum)8391 const char *CALL_CONV swe_get_current_file_data(int ifno, double *tfstart, double *tfend, int *denum)
8392 {
8393 if (ifno < 0 || ifno > 4) return NULL;
8394 struct file_data *pfp = &swed.fidat[ifno];
8395 if (strlen(pfp->fnam) == 0) return NULL;
8396 *tfstart = pfp->tfstart;
8397 *tfend = pfp->tfend;
8398 *denum = pfp->sweph_denum;
8399 return pfp->fnam;
8400 }
8401
8402