/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:33:17 */
/*FOR_C Options SET: ftn=u io=c no=p op=aimnv pf=,p_slnrel s=dbov str=l x=f - prototypes */
#include <math.h>
#include "fcrt.h"
#include <float.h>
#include <stdio.h>
#include <stdlib.h>
#include "p_slnrel.h"
#include "drslnrel.h"
/*      program DRSLNREL
 *>> 1999-07-27 DRSLNREL Krogh analyz => SANAL for global analysis.
 *>> 1996-07-09 DRSLNREL Krogh Moved formats up.
 *>> 1994-11-02 DRSLNREL Krogh  Changes to use M77CON
 *>> 1994-07-06 DRSLNREL WVS set up for chgtyp
 *
 *     Demonstration driver for more accurate routines from chapter 2-15.
 *     To illustrate worst-case, expressions are computed little-by-
 *     little.  If possible, the routine should be compiled with an
 *     option that causes results not to be stored in registers from one
 *     assignment to the next.  For Lahey Fortran on a PC, use /7.
 *
 *--S replaces "?": DR?LNREL, ?GAMMA, ?LNREL, ?RLOG1, ?RLOG, ?REXP
 *--   &              ?SINPX, ?COSPX, ?SINHM, ?COSHM, ?CSHMM, ?GAM1
 *--   &              ?COS1, ?SIN1, ?ANAL */
		/* PARAMETER translations */
#define	DPI	3.141592653589793238462643383279502884197e0
		/* end of PARAMETER translations */
 
 
int main( )
{
	long int _l0;
	float d, u, w;
 
 
	/*     SLNREL */
	d = 1.0e0/powif(2.0e0,12);
	w = 1.0e0 + d;
	w = logf( w );
	u = slnrel( d );
	sanal( "SLNREL", d, u, w );
 
	/*     SRLOG1 */
	w = d - w;
	u = srlog1( d );
	sanal( "SRLOG1", d, u, w );
 
	/*     SRLOG */
	w = d - 1.0e0;
	w -= logf( d );
	u = srlog( d );
	sanal( "SRLOG ", d, u, w );
 
	/*     SREXP */
	w = expf( d );
	w -= 1.0e0;
	u = srexp( d );
	sanal( "SREXP ", d, u, w );
 
	/*     SSINPX */
	d = 25.125e0;
	w = sinf( d*DPI );
	u = ssinpx( d );
	sanal( "SSINPX", d, u, w );
 
	/*     SCOSPX */
	w = cosf( d*DPI );
	u = scospx( d );
	sanal( "SCOSPX", d, u, w );
 
	/*     SSIN1 */
	d = powif(0.5e0,22);
	w = sinf( d );
	w = (d - w)/CUBE(d);
	u = ssin1( d );
	sanal( "SSIN1 ", d, u, w );
 
	/*     SCOS1 */
	w = cosf( d );
	w = (d - w)/SQ(d);
	u = scos1( d );
	sanal( "SCOS1 ", d, u, w );
 
	/*     SSINHM */
	d = 0.25e0;
	w = sinhf( d );
	w -= d;
	u = ssinhm( d );
	sanal( "SSINHM", d, u, w );
 
	/*     SCOSHM */
	w = coshf( d );
	w -= 1.0e0;
	u = scoshm( d );
	sanal( "SCOSHM", d, u, w );
 
	/*     SCSHMM */
	w = coshf( d );
	w -= 1.0e0;
	w += -0.5*d*d;
	u = scshmm( d );
	sanal( "SCSHMM", d, u, w );
 
	/*     SGAM1 */
	w = 1.0e0/sgamma( 1.0e0 + d );
	w -= 1.0e0;
	u = sgam1( d );
	sanal( "SGAM1 ", d, u, w );
 
	printf(" Error is (relative error) / (round off level).\n Round off level is (smallest number r such that 1 + r .NE. 1).\n For the present machine, r =%13.6g\n Errors less than 0.5 r should be considered to be zero.\n",
	   FLT_EPSILON);
	exit(0);
} /* end of function */
 
void /*FUNCTION*/ sanal(
char *routin,
float x,
float u,
float w)
{
	long int _l0;
	float ew;
	static float round = -1.0e0;
 
	if (round < 0.0e0)
	{
		round = FLT_EPSILON;
		printf(" Function                    Result         ---- Not Using ----\n From This                   Using This     --- This Package --\n Package        Argument     Package        Result        Error\n");
	}
	ew = fabsf( w - u )/fabsf( u*round );
	printf(" %6.6s     %12.4e  %13.6e  %13.6e %9.2e\n", routin, x, u, w, ew);
	return;
} /* end of function */