-- version control marker $Id: cg67cplx.occ,v 1.1 1995/10/11 10:25:45 djb1 Exp $
COMPLEX FUNCTION neg (VAL COMPLEX x) IS [-x[re], -x[im]] :
COMPLEX FUNCTION conj (VAL COMPLEX x) IS [x[re], -x[im]] :
COMPLEX FUNCTION add (VAL COMPLEX x, y) IS [x[re]+y[re], x[im]+y[im]] :
COMPLEX FUNCTION sub (VAL COMPLEX x, y) IS add (x, neg (y)) :
COMPLEX FUNCTION mulR (VAL COMPLEX x, VAL COMP.BASE y) IS [x[re]*y, x[im]*y] :
COMPLEX FUNCTION mul (VAL COMPLEX x, y) IS
  [(x[re]*y[re])-(x[im]*y[im]), (x[re]*y[im])+(x[im]*y[re])] :
COMPLEX FUNCTION divR (VAL COMPLEX x, VAL COMP.BASE y) IS [x[re]/y, x[im]/y] :
COMP.BASE FUNCTION conj.prod (VAL COMPLEX x) IS (x[re]*x[re])+(x[im]*x[im]) :
COMPLEX FUNCTION div (VAL COMPLEX x, y) IS divR (mul (x, conj (y)), conj.prod (y)) :

--COMP.BASE INLINE FUNCTION expR(VAL COMP.BASE x) IS COMP.BASE ROUND DEXP (REAL64 ROUND x) :
--COMP.BASE INLINE FUNCTION sinR(VAL COMP.BASE x) IS COMP.BASE ROUND DSIN (REAL64 ROUND x) :
--COMP.BASE INLINE FUNCTION cosR(VAL COMP.BASE x) IS COMP.BASE ROUND DCOS (REAL64 ROUND x) :
--COMP.BASE INLINE FUNCTION logR(VAL COMP.BASE x) IS COMP.BASE ROUND DALOG(REAL64 ROUND x) :
--COMP.BASE INLINE FUNCTION atan2R (VAL COMP.BASE x, y) IS
--  COMP.BASE ROUND DATAN2(REAL64 ROUND x, REAL64 ROUND y) :
--COMPLEX FUNCTION exp (VAL COMPLEX x) IS mulR ([cosR(x[im]), sinR(x[im])], expR (x[re])) :
--COMPLEX FUNCTION log (VAL COMPLEX x) IS [logR (conj.prod (x))/2, atan2R(x[re],x[im])] :
--COMPLEX FUNCTION power (VAL COMPLEX x, y) IS exp (mul (log (x), y)) :

COMPLEX INLINE FUNCTION complex (VAL REAL32 x) IS
  [COMP.BASE ROUND x, COMP.BASE ROUND 0.0(REAL32)] :
COMPLEX INLINE FUNCTION complex.2 (VAL REAL32 x, y) IS
  [COMP.BASE ROUND x, COMP.BASE ROUND y] :

PROC check.COMPLEX(VAL COMPLEX x, y, VAL []BYTE msg)
  SEQ
    check.COMP.BASE(x[re], y[re], msg)
    check.COMP.BASE(x[im], y[im], msg)
:

REAL64 INLINE FUNCTION re (VAL COMPLEX z) IS REAL64 ROUND z[re] :
REAL64 INLINE FUNCTION im (VAL COMPLEX z) IS REAL64 ROUND z[im] :
--REAL64 FUNCTION rho (VAL COMPLEX x) IS SQRT (REAL64 ROUND conj.prod (x)) :
--REAL64 FUNCTION theta (VAL COMPLEX x) IS ATAN2 (re(x), im(x)) :

COMPLEX a, b, w, x, y, z :
VAL COMPLEX one IS complex(1.0) :
VAL COMPLEX two IS complex(2.0) :
VAL COMPLEX j IS complex.2(0.0, 1.0) :
VAL COMPLEX onej IS complex.2(1.0, 1.0) :
VAL COMPLEX twoj IS complex.2(2.0, 1.0) :
SEQ
  --so.write.res (fs, ts, j, j, " ** ", mul (j, j)) -- -1.0
  check.COMPLEX(mul(j, j), complex(-1.0), "CPLX-000")

  a := complex(2.0)
  b := complex.2(3.0, 5.0)
  x := mul (a, b)
  --so.write.res (fs, ts, a, b, " ** ", x) -- (6.0+10.0j)
  check.COMPLEX(x, complex.2(6.0, 10.0), "CPLX-001")

  x := add (one, j)
  --so.write.res (fs, ts, one, j, " + ", x) -- (1.0+j)
  check.COMPLEX(x, complex.2(1.0, 1.0), "CPLX-002")

  x := mul (onej, twoj)
  y := div (x, twoj)
  z := div (x, onej)
  --so.write.res (fs, ts, onej, twoj, " ** ", x) -- (1.0+3.0j)
  check.COMPLEX(x, complex.2(1.0, 3.0), "CPLX-003")
  --so.write.res (fs, ts, x, twoj, " / ", y)     -- (1.0+j)
  check.COMPLEX(y, complex.2(1.0, 1.0), "CPLX-004")
  --so.write.res (fs, ts, x, onej, " / ", z)     -- (2.0+j)
  check.COMPLEX(z, complex.2(2.0, 1.0), "CPLX-005")

  --x := exp (add (twoj, mul (j, complex (6.0))))
  --y := log (x)
  --so.write.res (fs, ts, twoj, x, " ^, ln ", y) -- (2.0+j)
  --check.COMPLEX(x, complex.2(1.0, 3.0), "CPLX-003")

  --SEQ i = 0 FOR 20
  --  VAL i IS complex (REAL32 ROUND i) :
  --  VAL base IS div (two, j) :
  --  SEQ
  --    x := power (base, i)
  --    so.write.res (fs, ts, base, i, " ^ ", x) -- lots

  --VAL X IS div (two, j) :
  --VAL Y IS complex (20.0) :
  --SEQ
  --  x := log (X)
  --  y := mul (x, Y)
  --  w := div (sub (y, conj (y)), two)
  --  z := exp (y)
  --  a := exp (w)
  --  so.write.res (fs, ts, X, Y, " log ", x) -- -2.0j
  --  so.write.res (fs, ts, x, w, " mul ", y) -- -40.0j
  --  so.write.res (fs, ts, y, a, " exp ", z) -- (-1.0+-1.0j)
