Quelle  tablat.c

/*
C----------------------------------------------------------------------
C  Subroutine to tabulate the results of tests for complex
C  functions.
C
C  Generic Fortran subprograms required:
C
C         ABS, AIMAG (or DIMAG), REAL (or DBLE)
C
C  Latest revision - October 11, 1990
C
C  Author - W. J. Cody
C           Argonne National Laboratory
C
C----------------------------------------------------------------------
C  Declare named common
C----------------------------------------------------------------------
*/

void
TABLAT ()
{
#ifdef TDOUBLE
  double complex CW;
  double ZZ;
#endif
#ifdef TSINGLE
  float complex CW;
  float ZZ;
#endif

  /*
C-----------------------------------------------------------------
C Handle vector error
C-----------------------------------------------------------------
*/
  if (CZ != CZERO)
    CW = (CZ - CZZ) / CZ;
  else
    CW = ONE;

  W = FABS (CW);
  if (W < ZERO)
    K1 = K1 + 1;
  else
    {
      if (W > ZERO)
 K3 = K3 + 1;
    }

  if (W > R6)
    {
      R6 = W;
      CX1 = CX;
      if (PFLAG)
 CY1 = CV;
      CF1 = CZ;
    }
  R7 = R7 + W * W;
  /*
C-----------------------------------------------------------------
C Handle error in real component
C-----------------------------------------------------------------
*/
  if (RFLAG)
    {
      Z = CONVR (CZ);
      ZZ = CONVR (CZZ);
      if (Z != ZERO)
 W = (Z - ZZ) / Z;
      else
 W = ONE;

      if (W < ZERO)
 KX1 = KX1 + 1;
      else
 {
   if (W > ZERO)
     KX3 = KX3 + 1;
 }
      W = ABS (W);
      if (W > RX6)
 {
   RX6 = W;
   CX2 = CX;
   if (PFLAG)
     CY2 = CV;
   CF2 = CZ;
 }
      RX7 = RX7 + W * W;
    }
  /*
C-----------------------------------------------------------------
C Handle error in imaginary component
C-----------------------------------------------------------------
*/
  if (IFLAG)
    {
      Z = CONVI (CZ);
      ZZ = CONVI (CZZ);
      if (Z != ZERO)
 W = (Z - ZZ) / Z;
      else
 W = ONE;

      if (W < ZERO)
 KY1 = KY1 + 1;
      else
 {
   if (W > ZERO)
     KY3 = KY3 + 1;
 }
      W = ABS (W);
      if (W > RY6)
 {
   RY6 = W;
   CX3 = CX;
   if (PFLAG)
     CY3 = CV;
   CF3 = CZ;
 }
      RY7 = RY7 + W * W;
    }
}

/*
C---------- Last line of TABLAT ----------
*/
/*
C----------------------------------------------------------------------
C  Subroutine to print the results of tests for complex functions.
C
C  Generic Fortran subprograms required:
C
C         ABS, LOG, MAX, SQRT
C
C  Latest revision - October 11, 1990
C
C  Author - W. J. Cody
C           Argonne National Laboratory
C
C----------------------------------------------------------------------
C  Declare named common
C----------------------------------------------------------------------
*/
/*
C----------------------------------------------------------------------
C  Declare local variables
C----------------------------------------------------------------------
*/
/*
C----------------------------------------------------------------------
C  Mathematical constants
C----------------------------------------------------------------------
*/
#ifdef TDOUBLE
extern double ALL9, ZERO;
#endif
#ifdef TSINGLE
extern float ALL9, ZERO;
#endif

/*
C----------------------------------------------------------------------
*/
void
REPORT (int IOUT)
{
  printf ("%7d random arguments were tested from the box\n", N);
  printf ("      (%15.4E,%15.4E)      (%15.4E,%15.4E)\n", AX, BX, AY, BY);
  /*
C-----------------------------------------------------------------
C Report vector error
C-----------------------------------------------------------------
*/
  printf (" First, report the vector error\n");
  K2 = N - K3 - K1;
  R7 = SQRT (R7 / XN);
  printf (" Test function was larger %6d times\n", K1);
  printf ("                   agreed %6d times, and\n", K2);
  printf ("              was smaller %6d times.\n", K3);

  printf (" There are %4d base %4d\n", IT, IBETA);
  printf (" significant digits in a floating-point number.\n");
  if (R6 != ZERO)
    W = LOG (ABS (R6)) / ALBETA;
  else
    W = ALL9;

  if (!PFLAG)
    {
      printf (" The maximum relative error of %15.4E = %4d ** %7.2f\n",
       R6, IBETA, W);
      printf ("    occurred for Z = (%17.6E,%17.6E)\n", creal (CX1), cimag (CX1));
      printf ("    with a value of (%17.6E,%17.6E\n", creal (CF1), cimag (CF1));
    }
  else
    {
      printf (" The maximum relative error of %15.4E = %4d ** %7.2f\n",
       R6, IBETA, W);
      printf (" occurred for Z = (%17.6E,%17.6E)\n", creal (CX1), cimag (CX1));
      printf ("             and W = (%17.6E,%17.6E)\n", creal (CY1), cimag (CY1));
      printf ("    with a value of (%17.6E,%17.6E)\n", creal (CF1), cimag (CF1));
    }
  W = MAX (AIT + W, ZERO);
  printf (" The estimated loss of base %4d\n", IBETA);
  printf (" significant digits is %7.2f\n", W);
  if (R7 != ZERO)
    W = LOG (ABS (R7)) / ALBETA;
  else
    W = ALL9;

  printf (" The root mean square relative error was %15.4E\n", R7);
  printf (" = %4d ** %7.2f\n", IBETA, W);
  W = MAX (AIT + W, ZERO);
  printf (" The estimated loss of base %4d\n", IBETA);
  printf (" significant digits is %7.2f\n", W);
  /*
C-----------------------------------------------------------------
C Report error in real component
C-----------------------------------------------------------------
*/
  if (RFLAG)
    {
      printf (" Then, report the error in the real component.\n");
      KX2 = N - KX3 - KX1;
      RX7 = SQRT (RX7 / XN);
      printf (" Test function was larger %6d times\n", KX1);
      printf ("                   agreed %6d times, and\n", KX2);
      printf ("              was smaller %6d times.\n", KX3);

      printf (" There are %4d base %4d\n", IT, IBETA);
      printf (" significant digits in a floating-point number.\n");
      if (RX6 != ZERO)
 W = LOG (ABS (RX6)) / ALBETA;
      else
 W = ALL9;

      if (!PFLAG)
 {
   printf (" The maximum relative error of %15.4E = %4d ** %7.2f\n",
    RX6, IBETA, W);
   printf ("    occurred for Z = (%17.6E,%17.6E)\n", creal (CX2), cimag (CX2));
   printf ("    with a value of (%17.6E,%17.6E\n", creal (CF2), cimag (CF2));
 }
      else
 {
   printf (" The maximum relative error of %15.4E = %4d ** %7.2f\n",
    RX6, IBETA, W);
   printf (" occurred for Z = (%17.6E,%17.6E)\n", creal (CX2), cimag (CX2));
   printf ("             and W = (%17.6E,%17.6E)\n", creal (CY2), cimag (CY2));
   printf ("    with a value of (%17.6E,%17.6E)\n", creal (CF2), cimag (CF2));
 }
      W = MAX (AIT + W, ZERO);
      printf (" The estimated loss of base %4d\n", IBETA);
      printf (" significant digits is %7.2f\n", W);
      if (RX7 != ZERO)
 W = LOG (ABS (RX7)) / ALBETA;
      else
 W = ALL9;

      printf (" The root mean square relative error was %15.4E\n", RX7);
      printf (" = %4d ** %7.2f\n", IBETA, W);
      W = MAX (AIT + W, ZERO);
      printf (" The estimated loss of base %4d\n", IBETA);
      printf (" significant digits is %7.2f\n", W);
    }
  /*
C-----------------------------------------------------------------
C Report error in imaginary component
C-----------------------------------------------------------------
*/
  if (IFLAG)
    {
      printf (" Then, report the error in the imaginary component.\n");
      KY2 = N - KY3 - KY1;
      RY7 = SQRT (RY7 / XN);
      printf (" Test function was larger %6d times\n", KY1);
      printf ("                   agreed %6d times, and\n", KY2);
      printf ("              was smaller %6d times.\n", KY3);

      printf (" There are %4d base %4d\n", IT, IBETA);
      printf (" significant digits in a floating-point number.\n");
      if (RY6 != ZERO)
 W = LOG (ABS (RY6)) / ALBETA;
      else
 W = ALL9;

      if (!PFLAG)
 {
   printf (" The maximum relative error of %15.4E = %4d ** %7.2f\n",
    RY6, IBETA, W);
   printf ("    occurred for Z = (%17.6E,%17.6E)\n", creal (CX3), cimag (CX3));
   printf ("    with a value of (%17.6E,%17.6E\n", creal (CF3), cimag (CF3));
 }
      else
 {
   printf (" The maximum relative error of %15.4E = %4d ** %7.2f\n",
    RY6, IBETA, W);
   printf (" occurred for Z = (%17.6E,%17.6E)\n", creal (CX3), cimag (CX3));
   printf ("             and W = (%17.6E,%17.6E)\n", creal (CY3), cimag (CY3));
   printf ("    with a value of (%17.6E,%17.6E)\n", creal (CF3), cimag (CF3));
 }
      W = MAX (AIT + W, ZERO);
      printf (" The estimated loss of base %4d\n", IBETA);
      printf (" significant digits is %7.2f\n", W);
      if (RY7 != ZERO)
 W = LOG (ABS (RY7)) / ALBETA;
      else
 W = ALL9;

      printf (" The root mean square relative error was %15.4E\n", RY7);
      printf (" = %4d ** %7.2f\n", IBETA, W);

      W = MAX (AIT + W, ZERO);
      printf (" The estimated loss of base %4d\n", IBETA);
      printf (" significant digits is %7.2f\n", W);

    }
}

/*
C-----------------------------------------------------------------
*/
/*
C---------- Last line of REPORT ----------
*/
/*
C----------------------------------------------------------------------
C  Subroutine to reset the paramaters for tests for complex
C  functions.
C
C  Latest revision - October 15, 1990
C
C  Author - W. J. Cody
C           Argonne National Laboratory
C
*/

void
RESET ()
{

  K1 = 0;
  K3 = 0;
  KX1 = 0;
  KX3 = 0;
  KY1 = 0;
  KY3 = 0;
  CX1 = CZERO;
  CX2 = CZERO;
  CX3 = CZERO;
  CY1 = CZERO;
  CY2 = CZERO;
  CY3 = CZERO;
  CF1 = CZERO;
  CF2 = CZERO;
  CF3 = CZERO;
  R6 = ZERO;
  R7 = ZERO;
  RX6 = ZERO;
  RX7 = ZERO;
  RY6 = ZERO;
  RY7 = ZERO;
};

/*
C---------- Last line of RESET ----------
*/