Blame mpc-0.9/src/norm.c

Packit Service 2e9770
/* mpc_norm -- Square of the norm of a complex number.
Packit Service 2e9770
Packit Service 2e9770
Copyright (C) INRIA, 2002, 2005, 2008, 2009, 2010
Packit Service 2e9770
Packit Service 2e9770
This file is part of the MPC Library.
Packit Service 2e9770
Packit Service 2e9770
The MPC Library is free software; you can redistribute it and/or modify
Packit Service 2e9770
it under the terms of the GNU Lesser General Public License as published by
Packit Service 2e9770
the Free Software Foundation; either version 2.1 of the License, or (at your
Packit Service 2e9770
option) any later version.
Packit Service 2e9770
Packit Service 2e9770
The MPC Library is distributed in the hope that it will be useful, but
Packit Service 2e9770
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
Packit Service 2e9770
or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
Packit Service 2e9770
License for more details.
Packit Service 2e9770
Packit Service 2e9770
You should have received a copy of the GNU Lesser General Public License
Packit Service 2e9770
along with the MPC Library; see the file COPYING.LIB.  If not, write to
Packit Service 2e9770
the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
Packit Service 2e9770
MA 02111-1307, USA. */
Packit Service 2e9770
Packit Service 2e9770
#include "mpc-impl.h"
Packit Service 2e9770
Packit Service 2e9770
/* the rounding mode is mpfr_rnd_t here since we return an mpfr number */
Packit Service 2e9770
int
Packit Service 2e9770
mpc_norm (mpfr_ptr a, mpc_srcptr b, mpfr_rnd_t rnd)
Packit Service 2e9770
{
Packit Service 2e9770
  mpfr_t u, v;
Packit Service 2e9770
  mpfr_prec_t prec;
Packit Service 2e9770
  int inexact, overflow, underflow;
Packit Service 2e9770
Packit Service 2e9770
  prec = mpfr_get_prec (a);
Packit Service 2e9770
Packit Service 2e9770
  /* handling of special values; consistent with abs in that
Packit Service 2e9770
     norm = abs^2; so norm (+-inf, nan) = norm (nan, +-inf) = +inf */
Packit Service 2e9770
  if (   (mpfr_nan_p (MPC_RE (b)) || mpfr_nan_p (MPC_IM (b)))
Packit Service 2e9770
      || (mpfr_inf_p (MPC_RE (b)) || mpfr_inf_p (MPC_IM (b))))
Packit Service 2e9770
      return mpc_abs (a, b, rnd);
Packit Service 2e9770
Packit Service 2e9770
  mpfr_init (u);
Packit Service 2e9770
  mpfr_init (v);
Packit Service 2e9770
Packit Service 2e9770
  if (!mpfr_zero_p(MPC_RE(b)) && !mpfr_zero_p(MPC_IM(b)) &&
Packit Service 2e9770
      2 * SAFE_ABS (mpfr_exp_t,
Packit Service 2e9770
                    mpfr_get_exp (MPC_RE (b)) - mpfr_get_exp (MPC_IM (b)))
Packit Service 2e9770
      > (mpfr_exp_t)prec)
Packit Service 2e9770
    /* If real and imaginary part have very different magnitudes, then the */
Packit Service 2e9770
    /* generic code increases the precision too much. Instead, compute the */
Packit Service 2e9770
    /* squarings _exactly_.                                                */
Packit Service 2e9770
  {
Packit Service 2e9770
     mpfr_set_prec (u, 2 * MPC_PREC_RE (b));
Packit Service 2e9770
     mpfr_set_prec (v, 2 * MPC_PREC_IM (b));
Packit Service 2e9770
     mpfr_sqr (u, MPC_RE (b), GMP_RNDN);
Packit Service 2e9770
     mpfr_sqr (v, MPC_IM (b), GMP_RNDN);
Packit Service 2e9770
     inexact = mpfr_add (a, u, v, rnd);
Packit Service 2e9770
  }
Packit Service 2e9770
  else if (mpfr_zero_p(MPC_RE(b)) && mpfr_zero_p(MPC_IM(b)))
Packit Service 2e9770
    {
Packit Service 2e9770
      inexact = mpfr_set_ui (a, 0, rnd);
Packit Service 2e9770
    }
Packit Service 2e9770
  else
Packit Service 2e9770
  {
Packit Service 2e9770
    do
Packit Service 2e9770
      {
Packit Service 2e9770
        prec += mpc_ceil_log2 (prec) + 3;
Packit Service 2e9770
Packit Service 2e9770
        mpfr_set_prec (u, prec);
Packit Service 2e9770
        mpfr_set_prec (v, prec);
Packit Service 2e9770
Packit Service 2e9770
        inexact = mpfr_sqr (u, MPC_RE(b), GMP_RNDN);  /* err<=1/2ulp */
Packit Service 2e9770
        inexact |= mpfr_sqr (v, MPC_IM(b), GMP_RNDN); /* err<=1/2ulp*/
Packit Service 2e9770
        inexact |= mpfr_add (u, u, v, GMP_RNDN);      /* err <= 3/2 ulps */
Packit Service 2e9770
Packit Service 2e9770
        overflow = mpfr_inf_p (u);
Packit Service 2e9770
        underflow = mpfr_zero_p (u);
Packit Service 2e9770
      }
Packit Service 2e9770
    while (!overflow && !underflow && inexact &&
Packit Service 2e9770
           mpfr_can_round (u, prec - 2, GMP_RNDN, rnd, mpfr_get_prec (a)) == 0);
Packit Service 2e9770
Packit Service 2e9770
    inexact |= mpfr_set (a, u, rnd);
Packit Service 2e9770
Packit Service 2e9770
    if (overflow)
Packit Service 2e9770
      inexact = 1;
Packit Service 2e9770
    if (underflow)
Packit Service 2e9770
      inexact = -1;
Packit Service 2e9770
  }
Packit Service 2e9770
  mpfr_clear (u);
Packit Service 2e9770
  mpfr_clear (v);
Packit Service 2e9770
Packit Service 2e9770
  return inexact;
Packit Service 2e9770
}