double run_mp(double sigma_, double c_, int tau, dgs_disc_gauss_alg_t alg, size_t ntrials, unsigned long long *t) { mpfr_set_default_prec(80); mpfr_t sigma; mpfr_init_set_d(sigma, sigma_, MPFR_RNDN); gmp_randstate_t state; gmp_randinit_default(state); mpfr_t c; mpfr_init_set_d(c, c_, MPFR_RNDN); dgs_disc_gauss_mp_t *gen = dgs_disc_gauss_mp_init(sigma, c, tau, alg); double variance = 0.0; mpz_t r; mpz_init(r); *t = walltime(0); for(size_t i=0; i<ntrials; i++) { gen->call(r, gen, state); variance += mpz_get_d(r)*mpz_get_d(r); } *t = walltime(*t); dgs_disc_gauss_mp_clear(gen); mpfr_clear(sigma); mpz_clear(r); mpfr_clear(c); gmp_randclear(state); variance /= ntrials; return sqrt(variance); }
int main (void) { mpfr_t x, y, z, u; int inexact; mpfr_exp_t emax; tests_start_mpfr (); /* check prototypes of mpfr_init_set_* */ inexact = mpfr_init_set_si (x, -1, MPFR_RNDN); inexact = mpfr_init_set (y, x, MPFR_RNDN); inexact = mpfr_init_set_ui (z, 1, MPFR_RNDN); inexact = mpfr_init_set_d (u, 1.0, MPFR_RNDN); emax = mpfr_get_emax (); set_emax (0); mpfr_set_prec (x, 3); mpfr_set_str_binary (x, "0.111"); mpfr_set_prec (y, 2); mpfr_set (y, x, MPFR_RNDU); if (!(MPFR_IS_INF (y) && MPFR_SIGN (y) > 0)) { printf ("Error for y=x=0.111 with px=3, py=2 and emax=0\nx="); mpfr_dump (x); printf ("y="); mpfr_dump (y); exit (1); } set_emax (emax); mpfr_set_prec (y, 11); mpfr_set_str_binary (y, "0.11111111100E-8"); mpfr_set_prec (x, 2); mpfr_set (x, y, MPFR_RNDN); mpfr_set_str_binary (y, "1.0E-8"); if (mpfr_cmp (x, y)) { printf ("Error for y=0.11111111100E-8, prec=2, rnd=MPFR_RNDN\n"); exit (1); } mpfr_clear (x); mpfr_clear (y); mpfr_clear (z); mpfr_clear (u); check_ternary_value (); check_special (); check_neg_special (); test_generic (2, 1000, 10); tests_end_mpfr (); return 0; }
int main (void) { mp_prec_t p, q; mpfr_t x, y, z, u; mp_rnd_t rnd; int inexact, cmp; /* check prototypes of mpfr_init_set_* */ inexact = mpfr_init_set_si (x, -1, GMP_RNDN); inexact = mpfr_init_set (y, x, GMP_RNDN); inexact = mpfr_init_set_ui (z, 1, GMP_RNDN); inexact = mpfr_init_set_d (u, 1.0, GMP_RNDN); mpfr_set_prec (y, 11); mpfr_set_str_raw (y, "0.11111111100E-8"); mpfr_set_prec (x, 2); mpfr_set (x, y, GMP_RNDN); mpfr_set_str_raw (y, "1.0E-8"); if (mpfr_cmp (x, y)) { fprintf (stderr, "Error for y=0.11111111100E-8, prec=2, rnd=GMP_RNDN\n"); exit (1); } for (p=2; p<500; p++) { mpfr_set_prec (x, p); mpfr_random (x); if (LONG_RAND () % 2) mpfr_neg (x, x, GMP_RNDN); for (q=2; q<2*p; q++) { mpfr_set_prec (y, q); for (rnd=0; rnd<4; rnd++) { inexact = mpfr_set (y, x, rnd); cmp = mpfr_cmp (y, x); if (((inexact == 0) && (cmp != 0)) || ((inexact > 0) && (cmp <= 0)) || ((inexact < 0) && (cmp >= 0))) { fprintf (stderr, "Wrong inexact flag in mpfr_set: expected %d, got %d\n", cmp, inexact); exit (1); } } } } mpfr_clear (x); mpfr_clear (y); mpfr_clear (z); mpfr_clear (u); return 0; }
int mpfi_init_set_d (mpfi_ptr a, const double b) { int inexact_left, inexact_right, inexact = 0; inexact_left = mpfr_init_set_d (&(a->left), b, MPFI_RNDD); inexact_right = mpfr_init_set_d (&(a->right), b, MPFI_RNDU); if ( MPFI_NAN_P (a) ) MPFR_RET_NAN; if (b == 0.0) { /* fix signed zero so as to return [+0, -0] */ mpfr_setsign (&(a->left), &(a->left), 0, MPFI_RNDU); mpfr_setsign (&(a->right), &(a->right), 1, MPFI_RNDD); } if (inexact_left) inexact += 1; if (inexact_right) inexact += 2; return inexact; }
void fft_init(size_t N, mpfr_prec_t prec) { if (prec) precision = prec; if (N) LEN = N; twid_fact = (Sequence) calloc(LEN, sizeof(mpc_t)); mpfr_init_set_d(ZERO, 0.0, MPFR_RNDA); mpfr_init2(tmp, precision); mpfr_const_pi(tmp, MPFR_RNDA); mpfr_mul_si(tmp, tmp, -2, MPFR_RNDA); mpfr_div_ui(tmp, tmp, N, MPFR_RNDA); mpc_init2(min2pii, precision); mpc_set_fr_fr(min2pii, ZERO, tmp, RND); mpc_init2(temp, precision); new_seq = (Sequence) calloc(N, sizeof(mpc_t)); size_t n = N / 2; while (n--) { mpc_init2(twid_fact + n, precision); mpc_mul_ui(twid_fact + n, min2pii, n, RND); mpc_exp(twid_fact + n, twid_fact + n, RND); } }
/// @brief Calculate A2 /// /// Calculate \f$a_2=e^{\Delta S}\f$ /// /// @param move The type of move /// @return \f$a_2=e^{-\Delta S}\f$ auto CalculateA2(const move_type move) const noexcept { auto currentS3Action = S3_bulk_action(N1_TL_, N3_31_13_, N3_22_, Alpha_, K_, Lambda_); auto newS3Action = static_cast<Gmpzf>(0); // auto newS3Action = static_cast<MP_Float>(0); switch (move) { case move_type::TWO_THREE: // A (2,3) move adds a timelike edge // and a (2,2) simplex newS3Action = S3_bulk_action(N1_TL_ + 1, N3_31_13_, N3_22_ + 1, Alpha_, K_, Lambda_); break; case move_type::THREE_TWO: // A (3,2) move removes a timelike edge // and a (2,2) simplex newS3Action = S3_bulk_action(N1_TL_ - 1, N3_31_13_, N3_22_ - 1, Alpha_, K_, Lambda_); break; case move_type::TWO_SIX: // A (2,6) move adds 2 timelike edges and // 2 (1,3) and 2 (3,1) simplices newS3Action = S3_bulk_action(N1_TL_ + 2, N3_31_13_ + 4, N3_22_, Alpha_, K_, Lambda_); break; case move_type::SIX_TWO: // A (6,2) move removes 2 timelike edges and // 2 (1,3) and 2 (3,1) simplices newS3Action = S3_bulk_action(N1_TL_ - 2, N3_31_13_, N3_22_ - 4, Alpha_, K_, Lambda_); break; case move_type::FOUR_FOUR: // A (4,4) move changes nothing with respect to the action, // and e^0==1 #ifndef NDEBUG std::cout << "A2 is 1\n"; #endif return static_cast<double>(1); } // auto exponent = newS3Action - currentS3Action; auto exponent = currentS3Action - newS3Action; auto exponent_double = Gmpzf_to_double(exponent); // if exponent > 0 then e^exponent >=1 so according to Metropolis // algorithm return A2=1 if (exponent >= 0) return static_cast<double>(1); // Set precision for initialization and assignment functions mpfr_set_default_prec(PRECISION); // Initialize for MPFR mpfr_t r1, a2; mpfr_inits2(PRECISION, r1, a2, nullptr); // Set input parameters and constants to mpfr_t equivalents mpfr_init_set_d(r1, exponent_double, MPFR_RNDD); // r1 = exponent // e^exponent mpfr_exp(a2, r1, MPFR_RNDD); // Convert mpfr_t total to Gmpzf result by using Gmpzf(double d) // Gmpzf result = Gmpzf(mpfr_get_d(a2, MPFR_RNDD)); auto result = mpfr_get_d(a2, MPFR_RNDD); // Free memory mpfr_clears(r1, a2, nullptr); #ifndef NDEBUG std::cout << "A2 is " << result << "\n"; #endif return result; } // CalculateA2()
int main (int argc, char *argv[]){ mpfr_t *lambda, *kappa; char f_out_name[BUFSIZ]; int d,iters,n, k, nk,nf,na,nb; double *lambdas, *kappas, *f,*a,*b; param_file_type param[Nparam] = {{"d:" , "%d", &d, NULL, sizeof(int)}, {"iter:" , "%d", &iters, NULL, sizeof(int)}, {"lambda:", "DATA_FILE", &lambdas, &n , sizeof(double)}, {"kappa:", "DATA_FILE", &kappas, &nk , sizeof(double)}, /*psi*/ {"h:", "DATA_FILE", &f, &nf , sizeof(double)}, /*odf*/ {"a:", "DATA_FILE", &a, &na , sizeof(double)}, /*pdf a*/ {"bc:", "DATA_FILE", &b, &nb , sizeof(double)}, /*pdf sqrt(b^2 + c^2)*/ {"res1:","%s ", &f_out_name,NULL, 0}}; FILE *f_param; FILE *f_out; if (argc<2) { printf("Error! Missing parameter - parameter_file.\n"); printf("%s\n",argv[0]); abort(); } /* read parameter file */ f_param = check_fopen(argv[1],"r"); if (read_param_file(f_param,param,Nparam,argc==2)<Nparam){ /*printf("Some parameters not found!");*/ /*abort();*/ } fclose(f_param); /* precission & delta */ init_prec(d); long int prec = d; if (nk>0) { /* kappas given*/ mpfr_t C; kappa = (mpfr_t*) malloc (nk*sizeof(mpfr_t)); for(k=0;k<nk;k++){ mpfr_init2(kappa[k],prec); mpfr_init_set_d(kappa[k], kappas[k],prec); } mhyper(C, kappa, nk); /* gmp_printf("C: %.*Fe \n ", 20, C); */ if (nf>0) /* eval odf values*/ { eval_exp_Ah(C,f,nf); f_out = check_fopen(f_out_name,"wb"); fwrite(f,sizeof(double),nf,f_out); fclose(f_out); } if ( na > 0) {/* eval pdf values*/ /* testing BesselI[0,a] mpfr_t in, out; for(k=0;k<na;k++){ mpfr_init2(in, prec); mpfr_set_d(in, a[k],prec); mpfr_init2(out, prec); mpfr_i0(out, in, prec); mpfr_printf ("%.1028RNf\ndd", out); a[k] = mpfr_get_d(out,prec); } f_out = check_fopen(f_out_name,"wb"); fwrite(a,sizeof(double),na,f_out); fclose(f_out); */ eval_exp_besseli(a,b,C,na); f_out = check_fopen(f_out_name,"wb"); fwrite(a,sizeof(double),na,f_out); fclose(f_out); } if (nf == 0 && na == 0) { /* only return constant */ double CC = mpfr_get_d(C,prec); f_out = check_fopen(f_out_name,"wb"); fwrite(&CC,sizeof(double),1,f_out); fclose(f_out); } } else { /* solve kappas */ /* copy input variables */ lambda = (mpfr_t*) malloc (n*sizeof(mpfr_t)); kappa = (mpfr_t*) malloc (n*sizeof(mpfr_t)); for(k=0;k<n;k++){ mpfr_init_set_ui(kappa[k],0,prec); mpfr_init_set_d(lambda[k],lambdas[k],prec); } if(iters>0){ /* check input */ mpfr_t tmp; mpfr_init(tmp); mpfr_set_d(tmp,0,prec); for(k=0;k<n;k++){ mpfr_add(tmp,tmp,lambda[k],prec); } mpfr_ui_sub(tmp,1,tmp,prec); mpfr_div_ui(tmp,tmp,n,prec); for(k=0;k<n;k++){ mpfr_add(lambda[k],lambda[k],tmp,prec); } mpfr_init2(tmp,prec); for(k=0;k<n;k++){ mpfr_add(tmp,tmp,lambda[k],prec); } mpfr_init2(tmp,prec); if( mpfr_cmp(lambda[min_N(lambda,n)],tmp) < 0 ){ printf("not well formed! sum should be exactly 1 and no lambda negativ"); exit(0); } /* solve the problem */ newton(iters,kappa, lambda, n); } else { guessinitial(kappa, lambda, n); } for(k=0;k<n;k++){ lambdas[k] = mpfr_get_d(kappa[k],GMP_RNDN); /* something wents wront in matlab for 473.66316276431799;*/ /* % bug: lambda= [0.97 0.01 0.001];*/ } f_out = check_fopen(f_out_name,"wb"); fwrite(lambdas,sizeof(double),n,f_out); fclose(f_out); free_N(lambda,n); free_N(kappa,n); } return EXIT_SUCCESS; }
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; }
int main (void) { mp_prec_t p, q; mpfr_t x, y, z, u; int rnd; int inexact, cmp; mp_exp_t emax; tests_start_mpfr (); /* check prototypes of mpfr_init_set_* */ inexact = mpfr_init_set_si (x, -1, GMP_RNDN); inexact = mpfr_init_set (y, x, GMP_RNDN); inexact = mpfr_init_set_ui (z, 1, GMP_RNDN); inexact = mpfr_init_set_d (u, 1.0, GMP_RNDN); mpfr_set_nan (x); (mpfr_set) (y, x, GMP_RNDN); MPFR_ASSERTN(mpfr_nan_p (y)); mpfr_set_inf (x, 1); mpfr_set (y, x, GMP_RNDN); MPFR_ASSERTN(mpfr_inf_p (y) && mpfr_sgn (y) > 0); mpfr_set_inf (x, -1); mpfr_set (y, x, GMP_RNDN); MPFR_ASSERTN(mpfr_inf_p (y) && mpfr_sgn (y) < 0); mpfr_set_ui (x, 0, GMP_RNDN); mpfr_set (y, x, GMP_RNDN); MPFR_ASSERTN(mpfr_cmp_ui (y, 0) == 0 && MPFR_IS_POS(y)); mpfr_set_ui (x, 0, GMP_RNDN); mpfr_neg (x, x, GMP_RNDN); mpfr_set (y, x, GMP_RNDN); MPFR_ASSERTN(mpfr_cmp_ui (y, 0) == 0 && MPFR_IS_NEG(y)); emax = mpfr_get_emax (); set_emax (0); mpfr_set_prec (x, 3); mpfr_set_str_binary (x, "0.111"); mpfr_set_prec (y, 2); mpfr_set (y, x, GMP_RNDU); if (!(MPFR_IS_INF (y) && MPFR_SIGN (y) > 0)) { printf ("Error for y=x=0.111 with px=3, py=2 and emax=0\nx="); mpfr_dump (x); printf ("y="); mpfr_dump (y); exit (1); } MPFR_ASSERTN (MPFR_IS_INF (y) && MPFR_SIGN (y) > 0); set_emax (emax); mpfr_set_prec (y, 11); mpfr_set_str_binary (y, "0.11111111100E-8"); mpfr_set_prec (x, 2); mpfr_set (x, y, GMP_RNDN); mpfr_set_str_binary (y, "1.0E-8"); if (mpfr_cmp (x, y)) { printf ("Error for y=0.11111111100E-8, prec=2, rnd=GMP_RNDN\n"); exit (1); } for (p=2; p<500; p++) { mpfr_set_prec (x, p); mpfr_random (x); if (randlimb () % 2) mpfr_neg (x, x, GMP_RNDN); for (q=2; q<2*p; q++) { mpfr_set_prec (y, q); for (rnd = 0; rnd < GMP_RND_MAX; rnd++) { inexact = mpfr_set (y, x, (mp_rnd_t) rnd); cmp = mpfr_cmp (y, x); if (((inexact == 0) && (cmp != 0)) || ((inexact > 0) && (cmp <= 0)) || ((inexact < 0) && (cmp >= 0))) { printf ("Wrong inexact flag in mpfr_set: expected %d," " got %d\n", cmp, inexact); exit (1); } } } } mpfr_clear (x); mpfr_clear (y); mpfr_clear (z); mpfr_clear (u); check_neg_special (); tests_end_mpfr (); return 0; }