complex.c.sh

复数运算库

X	CCheck( "CxAdd 2", *cp, 2.0, 3.0 );
X
X	/* CxSub test */
X	cp = CxSub( CxCons( &a, 4.0, 7.0 ), bp );
X	CCheck( "CxSub 1", a, -2.0, 15.0 );
X	CCheck( "CxSub 2", *cp, -2.0, 15.0 );
X
X	/* CxMul test */
X	cp = CxMul( CxCons( bp, -1.0, 3.0 ), CxCons( &a, 1.0, 2.0 ) );
X	CCheck( "CxMul 1", *bp, -7.0, 1.0 );
X	CCheck( "CxMul 2", *cp, -7.0, 1.0 );
X
X	/* CxDiv test */
X	cp = CxDiv( bp, &a );
X	CCheck( "CxDiv 1", *bp, -1.0, 3.0 );
X	CCheck( "CxDiv 2", *cp, -1.0, 3.0 );
X
X	/* CxSqrt and overlapping CxMul tests */
X	(void)CxCons( &a, -1.0, 2.0 );
X	cp = CxSqrt( CxMul( &a, &a ) );
X	CCheck( "CxSqrt 1", a, -1.0, 2.0 );
X	CCheck( "CxSqrt 2", *cp, -1.0, 2.0 );
X	(void)CxCons( &a, 3.0, 2.0 );
X	cp = CxSqrt( CxMul( &a, &a ) );
X	CCheck( "CxSqrt 3", a, 3.0, 2.0 );
X	CCheck( "CxSqrt 4", *cp, 3.0, 2.0 );
X
X	/* CxFree "test" */
X	CxFree( bp );
X
X	return errs;
X	}
X
X
Xstatic void
XCCheck( s, c, r, i )			/* check complex number */
X	char	*s;			/* message string for failure */
X	complex	c;			/* complex to be checked */
X	double	r, i;			/* expected real, imaginary parts */
X	{
X	if ( RelDif( CxReal( &c ), r ) > TOL
X	  || RelDif( CxImag( &c ), i ) > TOL
X	   )	{
X		++errs;
X		Printf( "%s; s.b. (%f,%f), was (%g,%g)\n",
X			s, r, i, c.re, c.im
X		      );
X		}
X	}
X
X
Xstatic void
XRCheck( s, d, r )			/* check real number */
X	char	*s;			/* message string for failure */
X	double	d;			/* real to be checked */
X	double	r;			/* expected value */
X	{
X	if ( RelDif( d, r ) > TOL )
X		{
X		++errs;
X		Printf( "%s; s.b. %f, was %g\n", s, r, d );
X		}
X	}
X
X
Xstatic double
XRelDif( a, b )			/* returns relative difference:	*/
X	double	a, b;		/* 0.0 if exactly the same,
X				   otherwise ratio of difference
X				   to the larger of the two	*/
X	{
X	double	c = Abs( a );
X	double	d = Abs( b );
X
X	d = Max( c, d );
X
X	return d == 0.0 ? 0.0 : Abs( a - b ) / d;
X	}
END_OF_cx_test.c
if test 4250 -ne `wc -c <cx_test.c`; then
    echo shar: \"cx_test.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f cxadd.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"cxadd.c\"
else
echo shar: Extracting \"cxadd.c\" \(304 characters\)
sed "s/^X//" >cxadd.c <<'END_OF_cxadd.c'
X/*
X	CxAdd -- add one complex to another
X
X	last edit:	86/01/04	D A Gwyn
X
X	SCCS ID:	@(#)cxadd.c	1.1
X
X	CxAdd( &a, &b )	adds  b  to  a  and returns  &a
X*/
X
X#include	<complex.h>
X
Xcomplex *
XCxAdd( ap, bp )
X	register complex	*ap, *bp;	/* may coincide */
X	{
X	ap->re += bp->re;
X	ap->im += bp->im;
X
X	return ap;
X	}
END_OF_cxadd.c
if test 304 -ne `wc -c <cxadd.c`; then
    echo shar: \"cxadd.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f cxampl.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"cxampl.c\"
else
echo shar: Extracting \"cxampl.c\" \(278 characters\)
sed "s/^X//" >cxampl.c <<'END_OF_cxampl.c'
X/*
X	CxAmpl -- amplitude (magnitude, modulus, norm) of a complex
X
X	CxAmpl( &c )	returns  |c|
X
X	last edit:	86/01/04	D A Gwyn
X
X	SCCS ID:	@(#)cxampl.c	1.1
X*/
X
X#include	<math.h>
X
X#include	<complex.h>
X
Xdouble
XCxAmpl( cp )
X	register complex	*cp;
X	{
X	return hypot( cp->re, cp->im );
X	}
END_OF_cxampl.c
if test 278 -ne `wc -c <cxampl.c`; then
    echo shar: \"cxampl.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f cxconj.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"cxconj.c\"
else
echo shar: Extracting \"cxconj.c\" \(278 characters\)
sed "s/^X//" >cxconj.c <<'END_OF_cxconj.c'
X/*
X	CxConj -- conjugate a complex
X
X	CxConj( &c )	conjugates  c  and returns  &c
X
X	last edit:	86/01/04	D A Gwyn
X
X	SCCS ID:	@(#)cxconj.c	1.1
X*/
X
X#include	<complex.h>
X
Xcomplex *
XCxConj( cp )
X	register complex	*cp;
X	{
X	/* (real part unchanged) */
X	cp->im = -cp->im;
X
X	return cp;
X	}
END_OF_cxconj.c
if test 278 -ne `wc -c <cxconj.c`; then
    echo shar: \"cxconj.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f cxcons.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"cxcons.c\"
else
echo shar: Extracting \"cxcons.c\" \(329 characters\)
sed "s/^X//" >cxcons.c <<'END_OF_cxcons.c'
X/*
X	CxCons -- construct a complex from real and imaginary parts
X
X	CxCons( &c, re, im )	makes  c = re + i im  and returns  &c
X
X	last edit:	86/01/04	D A Gwyn
X
X	SCCS ID:	@(#)cxcons.c	1.1
X*/
X
X#include	<complex.h>
X
Xcomplex *
XCxCons( cp, re, im )
X	register complex	*cp;
X	double			re, im;
X	{
X	cp->re = re;
X	cp->im = im;
X
X	return cp;
X	}
END_OF_cxcons.c
if test 329 -ne `wc -c <cxcons.c`; then
    echo shar: \"cxcons.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f cxcopy.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"cxcopy.c\"
else
echo shar: Extracting \"cxcopy.c\" \(264 characters\)
sed "s/^X//" >cxcopy.c <<'END_OF_cxcopy.c'
X/*
X	CxCopy -- copy a complex
X
X	last edit:	86/01/04	D A Gwyn
X
X	SCCS ID:	@(#)cxcopy.c	1.1
X
X	CxCopy( &a, &b )	copies  b  to  a  and returns  &a
X*/
X
X#include	<complex.h>
X
Xcomplex *
XCxCopy( ap, bp )
X	complex	*ap, *bp;		/* may coincide */
X	{
X	*ap = *bp;
X
X	return ap;
X	}
END_OF_cxcopy.c
if test 264 -ne `wc -c <cxcopy.c`; then
    echo shar: \"cxcopy.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f cxdiv.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"cxdiv.c\"
else
echo shar: Extracting \"cxdiv.c\" \(820 characters\)
sed "s/^X//" >cxdiv.c <<'END_OF_cxdiv.c'
X/*
X	CxDiv -- divide one complex by another
X
X	CxDiv( &a, &b )	divides  a  by  b  and returns  &a;
X			zero divisor fails
X
X	last edit:	86/01/04	D A Gwyn
X
X	SCCS ID:	@(#)cxdiv.c	1.1 (modified for public version)
X*/
X
X#include	<complex.h>
X
X#define Abs( x )	((x) < 0 ? -(x) : (x))
X
Xcomplex *
XCxDiv( ap, bp )
X	register complex	*ap, *bp;	/* may coincide (?) */
X	{
X	double	r, s;
X	double	ap__re = ap->re;
X
X	/* Note: classical formula may cause unnecessary overflow */
X	r = bp->re;
X	s = bp->im;
X	if ( Abs( r ) >= Abs( s ) )
X		{
X		r = s / r;		/* <= 1 */
X		s = bp->re + r * s;
X		ap->re = (ap->re + ap->im * r) / s;
X		ap->im = (ap->im - ap__re * r) / s;
X		}
X	else /* Abs( s ) > Abs( r ) */
X		{
X		r = r / s;		/* < 1 */
X		s = s + r * bp->re;
X		ap->re = (ap->re * r + ap->im) / s;
X		ap->im = (ap->im * r - ap__re) / s;
X		}
X
X	return ap;
X	}
END_OF_cxdiv.c
if test 820 -ne `wc -c <cxdiv.c`; then
    echo shar: \"cxdiv.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f cxmul.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"cxmul.c\"
else
echo shar: Extracting \"cxmul.c\" \(424 characters\)
sed "s/^X//" >cxmul.c <<'END_OF_cxmul.c'
X/*
X	CxMul -- multiply one complex by another
X
X	CxMul( &a, &b )	multiplies  a  by  b  and returns  &a
X
X	last edit:	86/01/04	D A Gwyn
X
X	SCCS ID:	@(#)cxmul.c	1.1
X*/
X
X#include	<complex.h>
X
Xcomplex *
XCxMul( ap, bp )
X	register complex	*ap, *bp;	/* (may coincide) */
X	{
X	double			ap__re = ap->re;
X	double			bp__re = bp->re;
X
X	ap->re = ap__re * bp__re - ap->im * bp->im;
X	ap->im = ap__re * bp->im + ap->im * bp__re;
X
X	return ap;
X	}
END_OF_cxmul.c
if test 424 -ne `wc -c <cxmul.c`; then
    echo shar: \"cxmul.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f cxphas.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"cxphas.c\"
else
echo shar: Extracting \"cxphas.c\" \(406 characters\)
sed "s/^X//" >cxphas.c <<'END_OF_cxphas.c'
X/*
X	CxPhas -- phase (angle, argument) of a complex
X
X	CxPhas( &c )	returns  arg(c)  in radians (-Pi,Pi]
X
X	last edit:	86/01/04	D A Gwyn
X
X	SCCS ID:	@(#)cxphas.c	1.1 (modified for public version)
X*/
X
X#include	<math.h>
X
X#include	<complex.h>
X
Xdouble
XCxPhas( cp )
X	register complex	*cp;
X	{
X	if ( cp->re == 0.0 && cp->im == 0.0 )
X		return 0.0;		/* can't trust atan2() */
X	else
X		return atan2( cp->im, cp->re );
X	}
END_OF_cxphas.c
if test 406 -ne `wc -c <cxphas.c`; then
    echo shar: \"cxphas.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f cxphsr.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"cxphsr.c\"
else
echo shar: Extracting \"cxphsr.c\" \(395 characters\)
sed "s/^X//" >cxphsr.c <<'END_OF_cxphsr.c'
X/*
X	CxPhsr -- construct a complex "phasor" from amplitude and phase
X
X	CxPhsr( &c, amp, phs )	makes  c = amp exp(i phs)
X					and returns  &c
X
X	last edit:	86/01/04	D A Gwyn
X
X	SCCS ID:	@(#)cxphsr.c	1.1
X*/
X
X#include	<math.h>
X
X#include	<complex.h>
X
Xcomplex *
XCxPhsr( cp, amp, phs )
X	register complex	*cp;
X	double			amp, phs;
X	{
X	cp->re = amp * cos( phs );
X	cp->im = amp * sin( phs );
X
X	return cp;
X	}
END_OF_cxphsr.c
if test 395 -ne `wc -c <cxphsr.c`; then
    echo shar: \"cxphsr.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f cxscal.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"cxscal.c\"
else
echo shar: Extracting \"cxscal.c\" \(291 characters\)
sed "s/^X//" >cxscal.c <<'END_OF_cxscal.c'
X/*
X	CxScal -- multiply a complex by a scalar
X
X	CxScal( &c, s )	scales  c  by  s  and returns  &c
X
X	last edit:	86/01/04	D A Gwyn
X
X	SCCS ID:	@(#)cxscal.c	1.1
X*/
X
X#include	<complex.h>
X
Xcomplex *
XCxScal( cp, s )
X	register complex	*cp;
X	double			s;
X	{
X	cp->re *= s;
X	cp->im *= s;
X
X	return cp;
X	}
END_OF_cxscal.c
if test 291 -ne `wc -c <cxscal.c`; then
    echo shar: \"cxscal.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f cxsqrt.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"cxsqrt.c\"
else
echo shar: Extracting \"cxsqrt.c\" \(1339 characters\)
sed "s/^X//" >cxsqrt.c <<'END_OF_cxsqrt.c'
X/*
X	CxSqrt -- compute square root of complex number
X
X	CxSqrt( &c )	replaces  c  by  sqrt(c)  and returns  &c
X
X	Note:	This is a double-valued function; the result of
X		CxSqrt() always has nonnegative imaginary part.
X
X	inspired by Jeff Hanes' version
X
X	last edit:	86/01/04	D A Gwyn
X
X	SCCS ID:	@(#)cxsqrt.c	1.1 (modified for public version)
X*/
X
X#include	<math.h>
X
X#include	<complex.h>
X
X#define	Sgn( x )	((x) == 0 ? 0 : (x) > 0 ? 1 : -1)
X
Xcomplex *
XCxSqrt( cp )
X	register complex	*cp;
X	{
X	/* record signs of original real & imaginary parts */
X	int			re_sign = Sgn( cp->re );
X	int			im_sign = Sgn( cp->im );
X
X	/* special cases are not necessary; they are here for speed */
X
X	if ( re_sign == 0 )
X		if ( im_sign == 0 )
X			;		/* (0,0) already there */
X		else if ( im_sign > 0 )
X			cp->re = cp->im = sqrt( cp->im / 2.0 );
X		else			/* im_sign < 0 */
X			cp->re = -(cp->im = sqrt( -cp->im / 2.0 ));
X	else if ( im_sign == 0 )
X		if ( re_sign > 0 )
X			cp->re = sqrt( cp->re );
X/*			cp->im = 0.0;	/* 0 already there */
X		else	{		/* re_sign < 0 */
X			cp->im = sqrt( -cp->re );
X			cp->re = 0.0;
X			}
X	else	{			/* no shortcuts */
X		double	ampl = CxAmpl( cp );
X
X		cp->im = sqrt( (ampl - cp->re) /2.0 );
X
X		if ( im_sign > 0 )
X			cp->re = sqrt( (ampl + cp->re) / 2.0 );
X		else			/* im_sign < 0 */
X			cp->re = -sqrt( (ampl + cp->re) / 2.0 );
X		}
X
X	return cp;
X	}
END_OF_cxsqrt.c
if test 1339 -ne `wc -c <cxsqrt.c`; then
    echo shar: \"cxsqrt.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f cxsub.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"cxsub.c\"
else
echo shar: Extracting \"cxsub.c\" \(320 characters\)
sed "s/^X//" >cxsub.c <<'END_OF_cxsub.c'
X/*
X	CxSub -- subtract one complex from another
X
X	CxSub( &a, &b )	subtracts  b  from  a  and returns  &a
X
X	last edit:	86/01/04	D A Gwyn
X
X	SCCS ID:	@(#)cxsub.c	1.1
X*/
X
X#include	<complex.h>
X
Xcomplex *
XCxSub( ap, bp )
X	register complex	*ap, *bp;	/* (may coincide) */
X	{
X	ap->re -= bp->re;
X	ap->im -= bp->im;
X
X	return ap;
X	}
END_OF_cxsub.c
if test 320 -ne `wc -c <cxsub.c`; then
    echo shar: \"cxsub.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of shell archive.
exit 0