void print_fp (FILE *fout, mpfr_t f, const char *suffix) { if (mpfr_inf_p (f)) mpfr_fprintf (fout, "\t%sINF%s", mpfr_signbit (f) ? "-" : "", suffix); else mpfr_fprintf (fout, "\t%Ra%s", f, suffix); }
static void round_str (FILE *fout, const char *s, int prec, int emin, int emax, bool ibm_ld) { mpfr_t f; mpfr_set_default_prec (prec); mpfr_set_emin (emin); mpfr_set_emax (emax); mpfr_init (f); int r = string_to_fp (f, s, MPFR_RNDD); if (ibm_ld) { assert (prec == 106 && emin == -1073 && emax == 1024); /* The maximum value in IBM long double has discontiguous mantissa bits. */ mpfr_t max_value; mpfr_init2 (max_value, 107); mpfr_set_str (max_value, "0x1.fffffffffffff7ffffffffffffcp+1023", 0, MPFR_RNDN); if (mpfr_cmpabs (f, max_value) > 0) r = 1; mpfr_clear (max_value); } mpfr_fprintf (fout, "\t%s,\n", r ? "false" : "true"); print_fp (fout, f, ",\n"); string_to_fp (f, s, MPFR_RNDN); print_fp (fout, f, ",\n"); string_to_fp (f, s, MPFR_RNDZ); print_fp (fout, f, ",\n"); string_to_fp (f, s, MPFR_RNDU); print_fp (fout, f, ""); mpfr_clear (f); }
static void check (FILE *fout, char *fmt, mpfr_t x) { if (mpfr_fprintf (fout, fmt, x) == -1) { mpfr_printf ("Error in mpfr_fprintf(fout, \"%s\", %Re)\n", fmt, x); exit (1); } fputc ('\n', fout); }
static void round_for_all (FILE *fout, const char *s) { static const struct fmt { int prec; int emin; int emax; bool ibm_ld; } formats[] = { { 24, -148, 128, false }, { 53, -1073, 1024, false }, /* This is the Intel extended float format. */ { 64, -16444, 16384, false }, /* This is the Motorola extended float format. */ { 64, -16445, 16384, false }, { 106, -1073, 1024, true }, { 113, -16493, 16384, false }, }; mpfr_fprintf (fout, " TEST (\""); const char *p; for (p = s; *p; p++) { fputc (*p, fout); if ((p - s) % 60 == 59 && p[1]) mpfr_fprintf (fout, "\"\n\t\""); } mpfr_fprintf (fout, "\",\n"); int i; int n_formats = sizeof (formats) / sizeof (formats[0]); for (i = 0; i < n_formats; i++) { round_str (fout, s, formats[i].prec, formats[i].emin, formats[i].emax, formats[i].ibm_ld); if (i < n_formats - 1) mpfr_fprintf (fout, ",\n"); } mpfr_fprintf (fout, "),\n"); }
void arf_fprintd(FILE * file, const arf_t x, slong d) { if (arf_is_finite(x) && (ARF_EXP(x) <= MPFR_EMIN_MIN + 1 || ARF_EXP(x) >= MPFR_EMAX_MAX - 1)) { arf_fprint(file, x); } else { mpfr_t t; mpfr_init2(t, d * 3.33 + 10); mpfr_set_emin(MPFR_EMIN_MIN); mpfr_set_emax(MPFR_EMAX_MAX); arf_get_mpfr(t, x, MPFR_RNDN); mpfr_fprintf(file, "%.*Rg", FLINT_MAX(d, 1), t); mpfr_clear(t); } }
void generate_2D_sample (FILE *output, struct speed_params2D param) { mpfr_t temp; double incr_prec; mpfr_t incr_x; mpfr_t x, x2; double prec; struct speed_params s; int i; int test; int nb_functions; double *t; /* store the timing of each implementation */ /* We first determine how many implementations we have */ nb_functions = 0; while (param.speed_funcs[nb_functions] != NULL) nb_functions++; t = malloc (nb_functions * sizeof (double)); if (t == NULL) { fprintf (stderr, "Can't allocate memory.\n"); abort (); } mpfr_init2 (temp, MPFR_SMALL_PRECISION); /* The precision is sampled from min_prec to max_prec with */ /* approximately nb_points_prec points. If logarithmic_scale_prec */ /* is true, the precision is multiplied by incr_prec at each */ /* step. Otherwise, incr_prec is added at each step. */ if (param.logarithmic_scale_prec) { mpfr_set_ui (temp, (unsigned long int)param.max_prec, MPFR_RNDU); mpfr_div_ui (temp, temp, (unsigned long int)param.min_prec, MPFR_RNDU); mpfr_root (temp, temp, (unsigned long int)param.nb_points_prec, MPFR_RNDU); incr_prec = mpfr_get_d (temp, MPFR_RNDU); } else { incr_prec = (double)param.max_prec - (double)param.min_prec; incr_prec = incr_prec/((double)param.nb_points_prec); } /* The points x are sampled according to the following rule: */ /* If logarithmic_scale_x = 0: */ /* nb_points_x points are equally distributed between min_x and max_x */ /* If logarithmic_scale_x = 1: */ /* nb_points_x points are sampled from 2^(min_x) to 2^(max_x). At */ /* each step, the current point is multiplied by incr_x. */ /* If logarithmic_scale_x = -1: */ /* nb_points_x/2 points are sampled from -2^(max_x) to -2^(min_x) */ /* (at each step, the current point is divided by incr_x); and */ /* nb_points_x/2 points are sampled from 2^(min_x) to 2^(max_x) */ /* (at each step, the current point is multiplied by incr_x). */ mpfr_init2 (incr_x, param.max_prec); if (param.logarithmic_scale_x == 0) { mpfr_set_d (incr_x, (param.max_x - param.min_x)/(double)param.nb_points_x, MPFR_RNDU); } else if (param.logarithmic_scale_x == -1) { mpfr_set_d (incr_x, 2.*(param.max_x - param.min_x)/(double)param.nb_points_x, MPFR_RNDU); mpfr_exp2 (incr_x, incr_x, MPFR_RNDU); } else { /* other values of param.logarithmic_scale_x are considered as 1 */ mpfr_set_d (incr_x, (param.max_x - param.min_x)/(double)param.nb_points_x, MPFR_RNDU); mpfr_exp2 (incr_x, incr_x, MPFR_RNDU); } /* Main loop */ mpfr_init2 (x, param.max_prec); mpfr_init2 (x2, param.max_prec); prec = (double)param.min_prec; while (prec <= param.max_prec) { printf ("prec = %d\n", (int)prec); if (param.logarithmic_scale_x == 0) mpfr_set_d (temp, param.min_x, MPFR_RNDU); else if (param.logarithmic_scale_x == -1) { mpfr_set_d (temp, param.max_x, MPFR_RNDD); mpfr_exp2 (temp, temp, MPFR_RNDD); mpfr_neg (temp, temp, MPFR_RNDU); } else { mpfr_set_d (temp, param.min_x, MPFR_RNDD); mpfr_exp2 (temp, temp, MPFR_RNDD); } /* We perturb x a little bit, in order to avoid trailing zeros that */ /* might change the behavior of algorithms. */ mpfr_const_pi (x, MPFR_RNDN); mpfr_div_2ui (x, x, 7, MPFR_RNDN); mpfr_add_ui (x, x, 1, MPFR_RNDN); mpfr_mul (x, x, temp, MPFR_RNDN); test = 1; while (test) { mpfr_fprintf (output, "%e\t", mpfr_get_d (x, MPFR_RNDN)); mpfr_fprintf (output, "%Pu\t", (mpfr_prec_t)prec); s.r = (mp_limb_t)mpfr_get_exp (x); s.size = (mpfr_prec_t)prec; s.align_xp = (mpfr_sgn (x) > 0)?1:2; mpfr_set_prec (x2, (mpfr_prec_t)prec); mpfr_set (x2, x, MPFR_RNDU); s.xp = x2->_mpfr_d; for (i=0; i<nb_functions; i++) { t[i] = speed_measure (param.speed_funcs[i], &s); mpfr_fprintf (output, "%e\t", t[i]); } fprintf (output, "%d\n", 1 + find_best (t, nb_functions)); if (param.logarithmic_scale_x == 0) { mpfr_add (x, x, incr_x, MPFR_RNDU); if (mpfr_cmp_d (x, param.max_x) > 0) test=0; } else { if (mpfr_sgn (x) < 0 ) { /* if x<0, it means that logarithmic_scale_x=-1 */ mpfr_div (x, x, incr_x, MPFR_RNDU); mpfr_abs (temp, x, MPFR_RNDD); mpfr_log2 (temp, temp, MPFR_RNDD); if (mpfr_cmp_d (temp, param.min_x) < 0) mpfr_neg (x, x, MPFR_RNDN); } else { mpfr_mul (x, x, incr_x, MPFR_RNDU); mpfr_set (temp, x, MPFR_RNDD); mpfr_log2 (temp, temp, MPFR_RNDD); if (mpfr_cmp_d (temp, param.max_x) > 0) test=0; } } } prec = ( (param.logarithmic_scale_prec) ? (prec * incr_prec) : (prec + incr_prec) ); fprintf (output, "\n"); } free (t); mpfr_clear (incr_x); mpfr_clear (x); mpfr_clear (x2); mpfr_clear (temp); return; }
static void check_random (FILE *fout, int nb_tests) { int i; mpfr_t x; mp_rnd_t rnd; char flag[] = { '-', '+', ' ', '#', '0', /* no ambiguity: first zeros are flag zero*/ '\'' }; char specifier[] = { 'a', 'b', 'e', 'f', 'g' }; mp_exp_t old_emin, old_emax; old_emin = mpfr_get_emin (); old_emax = mpfr_get_emax (); mpfr_init (x); for (i = 0; i < nb_tests; ++i) { int ret; int j, jmax; int spec, prec; #define FMT_SIZE 13 char fmt[FMT_SIZE]; /* at most something like "%-+ #0'.*R*f" */ char *ptr = fmt; tests_default_random (x, 256, MPFR_EMIN_MIN, MPFR_EMAX_MAX); rnd = RND_RAND (); spec = (int) (randlimb () % 5); jmax = (spec == 3 || spec == 4) ? 6 : 5; /* ' flag only with %f or %g */ /* advantage small precision */ prec = (int) (randlimb () % ((randlimb () % 2) ? 10 : prec_max_printf)); if (spec == 3 && (mpfr_get_exp (x) > prec_max_printf || mpfr_get_exp (x) < -prec_max_printf)) /* change style 'f' to style 'e' when number x is large */ --spec; *ptr++ = '%'; for (j = 0; j < jmax; j++) { if (randlimb () % 3 == 0) *ptr++ = flag[j]; } *ptr++ = '.'; *ptr++ = '*'; *ptr++ = 'R'; *ptr++ = '*'; *ptr++ = specifier[spec]; *ptr = '\0'; MPFR_ASSERTD (ptr - fmt < FMT_SIZE); mpfr_fprintf (fout, "mpfr_fprintf(fout, \"%s\", %d, %s, %Re)\n", fmt, prec, mpfr_print_rnd_mode (rnd), x); ret = mpfr_fprintf (fout, fmt, prec, rnd, x); if (ret == -1) { if (spec == 3 && (MPFR_GET_EXP (x) > INT_MAX || MPFR_GET_EXP (x) < -INT_MAX)) /* normal failure: x is too large to be output with full precision */ { mpfr_fprintf (fout, "too large !"); } else { mpfr_printf ("Error in mpfr_fprintf(fout, \"%s\", %d, %s, %Re)\n", fmt, prec, mpfr_print_rnd_mode (rnd), x); exit (1); } } mpfr_fprintf (fout, "\n"); } mpfr_set_emin (old_emin); mpfr_set_emax (old_emax); mpfr_clear (x); }
static void check_mixed (FILE *fout) { int ch = 'a'; #ifndef NPRINTF_HH signed char sch = -1; unsigned char uch = 1; #endif short sh = -1; unsigned short ush = 1; int i = -1; int j = 1; unsigned int ui = 1; long lo = -1; unsigned long ulo = 1; float f = -1.25; double d = -1.25; #if !defined(NPRINTF_T) || !defined(NPRINTF_L) long double ld = -1.25; #endif #ifndef NPRINTF_T ptrdiff_t p = 1, saved_p; #endif size_t sz = 1; mpz_t mpz; mpq_t mpq; mpf_t mpf; mpfr_rnd_t rnd = MPFR_RNDN; mp_size_t limb_size = 3; mp_limb_t limb[3]; mpfr_t mpfr; mpfr_prec_t prec = 53; mpz_init (mpz); mpz_set_ui (mpz, ulo); mpq_init (mpq); mpq_set_si (mpq, lo, ulo); mpf_init (mpf); mpf_set_q (mpf, mpq); mpfr_init2 (mpfr, prec); mpfr_set_f (mpfr, mpf, MPFR_RNDN); limb[0] = limb[1] = limb[2] = ~ (mp_limb_t) 0; check_vfprintf (fout, "a. %Ra, b. %u, c. %lx%n", mpfr, ui, ulo, &j); check_length (1, j, 22, d); check_vfprintf (fout, "a. %c, b. %Rb, c. %u, d. %li%ln", i, mpfr, i, lo, &ulo); check_length (2, ulo, 36, lu); check_vfprintf (fout, "a. %hi, b. %*f, c. %Re%hn", ush, 3, f, mpfr, &ush); check_length (3, ush, 29, hu); check_vfprintf (fout, "a. %hi, b. %f, c. %#.2Rf%n", sh, d, mpfr, &i); check_length (4, i, 29, d); check_vfprintf (fout, "a. %R*A, b. %Fe, c. %i%zn", rnd, mpfr, mpf, sz, &sz); check_length (5, (unsigned long) sz, 34, lu); /* no format specifier "%zu" in C89 */ check_vfprintf (fout, "a. %Pu, b. %c, c. %Zi%Zn", prec, ch, mpz, &mpz); check_length_with_cmp (6, mpz, 17, mpz_cmp_ui (mpz, 17), Zi); check_vfprintf (fout, "%% a. %#.0RNg, b. %Qx%Rn, c. %p", mpfr, mpq, &mpfr, (void *) &i); check_length_with_cmp (7, mpfr, 15, mpfr_cmp_ui (mpfr, 15), Rg); #ifndef NPRINTF_T saved_p = p; check_vfprintf (fout, "%% a. %RNg, b. %Qx, c. %td%tn", mpfr, mpq, p, &p); if (p != 20) mpfr_fprintf (stderr, "Error in test 8, got '%% a. %RNg, b. %Qx, c. %td'\n", mpfr, mpq, saved_p); check_length (8, (long) p, 20, ld); /* no format specifier "%td" in C89 */ #endif #ifndef NPRINTF_L check_vfprintf (fout, "a. %RA, b. %Lf, c. %QX%zn", mpfr, ld, mpq, &sz); check_length (9, (unsigned long) sz, 30, lu); /* no format specifier "%zu" in C89 */ #endif #ifndef NPRINTF_HH check_vfprintf (fout, "a. %hhi, b. %RA, c. %hhu%hhn", sch, mpfr, uch, &uch); check_length (10, (unsigned int) uch, 22, u); /* no format specifier "%hhu" in C89 */ #endif #if (__GNU_MP_VERSION * 10 + __GNU_MP_VERSION_MINOR) >= 42 /* The 'M' specifier was added in gmp 4.2.0 */ check_vfprintf (fout, "a. %Mx b. %Re%Mn", limb[0], mpfr, &limb[0]); if (limb[0] != 14 + GMP_NUMB_BITS / 4 || limb[1] != ~ (mp_limb_t) 0 || limb[2] != ~ (mp_limb_t) 0) { printf ("Error in test #11: mpfr_vfprintf did not print %d characters" " as expected\n", 14 + (int) GMP_NUMB_BITS / 4); exit (1); } limb[0] = ~ (mp_limb_t) 0; /* we tell vfprintf that limb array is 2 cells wide and check it doesn't go through */ check_vfprintf (fout, "a. %Re .b %Nx%Nn", mpfr, limb, limb_size, limb, limb_size - 1); if (limb[0] != 14 + 3 * GMP_NUMB_BITS / 4 || limb[1] != (mp_limb_t) 0 || limb[2] != ~ (mp_limb_t) 0) { printf ("Error in test #12: mpfr_vfprintf did not print %d characters" " as expected\n", 14 + (int) GMP_NUMB_BITS / 4); exit (1); } #endif #if defined(HAVE_LONG_LONG) && !defined(NPRINTF_LL) { long long llo = -1; unsigned long long ullo = 1; check_vfprintf (fout, "a. %Re, b. %llx%Qn", mpfr, ullo, &mpq); check_length_with_cmp (21, mpq, 16, mpq_cmp_ui (mpq, 16, 1), Qu); check_vfprintf (fout, "a. %lli, b. %Rf%Fn", llo, mpfr, &mpf); check_length_with_cmp (22, mpf, 19, mpf_cmp_ui (mpf, 19), Fg); } #endif #if defined(_MPFR_H_HAVE_INTMAX_T) && !defined(NPRINTF_J) { intmax_t im = -1; uintmax_t uim = 1; check_vfprintf (fout, "a. %*RA, b. %ji%Qn", 10, mpfr, im, &mpq); check_length_with_cmp (31, mpq, 20, mpq_cmp_ui (mpq, 20, 1), Qu); check_vfprintf (fout, "a. %.*Re, b. %jx%Fn", 10, mpfr, uim, &mpf); check_length_with_cmp (32, mpf, 25, mpf_cmp_ui (mpf, 25), Fg); } #endif mpfr_clear (mpfr); mpf_clear (mpf); mpq_clear (mpq); mpz_clear (mpz); }
static void check_mixed (void) { int ch = 'a'; #ifndef NPRINTF_HH signed char sch = -1; unsigned char uch = 1; #endif short sh = -1; unsigned short ush = 1; int i = -1; int j = 1; unsigned int ui = 1; long lo = -1; unsigned long ulo = 1; float f = -1.25; double d = -1.25; #if !defined(NPRINTF_T) || !defined(NPRINTF_L) long double ld = -1.25; #endif #ifndef NPRINTF_T ptrdiff_t p = 1, saved_p; #endif size_t sz = 1; mpz_t mpz; mpq_t mpq; mpf_t mpf; mpfr_rnd_t rnd = MPFR_RNDN; mpfr_t mpfr; mpfr_prec_t prec; mpz_init (mpz); mpz_set_ui (mpz, ulo); mpq_init (mpq); mpq_set_si (mpq, lo, ulo); mpf_init (mpf); mpf_set_q (mpf, mpq); mpfr_init (mpfr); mpfr_set_f (mpfr, mpf, MPFR_RNDN); prec = mpfr_get_prec (mpfr); check_vprintf ("a. %Ra, b. %u, c. %lx%n", mpfr, ui, ulo, &j); check_length (1, j, 22, d); check_vprintf ("a. %c, b. %Rb, c. %u, d. %li%ln", i, mpfr, i, lo, &ulo); check_length (2, ulo, 36, lu); check_vprintf ("a. %hi, b. %*f, c. %Re%hn", ush, 3, f, mpfr, &ush); check_length (3, ush, 29, hu); check_vprintf ("a. %hi, b. %f, c. %#.2Rf%n", sh, d, mpfr, &i); check_length (4, i, 29, d); check_vprintf ("a. %R*A, b. %Fe, c. %i%zn", rnd, mpfr, mpf, sz, &sz); check_length (5, (unsigned long) sz, 34, lu); /* no format specifier '%zu' in C89 */ check_vprintf ("a. %Pu, b. %c, c. %RUG, d. %Zi%Zn", prec, ch, mpfr, mpz, &mpz); check_length_with_cmp (6, mpz, 24, mpz_cmp_ui (mpz, 24), Zi); check_vprintf ("%% a. %#.0RNg, b. %Qx%Rn c. %p", mpfr, mpq, &mpfr, (void *) &i); check_length_with_cmp (7, mpfr, 15, mpfr_cmp_ui (mpfr, 15), Rg); #ifndef NPRINTF_T saved_p = p; check_vprintf ("%% a. %RNg, b. %Qx, c. %td%tn", mpfr, mpq, p, &p); if (p != 20) mpfr_fprintf (stderr, "Error in test 8, got '%% a. %RNg, b. %Qx, c. %td'\n", mpfr, mpq, saved_p); check_length (8, (long) p, 20, ld); /* no format specifier '%td' in C89 */ #endif #ifndef NPRINTF_L check_vprintf ("a. %RA, b. %Lf, c. %QX%zn", mpfr, ld, mpq, &sz); check_length (9, (unsigned long) sz, 30, lu); /* no format specifier '%zu' in C89 */ #endif #ifndef NPRINTF_HH check_vprintf ("a. %hhi, b. %Ra, c. %hhu%hhn", sch, mpfr, uch, &uch); check_length (10, (unsigned int) uch, 22, u); /* no format specifier '%hhu' in C89 */ #endif #if defined(HAVE_LONG_LONG) && !defined(NPRINTF_LL) { long long llo = -1; unsigned long long ullo = 1; check_vprintf ("a. %Re, b. %llx%Qn", mpfr, ullo, &mpq); check_length_with_cmp (11, mpq, 16, mpq_cmp_ui (mpq, 16, 1), Qu); check_vprintf ("a. %lli, b. %Rf%lln", llo, mpfr, &ullo); check_length (12, ullo, 19, llu); } #endif #if defined(_MPFR_H_HAVE_INTMAX_T) && !defined(NPRINTF_J) { intmax_t im = -1; uintmax_t uim = 1; check_vprintf ("a. %*RA, b. %ji%Fn", 10, mpfr, im, &mpf); check_length_with_cmp (31, mpf, 20, mpf_cmp_ui (mpf, 20), Fg); check_vprintf ("a. %.*Re, b. %jx%jn", 10, mpfr, uim, &im); check_length (32, (long) im, 25, li); /* no format specifier "%ji" in C89 */ } #endif mpfr_clear (mpfr); mpf_clear (mpf); mpq_clear (mpq); mpz_clear (mpz); }
int fmpq_poly_oz_sqrt_approx_babylonian(fmpq_poly_t f_sqrt, const fmpq_poly_t f, const long n, const mpfr_prec_t prec, const mpfr_prec_t bound, oz_flag_t flags, const fmpq_poly_t init) { fmpq_poly_t y; fmpq_poly_init(y); fmpq_poly_t y_next; fmpq_poly_init(y_next); mpfr_t norm; mpfr_init2(norm, prec); mpfr_t prev_norm; mpfr_init2(prev_norm, prec); if (init) { fmpq_poly_set(y, init); } else { fmpq_poly_set(y, f); } mpfr_t log_f; mpfr_init2(log_f, prec); uint64_t t = oz_walltime(0); int r = 0; for(long k=0; ; k++) { _fmpq_poly_oz_invert_approx(y_next, y, n, prec); fmpq_poly_oz_mul(y_next, f, y_next, n); fmpq_poly_add(y_next, y_next, y); fmpq_poly_scalar_div_si(y_next, y_next, 2); fmpq_poly_set(y, y_next); r = _fmpq_poly_oz_sqrt_approx_break(norm, y, f, n, bound, prec); if(flags & OZ_VERBOSE) { mpfr_log2(log_f, norm, MPFR_RNDN); mpfr_fprintf(stderr, "Computing sqrt(Σ):: k: %4d, Δ=|sqrt(Σ)^2-Σ|: %7.2Rf", k, log_f); fprintf(stderr, " <? %4ld, ", -bound); fprintf(stderr, "t: %8.2fs\n", oz_seconds(oz_walltime(t))); fflush(0); } if(r) { r = 0; break; } if (k>0 && mpfr_cmp_ui_2exp(norm, 1, bound) >= 0) { /* something went really wrong */ r = -1; break; } mpfr_div_ui(prev_norm, prev_norm, 2, MPFR_RNDN); if (k>0 && mpfr_cmp(norm, prev_norm) >= 0) { /* we don't converge any more */ r = 1; break; } mpfr_set(prev_norm, norm, MPFR_RNDN); } mpfr_clear(log_f); fmpq_poly_set(f_sqrt, y); mpfr_clear(norm); mpfr_clear(prev_norm); fmpq_poly_clear(y_next); fmpq_poly_clear(y); return r; }
int fmpq_poly_oz_sqrt_approx_pade(fmpq_poly_t f_sqrt, const fmpq_poly_t f, const long n, const int p, const mpfr_prec_t prec, const mpfr_prec_t bound, oz_flag_t flags, const fmpq_poly_t init) { fmpq_poly_t y; fmpq_poly_init(y); fmpq_poly_t y_next; fmpq_poly_init(y_next); fmpq_poly_t z; fmpq_poly_init(z); fmpq_poly_t z_next; fmpq_poly_init(z_next); mpfr_t norm; mpfr_init2(norm, prec); mpfr_t prev_norm; mpfr_init2(prev_norm, prec); mpfr_t log_f; mpfr_init2(log_f, prec); if (init) { // z = y/x fmpq_poly_set(y, init); _fmpq_poly_oz_invert_approx(z, f, n, prec); fmpq_poly_oz_mul(z, z, y, n); } else { fmpq_poly_set(y, f); fmpq_poly_set_coeff_si(z, 0, 1); } fmpq_t *xi = (fmpq_t*)calloc(p, sizeof(fmpq_t)); fmpq_t *a2 = (fmpq_t*)calloc(p, sizeof(fmpq_t)); fmpq_t *c = (fmpq_t*)calloc(p, sizeof(fmpq_t)); fmpq_poly_t *t_ = (fmpq_poly_t*)calloc(p, sizeof(fmpq_poly_t)); fmpq_poly_t *s_ = (fmpq_poly_t*)calloc(p, sizeof(fmpq_poly_t)); mpfr_t pi; mpfr_init2(pi, 4*prec); mpfr_const_pi(pi, MPFR_RNDN); #pragma omp parallel for for(int i=0; i<p; i++) { mpfr_t xi_r; mpfr_init2(xi_r, 4*prec); mpfr_t a2_r; mpfr_init2(a2_r, 4*prec); /* ζ_i = 1/2 * (1 + cos( (2·i -1)·π/(2·p) )) */ mpfr_set_si(xi_r, 2*i+1, MPFR_RNDN); mpfr_mul(xi_r, xi_r, pi, MPFR_RNDN); mpfr_div_si(xi_r, xi_r, 2*p, MPFR_RNDN); mpfr_cos(xi_r, xi_r, MPFR_RNDN); mpfr_add_si(xi_r, xi_r, 1, MPFR_RNDN); mpfr_div_si(xi_r, xi_r, 2, MPFR_RNDN); /* α_i^2 = 1/ζ_i -1 */ mpfr_set_si(a2_r, 1, MPFR_RNDN); mpfr_div(a2_r, a2_r, xi_r, MPFR_RNDN); mpfr_sub_si(a2_r, a2_r, 1, MPFR_RNDN); fmpq_init(xi[i]); fmpq_init(a2[i]); fmpq_set_mpfr(xi[i], xi_r, MPFR_RNDN); fmpq_set_mpfr(a2[i], a2_r, MPFR_RNDN); fmpq_init(c[i]); fmpq_poly_init(t_[i]); fmpq_poly_init(s_[i]); mpfr_clear(xi_r); mpfr_clear(a2_r); } mpfr_clear(pi); uint64_t t = oz_walltime(0); int r = 0; int cont = 1; for(long k=0; cont; k++) { if (k == 0 || mpfr_cmp_ui(prev_norm, 1) > 0) _fmpq_poly_oz_sqrt_approx_scale(y, z, n, prec); /* T = sum([1/xi[i] * ~(Z*Y + a2[i]) for i in range(p)]) */ #pragma omp parallel for for(int i=0; i<p; i++) { fmpq_poly_oz_mul(t_[i], z, y, n); fmpq_poly_get_coeff_fmpq(c[i], t_[i], 0); fmpq_add(c[i], c[i], a2[i]); fmpq_poly_set_coeff_fmpq(t_[i], 0, c[i]); fmpq_poly_scalar_mul_fmpq(t_[i], t_[i], xi[i]); _fmpq_poly_oz_invert_approx(s_[i], t_[i], n, prec); } for(int i=1; i<p; i++) fmpq_poly_add(s_[0], s_[0], s_[i]); #pragma omp parallel sections { #pragma omp section { fmpq_poly_oz_mul(y_next, y, s_[0], n); fmpq_poly_scalar_div_si(y_next, y_next, p); fmpq_poly_set(y, y_next); } #pragma omp section { fmpq_poly_oz_mul(z_next, z, s_[0], n); fmpq_poly_scalar_div_si(z_next, z_next, p); fmpq_poly_set(z, z_next); } } cont = !_fmpq_poly_oz_sqrt_approx_break(norm, y, f, n, bound, prec); if(flags & OZ_VERBOSE) { mpfr_log2(log_f, norm, MPFR_RNDN); mpfr_fprintf(stderr, "Computing sqrt(Σ):: k: %4d, Δ=|sqrt(Σ)^2-Σ|: %7.2Rf", k, log_f); fprintf(stderr, " <? %4ld, ", -bound); fprintf(stderr, "t: %8.2fs\n", oz_seconds(oz_walltime(t))); fflush(0); } if (cont) { if (k>0 && mpfr_cmp_ui_2exp(norm, 1, bound) >= 0) { /* something went really wrong */ r = -1; break; } if (k>0 && mpfr_cmp(norm, prev_norm) >= 0) { /* we don't converge any more */ r = 1; break; } mpfr_set(prev_norm, norm, MPFR_RNDN); } } for(int i=0; i<p; i++) { fmpq_clear(xi[i]); fmpq_clear(a2[i]); fmpq_clear(c[i]); fmpq_poly_clear(t_[i]); fmpq_poly_clear(s_[i]); } free(xi); free(a2); free(c); free(t_); free(s_); mpfr_clear(log_f); fmpq_poly_set(f_sqrt, y); mpfr_clear(norm); mpfr_clear(prev_norm); fmpq_poly_clear(y_next); fmpq_poly_clear(y); fmpq_poly_clear(z_next); fmpq_poly_clear(z); return r; }
int nth_new_moon( mpfr_t *result, int n_int ) { mpfr_t n, k, C, approx, E, solar_anomaly, lunar_anomaly, moon_argument, omega, extra, correction, additional; #if(0) PerlIO_printf(PerlIO_stderr(), "nth_new_moon = %d\n", n_int ); #endif if ( dt_astro_global_cache.cache_size > n_int ) { mpfr_t *cached = dt_astro_global_cache.cache[n_int]; if (cached != NULL) { #if(0) PerlIO_printf(PerlIO_stderr(), "Cache HIT for %d\n", n_int); #endif mpfr_set( *result, *cached, GMP_RNDN ); return 1; } } mpfr_init_set_ui( n, n_int, GMP_RNDN ); /* k = n - 24724 */ mpfr_init_set(k, n, GMP_RNDN); mpfr_sub_ui(k, k, 24724, GMP_RNDN ); /* c = k / 1236.85 */ mpfr_init_set(C, k, GMP_RNDN ); mpfr_div_d(C, C, 1236.85, GMP_RNDN); { mpfr_t a, b, c, d, e; mpfr_init(approx); mpfr_init_set_d(a, 730125.59765, GMP_RNDN ); mpfr_init_set_d(b, MEAN_SYNODIC_MONTH * 1236.85, GMP_RNDN ); mpfr_init_set_d(c, 0.0001337, GMP_RNDN ); mpfr_init_set_d(d, -0.000000150, GMP_RNDN ); mpfr_init_set_d(e, 0.00000000073, GMP_RNDN ); polynomial( &approx, &C, 5, &a, &b, &c, &d, &e ); mpfr_clear(a); mpfr_clear(b); mpfr_clear(c); mpfr_clear(d); mpfr_clear(e); #ifdef ANNOYING_DEBUG #if (ANNOYING_DEBUG) mpfr_fprintf(stderr, "approx = %.10RNf\n", approx); #endif #endif } { mpfr_t a, b, c; mpfr_init(E); mpfr_init_set_ui(a, 1, GMP_RNDN); mpfr_init_set_d(b, -0.002516, GMP_RNDN ); mpfr_init_set_d(c, -0.0000074, GMP_RNDN ); polynomial( &E, &C, 3, &a, &b, &c ); mpfr_clear(a); mpfr_clear(b); mpfr_clear(c); } { mpfr_t a, b, c, d; mpfr_init(solar_anomaly); mpfr_init_set_d(a, 2.5534, GMP_RNDN); mpfr_init_set_d(b, 1236.85, GMP_RNDN); mpfr_mul_d(b, b, 29.10535669, GMP_RNDN); mpfr_init_set_d(c, -0.0000218, GMP_RNDN ); mpfr_init_set_d(d, -0.00000011, GMP_RNDN ); polynomial( &solar_anomaly, &C, 4, &a, &b, &c, &d); mpfr_clear(a); mpfr_clear(b); mpfr_clear(c); mpfr_clear(d); } { mpfr_t a, b, c, d, e; mpfr_init(lunar_anomaly); mpfr_init_set_d(a, 201.5643, GMP_RNDN); mpfr_init_set_d(b, 385.81693528 * 1236.85, GMP_RNDN); mpfr_init_set_d(c, 0.0107438, GMP_RNDN); mpfr_init_set_d(d, 0.00001239, GMP_RNDN); mpfr_init_set_d(e, -0.000000058, GMP_RNDN); polynomial( &lunar_anomaly, &C, 5, &a, &b, &c, &d, &e); mpfr_clear(a); mpfr_clear(b); mpfr_clear(c); mpfr_clear(d); mpfr_clear(e); } { mpfr_t a, b, c, d, e; mpfr_init(moon_argument); mpfr_init_set_d(a, 160.7108, GMP_RNDN); mpfr_init_set_d(b, 390.67050274 * 1236.85, GMP_RNDN); mpfr_init_set_d(c, -0.0016431, GMP_RNDN); mpfr_init_set_d(d, -0.00000227, GMP_RNDN); mpfr_init_set_d(e, 0.000000011, GMP_RNDN); polynomial( &moon_argument, &C, 5, &a, &b, &c, &d, &e); mpfr_clear(a); mpfr_clear(b); mpfr_clear(c); mpfr_clear(d); mpfr_clear(e); } { mpfr_t a, b, c, d; mpfr_init(omega); mpfr_init_set_d(a, 124.7746, GMP_RNDN); mpfr_init_set_d(b, -1.56375580 * 1236.85, GMP_RNDN); mpfr_init_set_d(c, 0.0020691, GMP_RNDN); mpfr_init_set_d(d, 0.00000215, GMP_RNDN); polynomial( &omega, &C, 4, &a, &b, &c, &d); mpfr_clear(a); mpfr_clear(b); mpfr_clear(c); mpfr_clear(d); } { mpfr_t a, b, c; mpfr_init(extra); mpfr_init_set_d(a, 299.77, GMP_RNDN); mpfr_init_set_d(b, 132.8475848, GMP_RNDN); mpfr_init_set_d(c, -0.009173, GMP_RNDN); polynomial(&extra, &c, 3, &a, &b, &c); dt_astro_sin(&extra, &extra); mpfr_mul_d(extra, extra, 0.000325, GMP_RNDN); mpfr_clear(a); mpfr_clear(b); mpfr_clear(c); } mpfr_init(correction); dt_astro_sin(&correction, &omega); mpfr_mul_d(correction, correction, -0.00017, GMP_RNDN); { int i; for( i = 0; i < NTH_NEW_MOON_CORRECTION_ARGS_SIZE; i++ ) { mpfr_t a, v, w, x, y, z; mpfr_init_set_d(v, NTH_NEW_MOON_CORRECTION_ARGS[i][0], GMP_RNDN); mpfr_init_set_d(w, NTH_NEW_MOON_CORRECTION_ARGS[i][1], GMP_RNDN); mpfr_init_set_d(x, NTH_NEW_MOON_CORRECTION_ARGS[i][2], GMP_RNDN); mpfr_init_set_d(y, NTH_NEW_MOON_CORRECTION_ARGS[i][3], GMP_RNDN); mpfr_init_set_d(z, NTH_NEW_MOON_CORRECTION_ARGS[i][4], GMP_RNDN); mpfr_mul(x, x, solar_anomaly, GMP_RNDN); mpfr_mul(y, y, lunar_anomaly, GMP_RNDN); mpfr_mul(z, z, moon_argument, GMP_RNDN); mpfr_add(x, x, y, GMP_RNDN); mpfr_add(x, x, z, GMP_RNDN); dt_astro_sin(&x, &x); mpfr_init(a); mpfr_pow(a, E, w, GMP_RNDN); mpfr_mul(a, a, v, GMP_RNDN); mpfr_mul(a, a, x, GMP_RNDN); mpfr_add( correction, correction, a, GMP_RNDN ); mpfr_clear(a); mpfr_clear(v); mpfr_clear(w); mpfr_clear(x); mpfr_clear(y); mpfr_clear(z); } } { int z; mpfr_init_set_ui(additional, 0, GMP_RNDN); for (z = 0; z < NTH_NEW_MOON_ADDITIONAL_ARGS_SIZE; z++) { mpfr_t i, j, l; mpfr_init_set_d(i, NTH_NEW_MOON_ADDITIONAL_ARGS[z][0], GMP_RNDN); mpfr_init_set_d(j, NTH_NEW_MOON_ADDITIONAL_ARGS[z][1], GMP_RNDN); mpfr_init_set_d(l, NTH_NEW_MOON_ADDITIONAL_ARGS[z][2], GMP_RNDN); mpfr_mul(j, j, k, GMP_RNDN); mpfr_add(j, j, i, GMP_RNDN); dt_astro_sin(&j, &j); mpfr_mul(l, l, j, GMP_RNDN); mpfr_add(additional, additional, l, GMP_RNDN); mpfr_clear(i); mpfr_clear(j); mpfr_clear(l); } } #ifdef ANNOYING_DEBUG #if (ANNOYING_DEBUG) mpfr_fprintf(stderr, "correction = %.10RNf\nextra = %.10RNf\nadditional = %.10RNf\n", correction, extra, additional ); #endif #endif mpfr_set(*result, approx, GMP_RNDN); mpfr_add(*result, *result, correction, GMP_RNDN); mpfr_add(*result, *result, extra, GMP_RNDN); mpfr_add(*result, *result, additional, GMP_RNDN); adjust_lunar_phase_to_zero( result ); mpfr_clear(n); mpfr_clear(k); mpfr_clear(C); mpfr_clear(approx); mpfr_clear(E); mpfr_clear(solar_anomaly); mpfr_clear(lunar_anomaly); mpfr_clear(moon_argument); mpfr_clear(omega); mpfr_clear(extra); mpfr_clear(correction); mpfr_clear(additional); if (dt_astro_global_cache.cache_size == 0) { dt_astro_global_cache.cache_size = 200000; Newxz( dt_astro_global_cache.cache, dt_astro_global_cache.cache_size, mpfr_t * ); }
static inline void adjust_lunar_phase_to_zero(mpfr_t *result) { mpfr_t ll, delta; int mode = -1; int loop = 1; int count = 0; /* Adjust values so that it's as close as possible to 0 degrees. * if we have a delta of 1 degree, then we're about * 1 / ( 360 / MEAN_SYNODIC_MONTH ) * days apart */ mpfr_init(ll); mpfr_init_set_d(delta, 0.0001, GMP_RNDN); while (loop) { int flipped = mode; mpfr_t new_moment; count++; mpfr_init(new_moment); lunar_phase(&ll, result); #if (TRACE) mpfr_fprintf(stderr, "Adjusting ll from (%.30RNf) moment is %.5RNf delta is %.30RNf\n", ll, *result, delta); #endif /* longitude was greater than 180, so we're looking to add a few * degrees to make it close to 360 ( 0 ) */ if (mpfr_cmp_ui( ll, 180 ) > 0) { mode = 1; mpfr_sub_ui(delta, ll, 360, GMP_RNDN); mpfr_div_d(delta, delta, 360 / MEAN_SYNODIC_MONTH, GMP_RNDN); mpfr_add( new_moment, *result, delta, GMP_RNDN ); #if (TRACE) mpfr_fprintf(stderr, "add %.30RNf -> %.30RNf\n", *result, new_moment); #endif mpfr_set(*result, new_moment, GMP_RNDN); if (mpfr_cmp(new_moment, *result) == 0) { loop = 0; } } else if (mpfr_cmp_ui( ll, 180 ) < 0 ) { if ( mpfr_cmp_d( ll, 0.000000000000000000001 ) < 0) { loop = 0; } else { mode = 0; mpfr_sub_ui(delta, ll, 0, GMP_RNDN); mpfr_div_d(delta, delta, 360 / MEAN_SYNODIC_MONTH, GMP_RNDN); mpfr_sub( new_moment, *result, delta, GMP_RNDN ); #if (TRACE) mpfr_fprintf(stderr, "sub %.120RNf -> %.120RNf\n", *result, new_moment); #endif if (mpfr_cmp(new_moment, *result) == 0) { loop = 0; } mpfr_set(*result, new_moment, GMP_RNDN); } } else { loop = 0; } if (flipped != -1 && flipped != mode) { mpfr_div_d(delta, delta, 1.1, GMP_RNDN); } mpfr_clear(new_moment); } mpfr_clear(delta); mpfr_clear(ll); }
int lunar_longitude( mpfr_t *result, mpfr_t *moment ) { mpfr_t C, mean_moon, elongation, solar_anomaly, lunar_anomaly, moon_node, E, correction, venus, jupiter, flat_earth, N, fullangle; mpfr_init(C); julian_centuries( &C, moment ); { mpfr_t a, b, c, d, e; mpfr_init(mean_moon); mpfr_init_set_d(a, 218.316591, GMP_RNDN); mpfr_init_set_d(b, 481267.88134236, GMP_RNDN); mpfr_init_set_d(c, -0.0013268, GMP_RNDN); mpfr_init_set_ui(d, 1, GMP_RNDN); mpfr_div_ui(d, d, 538841, GMP_RNDN); mpfr_init_set_si(e, -1, GMP_RNDN); mpfr_div_ui(e, e, 65194000, GMP_RNDN); polynomial( &mean_moon, &C, 5, &a, &b, &c, &d, &e ); mpfr_clear(a); mpfr_clear(b); mpfr_clear(c); mpfr_clear(d); mpfr_clear(e); } { mpfr_t a, b, c, d, e; mpfr_init(elongation); mpfr_init_set_d(a, 297.8502042, GMP_RNDN); mpfr_init_set_d(b, 445267.1115168, GMP_RNDN); mpfr_init_set_d(c, -0.00163, GMP_RNDN); mpfr_init_set_ui(d, 1, GMP_RNDN); mpfr_div_ui(d, d, 545868, GMP_RNDN); mpfr_init_set_si(e, -1, GMP_RNDN); mpfr_div_ui(e, e, 113065000, GMP_RNDN); polynomial( &elongation, &C, 5, &a, &b, &c, &d, &e ); mpfr_clear(a); mpfr_clear(b); mpfr_clear(c); mpfr_clear(d); mpfr_clear(e); } { mpfr_t a, b, c, d; mpfr_init(solar_anomaly); mpfr_init_set_d(a, 357.5291092, GMP_RNDN); mpfr_init_set_d(b, 35999.0502909, GMP_RNDN); mpfr_init_set_d(c, -0.0001536, GMP_RNDN); mpfr_init_set_ui(d, 1, GMP_RNDN); mpfr_div_ui(d, d, 24490000, GMP_RNDN); polynomial( &solar_anomaly, &C, 4, &a, &b, &c, &d ); mpfr_clear(a); mpfr_clear(b); mpfr_clear(c); mpfr_clear(d); } { mpfr_t a, b, c, d, e; mpfr_init(lunar_anomaly); mpfr_init_set_d(a, 134.9634114, GMP_RNDN); mpfr_init_set_d(b, 477198.8676313, GMP_RNDN); mpfr_init_set_d(c, 0.0008997, GMP_RNDN); mpfr_init_set_ui(d, 1, GMP_RNDN); mpfr_div_ui(d, d, 69699, GMP_RNDN); mpfr_init_set_si(e, -1, GMP_RNDN); mpfr_div_ui(e, e, 14712000, GMP_RNDN); polynomial( &lunar_anomaly, &C, 5, &a, &b, &c, &d, &e); mpfr_clear(a); mpfr_clear(b); mpfr_clear(c); mpfr_clear(d); mpfr_clear(e); } { mpfr_t a, b, c, d, e; mpfr_init(moon_node); mpfr_init_set_d(a, 93.2720993, GMP_RNDN); mpfr_init_set_d(b, 483202.0175273, GMP_RNDN); mpfr_init_set_d(c, -0.0034029, GMP_RNDN); mpfr_init_set_si(d, -1, GMP_RNDN); mpfr_div_ui(d, d, 3526000, GMP_RNDN); mpfr_init_set_ui(e, 1, GMP_RNDN); mpfr_div_ui(e, e, 863310000, GMP_RNDN); polynomial(&moon_node, &C, 5, &a, &b, &c, &d, &e); mpfr_clear(a); mpfr_clear(b); mpfr_clear(c); mpfr_clear(d); mpfr_clear(e); } { mpfr_t a, b, c; mpfr_init(E); mpfr_init_set_ui(a, 1, GMP_RNDN); mpfr_init_set_d(b, -0.002516, GMP_RNDN); mpfr_init_set_d(c, -0.0000074, GMP_RNDN); polynomial( &E, &C, 3, &a, &b, &c ); mpfr_clear(a); mpfr_clear(b); mpfr_clear(c); } { int i; mpfr_t fugly; mpfr_init_set_ui(fugly, 0, GMP_RNDN); for(i = 0; i < LUNAR_LONGITUDE_ARGS_SIZE; i++) { mpfr_t a, b, v, w, x, y, z; mpfr_init_set_d( v, LUNAR_LONGITUDE_ARGS[i][0], GMP_RNDN ); mpfr_init_set_d( w, LUNAR_LONGITUDE_ARGS[i][1], GMP_RNDN ); mpfr_init_set_d( x, LUNAR_LONGITUDE_ARGS[i][2], GMP_RNDN ); mpfr_init_set_d( y, LUNAR_LONGITUDE_ARGS[i][3], GMP_RNDN ); mpfr_init_set_d( z, LUNAR_LONGITUDE_ARGS[i][4], GMP_RNDN ); mpfr_init(b); mpfr_pow(b, E, x, GMP_RNDN); mpfr_mul(w, w, elongation, GMP_RNDN); mpfr_mul(x, x, solar_anomaly, GMP_RNDN); mpfr_mul(y, y, lunar_anomaly, GMP_RNDN); mpfr_mul(z, z, moon_node, GMP_RNDN); mpfr_init_set(a, w, GMP_RNDN); mpfr_add(a, a, x, GMP_RNDN); mpfr_add(a, a, y, GMP_RNDN); mpfr_add(a, a, z, GMP_RNDN); dt_astro_sin(&a, &a); mpfr_mul(a, a, v, GMP_RNDN); mpfr_mul(a, a, b, GMP_RNDN); mpfr_add(fugly, fugly, a, GMP_RNDN); mpfr_clear(a); mpfr_clear(b); mpfr_clear(v); mpfr_clear(w); mpfr_clear(x); mpfr_clear(y); mpfr_clear(z); } mpfr_init_set_d( correction, 0.000001, GMP_RNDN ); mpfr_mul( correction, correction, fugly, GMP_RNDN); mpfr_clear(fugly); } { mpfr_t a, b; mpfr_init(venus); mpfr_init_set_d(a, 119.75, GMP_RNDN); mpfr_init_set(b, C, GMP_RNDN); mpfr_mul_d(b, b, 131.849, GMP_RNDN); mpfr_add(a, a, b, GMP_RNDN); dt_astro_sin(&a, &a); mpfr_mul_d(venus, a, 0.003957, GMP_RNDN ); mpfr_clear(a); mpfr_clear(b); } { mpfr_t a, b; mpfr_init(jupiter); mpfr_init_set_d(a, 53.09, GMP_RNDN); mpfr_init_set(b, C, GMP_RNDN); mpfr_mul_d(b, b, 479264.29, GMP_RNDN); mpfr_add(a, a, b, GMP_RNDN); dt_astro_sin(&a, &a); mpfr_mul_d(jupiter, a, 0.000318, GMP_RNDN ); mpfr_clear(a); mpfr_clear(b); } { mpfr_t a; mpfr_init(flat_earth); mpfr_init_set(a, mean_moon, GMP_RNDN); mpfr_sub(a, a, moon_node, GMP_RNDN); dt_astro_sin(&a, &a); mpfr_mul_d(flat_earth, a, 0.001962, GMP_RNDN); mpfr_clear(a); } mpfr_set(*result, mean_moon, GMP_RNDN); mpfr_add(*result, *result, correction, GMP_RNDN); mpfr_add(*result, *result, venus, GMP_RNDN); mpfr_add(*result, *result, jupiter, GMP_RNDN); mpfr_add(*result, *result, flat_earth, GMP_RNDN); #ifdef ANNOYING_DEBUG #if (ANNOYING_DEBUG) mpfr_fprintf(stderr, "mean_moon = %.10RNf\ncorrection = %.10RNf\nvenus = %.10RNf\njupiter = %.10RNf\nflat_earth = %.10RNf\n", mean_moon, correction, venus, jupiter, flat_earth); #endif #endif mpfr_init(N); nutation(&N, moment); mpfr_add(*result, *result, N, GMP_RNDN); mpfr_init_set_ui(fullangle, 360, GMP_RNDN); #ifdef ANNOYING_DEBUG #if (ANNOYING_DEBUG) mpfr_fprintf(stderr, "lunar = mod(%.10RNf) = ", *result ); #endif #endif dt_astro_mod(result, result, &fullangle); #ifdef ANNOYING_DEBUG #if (ANNOYING_DEBUG) mpfr_fprintf(stderr, "%.10RNf\n", *result ); #endif #endif mpfr_clear(C); mpfr_clear(mean_moon); mpfr_clear(elongation); mpfr_clear(solar_anomaly); mpfr_clear(lunar_anomaly); mpfr_clear(moon_node); mpfr_clear(E); mpfr_clear(correction); mpfr_clear(venus); mpfr_clear(jupiter); mpfr_clear(flat_earth); mpfr_clear(N); mpfr_clear(fullangle); return 1; }
/* VARARGS2 */ void err(bool isfatal, const char *s, const char *emsg, va_list argp) { char *file; const char *me; static bool first = true; static bool add_src_info = false; if (first) { first = false; add_src_info = (getenv("GAWK_MSG_SRC") != NULL); } (void) fflush(output_fp); me = myname; (void) fprintf(stderr, "%s: ", me); if (srcfile != NULL && add_src_info) { fprintf(stderr, "%s:%d:", srcfile, srcline); srcfile = NULL; } if (sourceline > 0) { if (source != NULL) (void) fprintf(stderr, "%s:", source); else (void) fprintf(stderr, _("cmd. line:")); (void) fprintf(stderr, "%d: ", sourceline); } #ifdef HAVE_MPFR if (FNR_node && is_mpg_number(FNR_node->var_value)) { NODE *val; val = mpg_update_var(FNR_node); assert((val->flags & MPZN) != 0); if (mpz_sgn(val->mpg_i) > 0) { file = FILENAME_node->var_value->stptr; (void) putc('(', stderr); if (file) (void) fprintf(stderr, "FILENAME=%s ", file); (void) mpfr_fprintf(stderr, "FNR=%Zd) ", val->mpg_i); } } else #endif if (FNR > 0) { file = FILENAME_node->var_value->stptr; (void) putc('(', stderr); if (file) (void) fprintf(stderr, "FILENAME=%s ", file); (void) fprintf(stderr, "FNR=%ld) ", FNR); } (void) fprintf(stderr, "%s", s); vfprintf(stderr, emsg, argp); (void) fprintf(stderr, "\n"); (void) fflush(stderr); if (isfatal) { #ifdef GAWKDEBUG abort(); #endif gawk_exit(EXIT_FATAL); } }