/* RCS $Id: j_sqr.c,v 1.2 1997/07/15 14:57:04 ae13 Exp $ */
/*
$Log: j_sqr.c,v $
 * Revision 1.2  1997/07/15  14:57:04  ae13
 * *** empty log message ***
 *
 * Revision 1.1  1997/05/16  13:26:20  ae13
 * Initial revision
 *
 */
/****************************************************************/
/*                                                              */
/*      Entries         : a_intv j_sqr(a_intv x)                */
/*                        a_intv x  ;                           */
/*                                                              */
/*      Arguments       : x = interval argument of sqr(x)       */
/*                                                              */
/*      Description     : Fast interval square function         */
/*                        for double IEEE Floating-Point        */
/*                        Arithmetic                            */
/*                                                              */
/*      Date            : 1997-03-10                            */
/*                                                              */
/*      Author          : W. Hofschuster                        */
/*                                                              */
/****************************************************************/

#ifndef ALL_IN_ONE
#ifdef AIX
#include "/u/p88c/runtime/o_defs.h"
#else
#include "o_defs.h"
#endif
#define local
#endif

#include "q_defs.h"
#include "q_fcth.h"

#ifdef LINT_ARGS
local a_intv j_sqr(a_intv x)
#else
local a_intv j_sqr(x)

a_intv x;
#endif
{
  a_intv res;

#ifdef PXSCTRAP
 E_SPUSH("j_sqr");
#endif
  if (x.INF==x.SUP)                       /* point interval */
    { 
      if (x.INF==0)
        res.INF=res.SUP=0;
      else { res.INF=q_sqr(x.INF); 
             res.SUP=r_succ(res.INF);
             res.INF=r_pred(res.INF);
           }
    }
  else
    {
      if NANTEST(x.INF)                     /* Test: x.inf=NaN */
        res.INF=q_abortnan(INV_ARG,&x.INF,1);
      else if NANTEST(x.SUP)                /* Test: x.sup=NaN */
        res.SUP=q_abortnan(INV_ARG,&x.SUP,1);
      else {
        if ((x.INF<-q_sqra)||(x.SUP>q_sqra))
          res=q_abortr2(OVER_FLOW,&x.INF,&x.SUP,1);
        else if (x.INF==0) 
          { res.INF=0; res.SUP=r_succ(x.SUP*x.SUP); }
        else if (x.INF>0)
          { res.INF=r_pred(x.INF*x.INF); res.SUP=r_succ(x.SUP*x.SUP); }
        else if (x.SUP==0)
          { res.INF=0; res.SUP=r_succ(x.INF*x.INF); }
        else if (x.SUP<0)
          { res.INF=r_pred(x.SUP*x.SUP); res.SUP=r_succ(x.INF*x.INF); }
        else 
          { res.INF=0;
            if (-x.INF>x.SUP) res.SUP=r_succ(x.INF*x.INF);
            else              res.SUP=r_succ(x.SUP*x.SUP);          
          }
      } 

    }   
#ifdef PXSCTRAP
  E_SPOPP("j_sqr");
#endif
  return(res);
}

