/* -*-C-*- tsinh.c */

#include "elefunt.h"

/*#     program to test sinh/cosh
#
#     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
#                 irnd   - 0 if floating-point addition chops,
#                          1 if floating-point addition rounds
#                 minexp - the largest in magnitude negative
#                          integer such that float(ibeta)**minexp
#                          is a positive floating-point number
#                 eps    - the smallest positive floating-point
#                          number such that 1.0+eps != 1.0
#                 xmax   - the largest finite floating-point no.
#
#        ran(k) - a function subprogram returning random real
#                 numbers uniformly distributed over (0,1)
#
#
#     standard fortran subprograms required
#
#         abs, alog, amax1, cosh, float, int, sinh, sqrt
#
#
#     latest revision - december 6, 1979
#
#     author - w. j. cody
#              argonne national laboratory
#
#*/

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

    sp_t
        eps,
        epsneg,
        xmax,
        xmin;

    volatile sp_t 
	a,
        aind,
        ait,
        albeta,
        alxmax,
        b,
        beta,
        betap,
        c,
        c0,
        del,
        den,
        five,
        r6,
        r7,
        three,
        w,
        x,
        xl,
        xn,
        x1,
        xsq,
        y,
        z,
        zz;

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

    (void)sranset(initseed());
    macharf(&ibeta, &it, &irnd, &ngrd, &machep, &negep, &iexp, &minexp,
        &maxexp, &eps, &epsneg, &xmin, &xmax);
    beta = TO_FP_T(ibeta);
    albeta = ALOG(beta);
    alxmax = ALOG(xmax);
    ait = TO_FP_T(it);
    three = 3.0e+00F;
    five = 5.0e+00F;
    c0 = five / 16.0e+00F + 1.152713683194269979e-2F;
    a = ZERO;
    b = 0.5e+00F;
    c = (ait + ONE) * 0.35e+00F;
    if (ibeta == 10)
	c = c * three;
    n = maxtest();
    xn = TO_FP_T(n);
    i2 = 2;
    nit = 2 - (INT(ALOG(eps) * three)) / 20;
    aind = TO_FP_T(nit + nit + 1);
    w = ZERO;

    /* random argument accuracy tests */

    for (j = 1; j <= 4; ++j)
    {
	if (j == 2)
	{
	    aind = aind - ONE;
	    i2 = 1;
	}
	k1 = 0;
	k3 = 0;
	x1 = ZERO;
	r6 = ZERO;
	r7 = ZERO;
	del = (b - a) / xn;
	xl = a;

	for (i = 1; i <= n; ++i)
	{
	    x = del * RAN() + xl;
	    if (j > 2)
	    {
		y = x;
		x = y - ONE;
		w = x - ONE;
		if (j == 4)
		{
		    z = COSH(x);
		    zz = (COSH(y) + COSH(w)) * c0;
		}
		else
		{
		    z = SINH(x);
		    zz = (SINH(y) + SINH(w)) * c0;
		}
	    }
	    else
	    {
		xsq = x * x;
		zz = ONE;
		den = aind;

		for (ii = i2; ii <= nit; ++ii)
		{
		    w = zz * xsq / (den * (den - ONE));
		    zz = w + ONE;
		    den = den - 2.0e+00F;
		}

		if (j == 2)
		{
		    z = COSH(x);
		    if (irnd == 0)
		    {
			w = (ONE - zz) + w;
			zz = zz + (w + w);
		    }
		}
		else
		{
		    w = x * xsq * zz / 6.0e+00F;
		    zz = x + w;
		    z = SINH(x);
		    if (irnd == 0)
		    {
			w = (x - zz) + w;
			zz = zz + (w + w);
		    }
		}
	    }
	    w = ONE;
	    if (z != ZERO)
		w = (z - zz) / z;
	    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;
	    xl = a + TO_FP_T(i) * del;	/* OLD: xl = xl + del (bad for large n) */
	}

	k2 = n - k3 - k1;
	r7 = SQRT(r7 / xn);
	i = (j / 2) * 2;
	if (j == 1)
	    (void)printf("1TEST OF SINH(X) VS T.S. EXPANSION OF SINH(X)\n\n");
	else if (j == 2)
	    (void)printf("1TEST OF COSH(X) VS T.S. EXPANSION OF COSH(X)\n\n");
	else if (j == 3)
	    (void)printf("1TEST OF SINH(X) VS C*(SINH(X+1)+SINH(X-1))\n\n");
	else if (j == 4)
	    (void)printf("1TEST OF COSH(X) VS C*(COSH(X+1)+COSH(X-1))\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);
	if (i != j)
	{
	    (void)printf(" SINH(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);
	}
	else
	{
	    (void)printf(" COSH(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);
	if (j == 2)
	{
	    b = alxmax;
	    a = three;
	}
    }

    /* special tests */

    (void)printf("1SPECIAL TESTS\n\n");
    (void)printf(" THE IDENTITY  SINH(-X) = -SINH(X)  WILL BE TESTED.\n\n");
    (void)printf("        X            F(X) + F(-X)\n\n");

    for (i = 1; i <= 5; ++i)
    {
	x = RAN() * a;
	z = SINH(x) + SINH(-x);
	(void)printf("%15.7e%15.7e\n\n", x, z);
    }

    (void)printf(" THE IDENTITY SINH(X) = X , X SMALL, WILL BE TESTED.\n\n");
    (void)printf("        X         X - F(X)\n\n");
    betap = IPOW(beta, it);
    x = RAN() / betap;

    for (i = 1; i <= 5; ++i)
    {
	z = x - SINH(x);
	(void)printf("%15.7e%15.7e\n\n", x, z);
	x = x / beta;
    }

    (void)printf(" THE IDENTITY  COSH(-X) = COSH(X)  WILL BE TESTED.\n\n");
    (void)printf("        X         F(X) - F(-X)\n\n");

    for (i = 1; i <= 5; ++i)
    {
	x = RAN() * a;
	z = COSH(x) - COSH(-x);
	(void)printf("%15.7e%15.7e\n\n", x, z);
    }

    (void)printf(" TEST OF UNDERFLOW FOR VERY SMALL ARGUMENT.\n\n");
    x = POW(beta, TO_FP_T(minexp) * 0.75e+00F);
    y = SINH(x);
    (void)printf("      SINH(%13.6e) =%13.6e\n\n", x, y);

    /* test of error returns */

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

    x = alxmax + 0.125e+00F;
    (void)printf(" SINH 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 = SINH(x);
    if (errno)
	perror("SINH()");
    (void)printf(" SINH RETURNED THE VALUE%15.4e\n\n\n", y);

    x = betap;
    (void)printf("\nSINH 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 = SINH(x);
    if (errno)
	perror("SINH()");
    (void)printf(" SINH RETURNED THE VALUE%15.4e\n\n\n\n", y);

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