コード例 #1
0
ファイル: div.c プロジェクト: BrianGladman/MPC
int
mpc_div (mpc_ptr a, mpc_srcptr b, mpc_srcptr c, mpc_rnd_t rnd)
{
   int ok_re = 0, ok_im = 0;
   mpc_t res, c_conj;
   mpfr_t q;
   mpfr_prec_t prec;
   int inex, inexact_prod, inexact_norm, inexact_re, inexact_im, loops = 0;
   int underflow_norm, overflow_norm, underflow_prod, overflow_prod;
   int underflow_re = 0, overflow_re = 0, underflow_im = 0, overflow_im = 0;
   mpfr_rnd_t rnd_re = MPC_RND_RE (rnd), rnd_im = MPC_RND_IM (rnd);
   int saved_underflow, saved_overflow;
   int tmpsgn;
   mpfr_exp_t e, emin, emax, emid; /* for scaling of exponents */
   mpc_t b_scaled, c_scaled;
   mpfr_t b_re, b_im, c_re, c_im;

   /* According to the C standard G.3, there are three types of numbers:   */
   /* finite (both parts are usual real numbers; contains 0), infinite     */
   /* (at least one part is a real infinity) and all others; the latter    */
   /* are numbers containing a nan, but no infinity, and could reasonably  */
   /* be called nan.                                                       */
   /* By G.5.1.4, infinite/finite=infinite; finite/infinite=0;             */
   /* all other divisions that are not finite/finite return nan+i*nan.     */
   /* Division by 0 could be handled by the following case of division by  */
   /* a real; we handle it separately instead.                             */
   if (mpc_zero_p (c)) /* both Re(c) and Im(c) are zero */
      return mpc_div_zero (a, b, c, rnd);
   else if (mpc_inf_p (b) && mpc_fin_p (c)) /* either Re(b) or Im(b) is infinite
                                               and both Re(c) and Im(c) are ordinary */
         return mpc_div_inf_fin (a, b, c);
   else if (mpc_fin_p (b) && mpc_inf_p (c))
         return mpc_div_fin_inf (a, b, c);
   else if (!mpc_fin_p (b) || !mpc_fin_p (c)) {
      mpc_set_nan (a);
      return MPC_INEX (0, 0);
   }
   else if (mpfr_zero_p(mpc_imagref(c)))
      return mpc_div_real (a, b, c, rnd);
   else if (mpfr_zero_p(mpc_realref(c)))
      return mpc_div_imag (a, b, c, rnd);

   prec = MPC_MAX_PREC(a);

   mpc_init2 (res, 2);
   mpfr_init (q);

   /* compute scaling of exponents: none of Re(c) and Im(c) can be zero,
      but one of Re(b) or Im(b) could be zero */

   e = mpfr_get_exp (mpc_realref (c));
   emin = emax = e;
   e = mpfr_get_exp (mpc_imagref (c));
   if (e > emax)
     emax = e;
   else if (e < emin)
     emin = e;
   if (!mpfr_zero_p (mpc_realref (b)))
     {
       e = mpfr_get_exp (mpc_realref (b));
       if (e > emax)
         emax = e;
       else if (e < emin)
         emin = e;
     }
   if (!mpfr_zero_p (mpc_imagref (b)))
     {
       e = mpfr_get_exp (mpc_imagref (b));
       if (e > emax)
         emax = e;
       else if (e < emin)
         emin = e;
     }

   /* all input exponents are in [emin, emax] */
   emid = emin / 2 + emax / 2;

   /* scale the inputs */
   b_re[0] = mpc_realref (b)[0];
   if (!mpfr_zero_p (mpc_realref (b)))
     MPFR_EXP(b_re) = MPFR_EXP(mpc_realref (b)) - emid;
   b_im[0] = mpc_imagref (b)[0];
   if (!mpfr_zero_p (mpc_imagref (b)))
     MPFR_EXP(b_im) = MPFR_EXP(mpc_imagref (b)) - emid;
   c_re[0] = mpc_realref (c)[0];
   MPFR_EXP(c_re) = MPFR_EXP(mpc_realref (c)) - emid;
   c_im[0] = mpc_imagref (c)[0];
   MPFR_EXP(c_im) = MPFR_EXP(mpc_imagref (c)) - emid;

   /* create the scaled inputs without allocating new memory */
   mpc_realref (b_scaled)[0] = b_re[0];
   mpc_imagref (b_scaled)[0] = b_im[0];
   mpc_realref (c_scaled)[0] = c_re[0];
   mpc_imagref (c_scaled)[0] = c_im[0];

   /* create the conjugate of c in c_conj without allocating new memory */
   mpc_realref (c_conj)[0] = mpc_realref (c_scaled)[0];
   mpc_imagref (c_conj)[0] = mpc_imagref (c_scaled)[0];
   MPFR_CHANGE_SIGN (mpc_imagref (c_conj));

   /* save the underflow or overflow flags from MPFR */
   saved_underflow = mpfr_underflow_p ();
   saved_overflow = mpfr_overflow_p ();

   do {
      loops ++;
      prec += loops <= 2 ? mpc_ceil_log2 (prec) + 5 : prec / 2;

      mpc_set_prec (res, prec);
      mpfr_set_prec (q, prec);

      /* first compute norm(c_scaled) */
      mpfr_clear_underflow ();
      mpfr_clear_overflow ();
      inexact_norm = mpc_norm (q, c_scaled, MPFR_RNDU);
      underflow_norm = mpfr_underflow_p ();
      overflow_norm = mpfr_overflow_p ();
      if (underflow_norm)
         mpfr_set_ui (q, 0ul, MPFR_RNDN);
         /* to obtain divisions by 0 later on */

      /* now compute b_scaled*conjugate(c_scaled) */
      mpfr_clear_underflow ();
      mpfr_clear_overflow ();
      inexact_prod = mpc_mul (res, b_scaled, c_conj, MPC_RNDZZ);
      inexact_re = MPC_INEX_RE (inexact_prod);
      inexact_im = MPC_INEX_IM (inexact_prod);
      underflow_prod = mpfr_underflow_p ();
      overflow_prod = mpfr_overflow_p ();
         /* unfortunately, does not distinguish between under-/overflow
            in real or imaginary parts
            hopefully, the side-effects of mpc_mul do indeed raise the
            mpfr exceptions */
      if (overflow_prod) {
        /* FIXME: in case overflow_norm is also true, the code below is wrong,
           since the after division by the norm, we might end up with finite
           real and/or imaginary parts. A workaround would be to scale the
           inputs (in case the exponents are within the same range). */
         int isinf = 0;
         /* determine if the real part of res is the maximum or the minimum
            representable number */
         tmpsgn = mpfr_sgn (mpc_realref(res));
         if (tmpsgn > 0)
           {
             mpfr_nextabove (mpc_realref(res));
             isinf = mpfr_inf_p (mpc_realref(res));
             mpfr_nextbelow (mpc_realref(res));
           }
         else if (tmpsgn < 0)
           {
             mpfr_nextbelow (mpc_realref(res));
             isinf = mpfr_inf_p (mpc_realref(res));
             mpfr_nextabove (mpc_realref(res));
           }
         if (isinf)
           {
             mpfr_set_inf (mpc_realref(res), tmpsgn);
             overflow_re = 1;
           }
         /* same for the imaginary part */
         tmpsgn = mpfr_sgn (mpc_imagref(res));
         isinf = 0;
         if (tmpsgn > 0)
           {
             mpfr_nextabove (mpc_imagref(res));
             isinf = mpfr_inf_p (mpc_imagref(res));
             mpfr_nextbelow (mpc_imagref(res));
           }
         else if (tmpsgn < 0)
           {
             mpfr_nextbelow (mpc_imagref(res));
             isinf = mpfr_inf_p (mpc_imagref(res));
             mpfr_nextabove (mpc_imagref(res));
           }
         if (isinf)
           {
             mpfr_set_inf (mpc_imagref(res), tmpsgn);
             overflow_im = 1;
           }
         mpc_set (a, res, rnd);
         goto end;
      }

      /* divide the product by the norm */
      if (inexact_norm == 0 && (inexact_re == 0 || inexact_im == 0)) {
         /* The division has good chances to be exact in at least one part.  */
         /* Since this can cause problems when not rounding to the nearest,  */
         /* we use the division code of mpfr, which handles the situation.   */
         mpfr_clear_underflow ();
         mpfr_clear_overflow ();
         inexact_re |= mpfr_div (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ);
         underflow_re = mpfr_underflow_p ();
         overflow_re = mpfr_overflow_p ();
         ok_re = !inexact_re || underflow_re || overflow_re
                 || mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN,
                    MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN));

         if (ok_re) /* compute imaginary part */ {
            mpfr_clear_underflow ();
            mpfr_clear_overflow ();
            inexact_im |= mpfr_div (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ);
            underflow_im = mpfr_underflow_p ();
            overflow_im = mpfr_overflow_p ();
            ok_im = !inexact_im || underflow_im || overflow_im
                    || mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN,
                       MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN));
         }
      }
      else {
         /* The division is inexact, so for efficiency reasons we invert q */
         /* only once and multiply by the inverse. */
         if (mpfr_ui_div (q, 1ul, q, MPFR_RNDZ) || inexact_norm) {
             /* if 1/q is inexact, the approximations of the real and
                imaginary part below will be inexact, unless RE(res)
                or IM(res) is zero */
             inexact_re |= !mpfr_zero_p (mpc_realref (res));
             inexact_im |= !mpfr_zero_p (mpc_imagref (res));
         }
         mpfr_clear_underflow ();
         mpfr_clear_overflow ();
         inexact_re |= mpfr_mul (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ);
         underflow_re = mpfr_underflow_p ();
         overflow_re = mpfr_overflow_p ();
         ok_re = !inexact_re || underflow_re || overflow_re
                 || mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN,
                    MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN));

         if (ok_re) /* compute imaginary part */ {
            mpfr_clear_underflow ();
            mpfr_clear_overflow ();
            inexact_im |= mpfr_mul (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ);
            underflow_im = mpfr_underflow_p ();
            overflow_im = mpfr_overflow_p ();
            ok_im = !inexact_im || underflow_im || overflow_im
                    || mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN,
                       MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN));
         }
      }
   } while ((!ok_re || !ok_im) && !underflow_norm && !overflow_norm
                               && !underflow_prod && !overflow_prod);

   inex = mpc_set (a, res, rnd);
   inexact_re = MPC_INEX_RE (inex);
   inexact_im = MPC_INEX_IM (inex);

 end:
   /* fix values and inexact flags in case of overflow/underflow */
   /* FIXME: heuristic, certainly does not cover all cases */
   if (overflow_re || (underflow_norm && !underflow_prod)) {
      mpfr_set_inf (mpc_realref (a), mpfr_sgn (mpc_realref (res)));
      inexact_re = mpfr_sgn (mpc_realref (res));
   }
   else if (underflow_re || (overflow_norm && !overflow_prod)) {
      inexact_re = mpfr_signbit (mpc_realref (res)) ? 1 : -1;
      mpfr_set_zero (mpc_realref (a), -inexact_re);
   }
   if (overflow_im || (underflow_norm && !underflow_prod)) {
      mpfr_set_inf (mpc_imagref (a), mpfr_sgn (mpc_imagref (res)));
      inexact_im = mpfr_sgn (mpc_imagref (res));
   }
   else if (underflow_im || (overflow_norm && !overflow_prod)) {
      inexact_im = mpfr_signbit (mpc_imagref (res)) ? 1 : -1;
      mpfr_set_zero (mpc_imagref (a), -inexact_im);
   }

   mpc_clear (res);
   mpfr_clear (q);

   /* restore underflow and overflow flags from MPFR */
   if (saved_underflow)
     mpfr_set_underflow ();
   if (saved_overflow)
     mpfr_set_overflow ();

   return MPC_INEX (inexact_re, inexact_im);
}
コード例 #2
0
static void
check_set (void)
{
  long int lo;
  mpz_t mpz;
  mpq_t mpq;
  mpf_t mpf;
  mpfr_t fr;
  mpc_t x, z;
  mpfr_prec_t prec;

  mpz_init (mpz);
  mpq_init (mpq);
  mpf_init2 (mpf, 1000);
  mpfr_init2 (fr, 1000);
  mpc_init2 (x, 1000);
  mpc_init2 (z, 1000);

  mpz_set_ui (mpz, 0x4217);
  mpq_set_si (mpq, -1, 0x4321);
  mpf_set_q (mpf, mpq);

  for (prec = 2; prec <= 1000; prec++)
    {
      unsigned long int u = (unsigned long int) prec;

      mpc_set_prec (z, prec);
      mpfr_set_prec (fr, prec);

      lo = -prec;

      mpfr_set_d (fr, 1.23456789, GMP_RNDN);

      mpc_set_d (z, 1.23456789, MPC_RNDNN);
      if (mpfr_cmp (MPC_RE(z), fr) != 0 || mpfr_cmp_si (MPC_IM(z), 0) != 0)
        PRINT_ERROR ("mpc_set_d", prec, z);

#if defined _MPC_H_HAVE_COMPLEX
      mpc_set_dc (z, I*1.23456789+1.23456789, MPC_RNDNN);
      if (mpfr_cmp (MPC_RE(z), fr) != 0 || mpfr_cmp (MPC_IM(z), fr) != 0)
        PRINT_ERROR ("mpc_set_c", prec, z);
#endif

      mpc_set_ui (z, u, MPC_RNDNN);
      if (mpfr_cmp_ui (MPC_RE(z), u) != 0
          || mpfr_cmp_ui (MPC_IM(z), 0) != 0)
        PRINT_ERROR ("mpc_set_ui", prec, z);

      mpc_set_d_d (z, 1.23456789, 1.23456789, MPC_RNDNN);
      if (mpfr_cmp (MPC_RE(z), fr) != 0 || mpfr_cmp (MPC_IM(z), fr) != 0)
        PRINT_ERROR ("mpc_set_d_d", prec, z);

      mpc_set_si (z, lo, MPC_RNDNN);
      if (mpfr_cmp_si (MPC_RE(z), lo) != 0 || mpfr_cmp_ui (MPC_IM(z), 0) != 0)
        PRINT_ERROR ("mpc_set_si", prec, z);

      mpfr_set_ld (fr, 1.23456789L, GMP_RNDN);

      mpc_set_ld_ld (z, 1.23456789L, 1.23456789L, MPC_RNDNN);
      if (mpfr_cmp (MPC_RE(z), fr) != 0 || mpfr_cmp (MPC_IM(z), fr) != 0)
        PRINT_ERROR ("mpc_set_ld_ld", prec, z);

#if defined _MPC_H_HAVE_COMPLEX
      mpc_set_ldc (z, I*1.23456789L+1.23456789L, MPC_RNDNN);
      if (mpfr_cmp (MPC_RE(z), fr) != 0 || mpfr_cmp (MPC_IM(z), fr) != 0)
        PRINT_ERROR ("mpc_set_lc", prec, z);
#endif
      mpc_set_ui_ui (z, u, u, MPC_RNDNN);
      if (mpfr_cmp_ui (MPC_RE(z), u) != 0
          || mpfr_cmp_ui (MPC_IM(z), u) != 0)
        PRINT_ERROR ("mpc_set_ui_ui", prec, z);

      mpc_set_ld (z, 1.23456789L, MPC_RNDNN);
      mpfr_clear_flags ();
      if (mpfr_cmp (MPC_RE(z), fr) != 0
          || mpfr_cmp_ui (MPC_IM(z), 0) != 0
          || mpfr_erangeflag_p())
        PRINT_ERROR ("mpc_set_ld", prec, z);

      mpc_set_prec (x, prec);
      mpfr_set_ui(fr, 1, GMP_RNDN);
      mpfr_div_ui(fr, fr, 3, GMP_RNDN);
      mpfr_set(MPC_RE(x), fr, GMP_RNDN);
      mpfr_set(MPC_IM(x), fr, GMP_RNDN);

      mpc_set (z, x, MPC_RNDNN);
      mpfr_clear_flags (); /* mpc_cmp set erange flag when an operand is a
                              NaN */
      if (mpc_cmp (z, x) != 0 || mpfr_erangeflag_p())
        {
          printf ("Error in mpc_set for prec = %lu\n",
                  (unsigned long int) prec);
          MPC_OUT(z);
          MPC_OUT(x);
          exit (1);
        }

      mpc_set_si_si (z, lo, lo, MPC_RNDNN);
      if (mpfr_cmp_si (MPC_RE(z), lo) != 0
          || mpfr_cmp_si (MPC_IM(z), lo) != 0)
        PRINT_ERROR ("mpc_set_si_si", prec, z);

      mpc_set_fr (z, fr, MPC_RNDNN);
      mpfr_clear_flags ();
      if (mpfr_cmp (MPC_RE(z), fr) != 0
          || mpfr_cmp_ui (MPC_IM(z), 0) != 0
          || mpfr_erangeflag_p())
        PRINT_ERROR ("mpc_set_fr", prec, z);

      mpfr_set_z (fr, mpz, GMP_RNDN);
      mpc_set_z_z (z, mpz, mpz, MPC_RNDNN);
      mpfr_clear_flags ();
      if (mpfr_cmp (MPC_RE(z), fr) != 0
          || mpfr_cmp (MPC_IM(z), fr) != 0
          || mpfr_erangeflag_p())
        PRINT_ERROR ("mpc_set_z_z", prec, z);

      mpc_set_fr_fr (z, fr, fr, MPC_RNDNN);
      mpfr_clear_flags ();
      if (mpfr_cmp (MPC_RE(z), fr) != 0
          || mpfr_cmp (MPC_IM(z), fr) != 0
          || mpfr_erangeflag_p())
        PRINT_ERROR ("mpc_set_fr_fr", prec, z);

      mpc_set_z (z, mpz, MPC_RNDNN);
      mpfr_clear_flags ();
      if (mpfr_cmp (MPC_RE(z), fr) != 0
          || mpfr_cmp_ui (MPC_IM(z), 0) != 0
          || mpfr_erangeflag_p())
        PRINT_ERROR ("mpc_set_z", prec, z);

      mpfr_set_q (fr, mpq, GMP_RNDN);
      mpc_set_q_q (z, mpq, mpq, MPC_RNDNN);
      mpfr_clear_flags ();
      if (mpfr_cmp (MPC_RE(z), fr) != 0
          || mpfr_cmp (MPC_IM(z), fr) != 0
          || mpfr_erangeflag_p())
        PRINT_ERROR ("mpc_set_q_q", prec, z);

      mpc_set_ui_fr (z, u, fr, MPC_RNDNN);
      mpfr_clear_flags ();
      if (mpfr_cmp_ui (MPC_RE (z), u) != 0
          || mpfr_cmp (MPC_IM (z), fr) != 0
          || mpfr_erangeflag_p ())
        PRINT_ERROR ("mpc_set_ui_fr", prec, z);

      mpc_set_fr_ui (z, fr, u, MPC_RNDNN);
      mpfr_clear_flags ();
      if (mpfr_cmp (MPC_RE (z), fr) != 0
          || mpfr_cmp_ui (MPC_IM (z), u) != 0
          || mpfr_erangeflag_p())
        PRINT_ERROR ("mpc_set_fr_ui", prec, z);

      mpc_set_q (z, mpq, MPC_RNDNN);
      mpfr_clear_flags ();
      if (mpfr_cmp (MPC_RE(z), fr) != 0
          || mpfr_cmp_ui (MPC_IM(z), 0) != 0
          || mpfr_erangeflag_p())
        PRINT_ERROR ("mpc_set_q", prec, z);

      mpfr_set_f (fr, mpf, GMP_RNDN);
      mpc_set_f_f (z, mpf, mpf, MPC_RNDNN);
      mpfr_clear_flags ();
      if (mpfr_cmp (MPC_RE(z), fr) != 0
          || mpfr_cmp (MPC_IM(z), fr) != 0
          || mpfr_erangeflag_p())
        PRINT_ERROR ("mpc_set_f_f", prec, z);

      mpc_set_f (z, mpf, MPC_RNDNN);
      mpfr_clear_flags ();
      if (mpfr_cmp (MPC_RE(z), fr) != 0
          || mpfr_cmp_ui (MPC_IM(z), 0) != 0
          || mpfr_erangeflag_p())
        PRINT_ERROR ("mpc_set_f", prec, z);

      mpc_set_f_si (z, mpf, lo, MPC_RNDNN);
      mpfr_clear_flags ();
      if (mpfr_cmp (MPC_RE (z), fr) != 0
          || mpfr_cmp_si (MPC_IM (z), lo) != 0
          || mpfr_erangeflag_p ())
        PRINT_ERROR ("mpc_set_f", prec, z);

      mpc_set_nan (z);
      if (!mpfr_nan_p (MPC_RE(z)) || !mpfr_nan_p (MPC_IM(z)))
        PRINT_ERROR ("mpc_set_nan", prec, z);

#ifdef _MPC_H_HAVE_INTMAX_T
      {
        uintmax_t uim = (uintmax_t) prec;
        intmax_t im = (intmax_t) prec;

        mpc_set_uj (z, uim, MPC_RNDNN);
        if (mpfr_cmp_ui (MPC_RE(z), u) != 0
            || mpfr_cmp_ui (MPC_IM(z), 0) != 0)
          PRINT_ERROR ("mpc_set_uj", prec, z);

        mpc_set_sj (z, im, MPC_RNDNN);
        if (mpfr_cmp_ui (MPC_RE(z), u) != 0
            || mpfr_cmp_ui (MPC_IM(z), 0) != 0)
          PRINT_ERROR ("mpc_set_sj (1)", prec, z);

        mpc_set_uj_uj (z, uim, uim, MPC_RNDNN);
        if (mpfr_cmp_ui (MPC_RE(z), u) != 0
            || mpfr_cmp_ui (MPC_IM(z), u) != 0)
          PRINT_ERROR ("mpc_set_uj_uj", prec, z);

        mpc_set_sj_sj (z, im, im, MPC_RNDNN);
        if (mpfr_cmp_ui (MPC_RE(z), u) != 0
            || mpfr_cmp_ui (MPC_IM(z), u) != 0)
          PRINT_ERROR ("mpc_set_sj_sj (1)", prec, z);

        im = LONG_MAX;
        if (sizeof (intmax_t) == 2 * sizeof (unsigned long))
          im = 2 * im * im + 4 * im + 1; /* gives 2^(2n-1)-1 from 2^(n-1)-1 */

        mpc_set_sj (z, im, MPC_RNDNN);
        if (mpfr_get_sj (MPC_RE(z), GMP_RNDN) != im ||
            mpfr_cmp_ui (MPC_IM(z), 0) != 0)
          PRINT_ERROR ("mpc_set_sj (2)", im, z);

        mpc_set_sj_sj (z, im, im, MPC_RNDNN);
        if (mpfr_get_sj (MPC_RE(z), GMP_RNDN) != im ||
            mpfr_get_sj (MPC_IM(z), GMP_RNDN) != im)
          PRINT_ERROR ("mpc_set_sj_sj (2)", im, z);
      }
#endif /* _MPC_H_HAVE_INTMAX_T */

#if defined _MPC_H_HAVE_COMPLEX
      {
         double _Complex c = 1.0 - 2.0*I;
         long double _Complex lc = c;

         mpc_set_dc (z, c, MPC_RNDNN);
         if (mpc_get_dc (z, MPC_RNDNN) != c)
            PRINT_ERROR ("mpc_get_c", prec, z);
         mpc_set_ldc (z, lc, MPC_RNDNN);
         if (mpc_get_ldc (z, MPC_RNDNN) != lc)
            PRINT_ERROR ("mpc_get_lc", prec, z);
      }
#endif
    }

  mpz_clear (mpz);
  mpq_clear (mpq);
  mpf_clear (mpf);
  mpfr_clear (fr);
  mpc_clear (x);
  mpc_clear (z);
}