/**************************************************************************/
/*                                                                        */
/*                                 Sources                                */
/*                                from  the                               */
/*                           XSC SOFTWARE PACKAGE                         */
/*                                                                        */
/*                Copyright (c) 1997 University of Karlsruhe              */
/*                     Institute for Appl. Mathematics                    */
/*                                                                        */
/* This program is free software for non-commercial use. For details, see */
/* the file LICENSE.XSC, distributed with this software package.          */
/*                                                                        */
/* This program is distributed WITHOUT ANY WARRANTY. For details, see the */
/* file LICENSE.XSC, distributed with this software package.              */
/*                                                                        */
/**************************************************************************/

/* RCS $Id: t_chk1.c,v 1.2 1997/09/25 18:07:58 ae59 Exp $ */
/*
$Log: t_chk1.c,v $
 * Revision 1.2  1997/09/25  18:07:58  ae59
 * Copyright-message
 *
 * Revision 1.1  1994/01/27  13:25:04  ae59
 * Put under RCS control
 *
 */
/*      Date    : 1991-09-06                                    */
/*      1991-09-06 : reduce maximum line length                 */

#ifdef AIX
#include "/u/p88c/runtime/tbyte/t_defs.h"
#else
#include "t_defs.h"
#endif

#define ReturnErr(A)    \
   if (NoErr!=(exc=A)) return exc

/*--------------------------------------------------------------*
 | Pruefe Argument                                              |
 *--------------------------------------------------------------*/
#ifdef ANSI_C
#ifdef LINT_ARGS
int chk_1(int fct, const ExtReal *arg)
#else
int chk_1(fct, arg)
int fct;                /* FunktionsNummer */
const ExtReal *arg;
#endif /* LINT_ARGS */
#else  /* NOT ANSI_C */
#ifdef LINT_ARGS
int chk_1(int fct, ExtReal *arg)
#else
int chk_1(fct, arg)
int fct;                /* FunktionsNummer */
ExtReal *arg;
#endif /* LINT_ARGS */
#endif /* ANSI_C */
{
   int         exc;

   /* --- ArgumentPruefung nach Funktionen --- */
   switch(fct) {
   case Sin  :
   case Cos  :
   case Tan  :
   case Cot  :
   case ISin :
   case ICos :
   case ITan :
   case ICot :
      ReturnErr (chk_extreal(arg, DBExtReal));
/* |arg|>2**127*/
      ReturnErr ((1==(cmpabsee(arg, &TwoPow127))?TLOSS:NoErr));
/* |arg|>2**63 */
      ReturnErr ((1==(cmpabsee(arg, &TwoPow63 ))?PLOSS:NoErr));
         return NoErr;
   case Asin :
   case Acos :
   case IAsin:
   case IAcos:
      ReturnErr (chk_extreal(arg, DBExtReal));
      ReturnErr ((1==(cmpabsee(arg, &One))?DOMAIN:NoErr));/* |arg|>1*/
         return NoErr;
   case Atan :
   case Acot :
   case IAtan:
   case IAcot:
      ReturnErr (chk_extreal(arg, DBExtReal));
         return NoErr;

   case Sqrt :
   case ISqrt:
      ReturnErr (chk_extreal(arg, DBPos0ExtReal));
         return NoErr;
   case Sqrtm1:
      ReturnErr (chk_extreal(arg, DBPos0ExtReal));
      ReturnErr ((-1!=(cmpee(arg, &MaxArgSqrtm1))?DOMAIN:NoErr));
         return NoErr;
   case Sinh :
   case Cosh :
   case ISinh:
   case ICosh:
      ReturnErr (chk_extreal(arg, DBExtReal));
      ReturnErr ((1==(cmpee(arg, &MaxArgHyp))?OVER_FLOW:NoErr));
      ReturnErr ((-1==(cmpee(arg, &MinArgHyp))?OVER_FLOW:NoErr));
         return NoErr;
   case Exp  :
      ReturnErr (chk_extreal(arg, DBExtReal));
      ReturnErr ((1==(cmpee(arg, &MaxArgExp))?OVER_FLOW:NoErr));
      ReturnErr ((-1==(cmpee(arg, &MinArgExp))?UNDER_FLOW:NoErr));
         return NoErr;
   case IExp :
      ReturnErr (chk_extreal(arg, DBExtReal));
      ReturnErr ((1==(cmpee(arg, &MaxArgExp))?OVER_FLOW:NoErr));
         return NoErr;
   case Coth :
   case ICoth:
      ReturnErr (chk_extreal(arg, DBPosExtReal|DBNegExtReal));
         return NoErr;
   case Tanh :
   case ITanh:
      ReturnErr (chk_extreal(arg, DBExtReal));
         return NoErr;
   case Expm1:
      ReturnErr (chk_extreal(arg, DBExtReal));
      ReturnErr ((1==(cmpee(arg, &Ln2))?DOMAIN:NoErr));
         return NoErr;           /* Underflow unmoeglich        */

   case Ln   :
   case ILn  :
      ReturnErr (chk_extreal(arg, DBPosExtReal));
         return NoErr;
   case Lnp1 :
      ReturnErr (chk_extreal(arg, DBExtReal));
      ReturnErr ((-1!=(cmpabsee(arg, &MaxArgLnp1))?DOMAIN:NoErr));
         return NoErr;
   case Asinh:
   case IAsinh:
      ReturnErr (chk_extreal(arg, DBExtReal));
         return NoErr;
   case Acosh:
   case IAcosh:
      ReturnErr (chk_extreal(arg, DBPosExtReal));
      ReturnErr ((-1==(cmpabsee(arg, &One))?DOMAIN:NoErr));/* |arg|<1*/
         return NoErr;
   case Atanh:
   case IAtanh:
      ReturnErr (chk_extreal(arg, DBExtReal));
      ReturnErr ((-1!=(cmpabsee(arg, &One))?DOMAIN:NoErr));/* |arg|>=1*/
         return NoErr;
   case Acoth:
   case IAcoth:
      ReturnErr (chk_extreal(arg, DBExtReal));
      ReturnErr ((1!=(cmpabsee(arg, &One))?DOMAIN:NoErr));/* |arg|<=1*/
         return NoErr;

   case Pow:
   case IPow:
      ReturnErr (chk_extreal(arg, DBExtReal));
         return NoErr;

   case Div:                    /* 010291 cb */
   case IDiv:
      ReturnErr (chk_extreal(arg, DBExtReal));
         return NoErr;

   /* ------------------------------------------------------------- */
   case EToI :
      ReturnErr (chk_extreal(arg, DBExtReal));
/* |arg|>INT_MAX */
      ReturnErr ((1==(cmpabsee(arg, &IntMax))?OVER_FLOW:NoErr));
         return NoErr;

   case EToL :
      ReturnErr (chk_extreal(arg, DBExtReal));
/* |arg|>DBL_MAX */
      ReturnErr (1==cmpabsee(arg, &LongRealMax)?OVER_FLOW:NoErr);
         return NoErr;

   default: fprintf(MsgOut, "Fehler ArgumentCheck!\n");
         return ExcUnknown;
   } /* switch(fct) */

} /* chk_1() */
