/* -*-C-*- tsqrt.c */

#include "elefunt.h"

/*    PROGRAM TO TEST SQRT
#
#     DATA REQUIRED
#
#        NONE
#
#     SUBPROGRAMS REQUIRED FROM THIS PACKAGE
#
#        MACHAR - AN ENVIRONMENTAL INQUIRY PROGRAM PROVIDING
#                 INFORMATION ON THE FLOATING-POINT ARITHMETIC
#                 SYSTEM.  NOTE THAT THE CALL TO MACHAR CAN
#                 BE DELETED PROVIDED THE FOLLOWING SIX
#                 PARAMETERS ARE ASSIGNED THE VALUES INDICATED
#
#                 IBETA  - THE RADIX OF THE FLOATING-POINT SYSTEM
#                 IT     - THE NUMBER OF BASE-IBETA DIGITS IN THE
#                          SIGNIFICAND OF A FLOATING-POINT NUMBER
#                 EPS    - THE SMALLEST POSITIVE FLOATING-POINT
#                          NUMBER SUCH THAT 1.0+EPS .NE. 1.0
#                 EPSNEG - THE SMALLEST POSITIVE FLOATING-POINT
#                          NUMBER SUCH THAT 1.0-EPSNEG .NE. 1.0
#                 XMIN   - THE SMALLEST NON-VANISHING FLOATING-POINT
#                          POWER OF THE RADIX
#                 XMAX   - THE LARGEST FINITE FLOATING-POINT NO.
#
#      RANDL(X) - A FUNCTION SUBPROGRAM RETURNING LOGARITHMICALLY
#                 DISTRIBUTED RANDOM REAL NUMBERS.  IN PARTICULAR,
#                        A * RANDL(ALOG(B/A))
#                 IS LOGARITHMICALLY DISTRIBUTED OVER (A,B)
#
#        RAN(K) - A FUNCTION SUBPROGRAM RETURNING RANDOM REAL
#                 NUMBERS UNIFORMLY DISTRIBUTED OVER (0,1)
#
#
#     STANDARD FORTRAN SUBPROGRAMS REQUIRED
#
#         ABS, ALOG, AMAX1, FLOAT, SQRT
#
#
#     LATEST REVISION - AUGUST 2, 1979
#
#     AUTHOR - W. J. CODY
#              ARGONNE NATIONAL LABORATORY
#
*****************************************************************************/

void
tsqrt(VOID_ARG)
{
    int i,
        ibeta,
        iexp,
        irnd,
        it,
        j,
        k1,
        k2,
        k3,
        machep,
        maxexp,
        minexp,
        n,
        negep,
        ngrd;

    sp_t
        eps,
        epsneg,
        xmax,
        xmin;

    volatile sp_t 
	a,
        ait,
        albeta,
        b,
        beta,
        c,
        r6,
        r7,
        sqbeta,
        w,
        x,
        xn,
        x1,
        y,
        z;

    /*******************************************************************/

    (void)sranset(initseed());
    macharf(&ibeta, &it, &irnd, &ngrd, &machep, &negep, &iexp, &minexp,
	   &maxexp, &eps, &epsneg, &xmin, &xmax);
    beta = TO_FP_T(ibeta);
    sqbeta = SQRT(beta);
    albeta = ALOG(beta);
    ait = TO_FP_T(it);
    a = ONE / sqbeta;
    b = ONE;
    n = maxtest();
    xn = TO_FP_T(n);
    c = ZERO;
    z = ZERO;

    /* random argument accuracy tests */

    for (j = 1; j <= 2; ++j)
    {
	c = ALOG(b / a);
	k1 = 0;
	k3 = 0;
	x1 = ZERO;
	r6 = ZERO;
	r7 = ZERO;

	for (i = 1; i <= n; ++i)
	{
	    x = a * RANDL(c);
	    y = x * x;
	    z = SQRT(y);
	    w = (z - x) / x;
	    if (w > ZERO)
		k1 = k1 + 1;
	    if (w < ZERO)
		k3 = k3 + 1;
	    w = ABS(w);
	    if (w > r6)
	    {
		r6 = w;
		x1 = x;
	    }
	    r7 = r7 + w * w;
	}

	k2 = n - k1 - k3;
	r7 = SQRT(r7 / xn);
	(void)printf("1TEST OF SQRT(X*X) - X\n\n\n");
	(void)printf("%7d RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL\n", n);
	(void)printf("       (%15.4e,%15.4e)\n\n\n", a, b);
	(void)printf(" SQRT(X) WAS LARGER%6d TIMES,\n", k1);
	(void)printf("             AGREED%6d TIMES, AND\n", k2);
	(void)printf("        WAS SMALLER%6d TIMES.\n\n\n", k3);
	(void)printf(" THERE ARE%4d BASE%4d SIGNIFICANT DIGITS IN A FLOATING-POINT NUMBER\n\n\n",
	    it, ibeta);
	w = -999.0e+00F;
	if (r6 != ZERO)
	    w = ALOG(ABS(r6)) / albeta;
	(void)printf(" THE MAXIMUM RELATIVE ERROR OF%15.4e = %4d **%7.2f\n",
	    r6, ibeta, w);
	(void)printf("    OCCURRED FOR X =%17.6e\n", x1);
	w = AMAX1(ait + w, ZERO);
	(void)printf(
	    " THE ESTIMATED LOSS OF BASE%4d SIGNIFICANT DIGITS IS%7.2f\n\n\n",
	    ibeta, w);
	w = -999.0e+00F;
	if (r7 != ZERO)
	    w = ALOG(ABS(r7)) / albeta;
	(void)printf(" THE ROOT MEAN SQUARE RELATIVE ERROR WAS%15.4e = %4d **%7.2f\n",
	    r7, ibeta, w);
	w = AMAX1(ait + w, ZERO);
	(void)printf(
	    " THE ESTIMATED LOSS OF BASE%4d SIGNIFICANT DIGITS IS%7.2f\n\n\n",
	    ibeta, w);
	a = ONE;
	b = sqbeta;
    }

    /* special tests */

    (void)printf("1TEST OF SPECIAL ARGUMENTS\n\n\n");
    x = xmin;
    y = SQRT(x);
    (void)printf(" SQRT(XMIN) = SQRT(%15.7e) = %15.7e\n\n\n", x, y);
    x = ONE - epsneg;
    y = SQRT(x);
    (void)printf(" SQRT(1-EPSNEG) = SQRT(1-%15.7e) = %15.7e\n\n\n", epsneg, y);
    x = ONE;
    y = SQRT(x);
    (void)printf(" SQRT(1.0) = SQRT(%15.7e) = %15.7e\n\n\n", x, y);
    x = ONE + eps;
    y = SQRT(x);
    (void)printf(" SQRT(1+EPS) = SQRT(1+%15.7e) = %15.7e\n\n\n", eps, y);
    x = xmax;
    y = SQRT(x);
    (void)printf(" SQRT(XMAX) = SQRT(%15.7e) = %15.7e\n\n\n", x, y);

    /* test of error returns */

    (void)printf("1TEST OF ERROR RETURNS\n\n\n");

    x = ZERO;
    (void)printf(" SQRT WILL BE CALLED WITH THE ARGUMENT %15.4e\n", x);
    (void)printf(" THIS SHOULD NOT TRIGGER AN ERROR MESSAGE\n\n\n");
    fflush(stdout);
    errno = 0;
    y = SQRT(x);
    if (errno)
	perror("SQRT()");
    (void)printf(" SQRT RETURNED THE VALUE %15.4e\n\n\n", y);

    x = -ONE;
    (void)printf("\nSQRT WILL BE CALLED WITH THE ARGUMENT %15.4e\n", x);
    (void)printf(" THIS SHOULD TRIGGER AN ERROR MESSAGE\n\n\n");
    fflush(stdout);
    errno = 0;
    y = SQRT(x);
    if (errno)
	perror("SQRT()");
    (void)printf(" SQRT RETURNED THE VALUE %15.4e\n\n\n\n", y);

    (void)printf(" THIS CONCLUDES THE TESTS\n");
}
