瀏覽代碼

+ complex.pp replaced by ucomplex.pp
complex operations working

pierre 27 年之前
父節點
當前提交
36e6db8f40
共有 3 個文件被更改,包括 644 次插入562 次删除
  1. 0 560
      rtl/inc/complex.pp
  2. 2 2
      rtl/inc/readme
  3. 642 0
      rtl/inc/ucomplex.pp

+ 0 - 560
rtl/inc/complex.pp

@@ -1,560 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by Pierre Muller,
-    member of the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-Unit COMPLEX;
-
-(* Bibliotheque mathematique pour type complexe *)
-(* Version a fonctions et pointeurs *)
-(* JD GAYRARD mai 95 *)
-
-(* modified for FPK by Pierre Muller *)
-(* FPK supports operator overloading *)
-(* This library is based on functions instead of procedures.
-   To allow a function to return complex type, the trick is
-   is to use a pointer on the result of the function. All
-   functions are of Pcomplex type (^complexe).
-   In the main program the function computation is accessed
-   by      z := function_name(param1, param2)^ *)
-
-{$G+}
-{$N+}
-{$E-}
-
-interface
-
-uses MATHLIB, HYPERBOL;
-
-const author  = 'GAYRARD J-D';
-      version = 'ver 0.0 - 05/95';
-
-type complex = record
-                re : real;
-                im : real;
-                end;
-
-pcomplex = ^complex;
-
-const _i : complex = (re : 0.0; im : 1.0);
-      _0 : complex = (re : 0.0; im : 0.0);
-
-
-(* quatre operations : +, -, * , /  and = *)
-operator + (z1, z2 : complex) z : complex;      (* addition *)
-{ assignment overloading is not implement }
-{ if it was the next two would not be unnecessary }
-operator + (z1 : complex; r : real) z : complex;      (* addition *)
-operator + (r : real; z1 : complex) z : complex;      (* addition *)
-
-operator - (z1, z2 : complex) z : complex;      (* soustraction *)
-operator - (z1 : complex;r : real) z : complex;      (* soustraction *)
-operator - (r : real; z1 : complex) z : complex;      (* soustraction *)
-
-operator * (z1, z2 : complex) z : complex;      (* multiplication *)
-operator * (z1 : complex; r : real) z : complex;      (* multiplication *)
-operator * (r : real; z1 : complex) z : complex;      (* multiplication *)
-
-operator / (znum, zden : complex) z : complex;  (* division znum / zden *)
-operator / (znum : complex; r : real) z : complex;  (* division znum / r *)
-operator / (r : real; zden : complex) z : complex;  (* division r / zden *)
-
-{ ^ is not built in FPK, but can be overloaded also }
-operator ^ (r1, r2 : real) r : real;
-operator ^ (z1, z2 : complex) z : complex;
-operator ^ (z1 : complex; r2 : real) z : complex;
-operator ^ (r : real; z1 : complex) z : complex;
-
-operator = (z1, z2 : complex) b : boolean;
-operator = (z1 : complex;r : real) b : boolean;
-operator = (r : real; z1 : complex) b : boolean;
-
-(* fonctions complexes particulieres *)
-function cneg (z : complex) : complex;       (* negatif *)
-function ccong (z : complex) : complex;      (* conjuge *)
-function crcp (z : complex) : complex;       (* inverse *)
-function ciz (z : complex) : complex;        (* multiplication par i *)
-function c_iz (z : complex) : complex;       (* multiplication par -i *)
-function czero : complex;                     (* return zero *)
-
-(* fonctions complexes a retour non complex *)
-function cmod (z : complex) : real;           (* module *)
-function cequal (z1, z2 : complex) : boolean;  (* compare deux complexes *)
-function carg (z : complex) : real;           (* argument : a / z = p.e^ia *)
-
-(* fonctions elementaires *)
-function cexp (z : complex) : complex;       (* exponantielle *)
-function cln (z : complex) : complex;        (* logarithme naturel *)
-function csqrt (z : complex) : complex;      (* racine carre *)
-
-(* fonctions trigonometrique directe *)
-function ccos (z : complex) : complex;       (* cosinus *)
-function csin (z : complex) : complex;       (* sinus *)
-function ctg  (z : complex) : complex;       (* tangente *)
-
-(* fonctions trigonometriques inverses *)
-function carc_cos (z : complex) : complex;   (* arc cosinus *)
-function carc_sin (z : complex) : complex;   (* arc sinus *)
-function carc_tg  (z : complex) : complex;   (* arc tangente *)
-
-(* fonctions trigonometrique hyperbolique *)
-function cch (z : complex) : complex;        (* cosinus hyperbolique *)
-function csh (z : complex) : complex;        (* sinus hyperbolique *)
-function cth (z : complex) : complex;        (* tangente hyperbolique *)
-
-(* fonctions trigonometrique hyperbolique inverse *)
-function carg_ch (z : complex) : complex;    (* arc cosinus hyperbolique *)
-function carg_sh (z : complex) : complex;    (* arc sinus hyperbolique *)
-function carg_th (z : complex) : complex;    (* arc tangente hyperbolique *)
-
-
-
-implementation
-
-(* quatre operations de base +, -, * , / *)
-
-operator + (z1, z2 : complex) z : complex;
-(* addition : z := z1 + z2 *)
-begin
-z.re := z1.re + z2.re;
-z.im := z1.im + z2.im;
-end;
-
-operator + (z1 : complex; r : real) z : complex;
-(* addition : z := z1 + r *)
-begin
-z.re := z1.re + r;
-z.im := z1.im;
-end;
-
-operator + (r : real; z1 : complex) z : complex;
-(* addition : z := r + z1 *)
-begin
-z.re := z1.re + r;
-z.im := z1.im;
-end;
-
-operator - (z1, z2 : complex) z : complex;
-(* substraction : z := z1 - z2 *)
-begin
-z.re := z1.re - z2.re;
-z.im := z1.im - z2.im;
-end;
-
-operator - (z1 : complex; r : real) z : complex;
-(* substraction : z := z1 - r *)
-begin
-z.re := z1.re - r;
-z.im := z1.im;
-end;
-
-operator - (r : real; z1 : complex) z : complex;
-(* substraction : z := r + z1 *)
-begin
-z.re := r - z1.re;
-z.im := - z1.im;
-end;
-
-operator * (z1, z2 : complex) z : complex;
-(* multiplication : z := z1 * z2 *)
-begin
-z.re := (z1.re * z2.re) - (z1.im * z2.im);
-z.im := (z1.re * z2.im) + (z1.im * z2.re);
-end;
-
-operator * (z1 : complex; r : real) z : complex;
-(* multiplication : z := z1 * r *)
-begin
-z.re := z1.re * r;
-z.im := z1.im * r;
-end;
-
-operator * (r : real; z1 : complex) z : complex;
-(* multiplication : z := r + z1 *)
-begin
-z.re := z1.re * r;
-z.im := z1.im * r;
-end;
-
-operator / (znum, zden : complex) z : complex;
-(* division : z := znum / zden *)
-var denom : real;
-begin
-with zden do denom := (re * re) + (im * im);
-if denom = 0.0
-   then begin
-        writeln('******** function Cdiv ********');
-        writeln('******* DIVISION BY ZERO ******');
-        runerror(200);
-        end
-   else begin
-        z.re := ((znum.re * zden.re) + (znum.im * zden.im)) / denom;
-        z.im := ((znum.im * zden.re) - (znum.re * zden.im)) / denom;
-        end;
-end;
-
-operator / (znum : complex; r : real) z : complex;
-(* division : z := znum / r *)
-begin
-if r = 0.0
-   then begin
-        writeln('******** function Cdiv ********');
-        writeln('******* DIVISION BY ZERO ******');
-        runerror(200);
-        end
-   else begin
-        z.re := znum.re / r;
-        z.im := znum.im / r;
-        end;
-end;
-
-operator / (r : real; zden : complex) z : complex;
-(* division : z := r / zden *)
-var denom : real;
-begin
-with zden do denom := (re * re) + (im * im);
-if denom = 0.0
-   then begin
-        writeln('******** function Cdiv ********');
-        writeln('******* DIVISION BY ZERO ******');
-        runerror(200);
-        end
-   else begin
-        z.re := (r * zden.re) / denom;
-        z.im := - (r * zden.im) / denom;
-        end;
-end;
-
-(* fonctions complexes particulieres *)
-
-function cneg (z : complex) : complex;
-(* negatif : cneg = - z *)
-begin
-cneg.re := - z.re;
-cneg.im := - z.im;
-end;
-
-function cmod (z : complex): real;
-(* module : r = |z| *)
-begin
-with z do cmod := sqrt((re * re) + (im * im))
-end;
-
-function carg (z : complex): real;
-(* argument : 0 / z = p ei0 *)
-begin
-carg := arctan2(z.re, z.im)
-end;
-
-function ccong (z : complex) : complex;
-(* conjuge : z := x + i.y alors r = x - i.y *)
-begin
-ccong.re := z.re;
-ccong.im := - z.im;
-end;
-
-function cinv (z : complex) : complex;
-(* inverse : r := 1 / z *)
-var denom : real;
-begin
-with z do denom := (re * re) + (im * im);
-if denom = 0.0
-   then begin
-        writeln('******** function Cinv ********');
-        writeln('******* DIVISION BY ZERO ******');
-        runerror(200);
-        end
-   else begin
-        cinv.re := z.re / denom;
-        cinv.im := - z.im / denom
-        end;
-end;
-
-function ciz (z : complex) : complex;
-(* multiplication par i *)
-(* z = x + i.y , r = i.z = - y + i.x *)
-begin
-ciz.re := - z.im;
-ciz.im := z.re;
-end;
-
-function c_iz (z : complex) : complex;
-(* multiplication par -i *)
-(* z = x + i.y , r = -i.z = y - i.x *)
-begin
-c_iz.re := z.im;
-c_iz.im := - z.re;
-end;
-
-function czero : complex;
-(* return a zero complex *)
-begin
-czero.re := 0.0;
-czero.im := 0.0;
-end;
-
-operator = (z1, z2 : complex) b : boolean;
-(* returns TRUE if z1 = z2 *)
-begin
-b := (z1.re = z2.re) and (z1.im = z2.im)
-end;
-
-operator = (z1 : complex; r :real) b : boolean;
-(* returns TRUE if z1 = r *)
-begin
-b := (z1.re = r) and (z1.im = 0.0)
-end;
-
-operator = (r : real; z1 : complex) b : boolean;
-(* returns TRUE if z1 = r *)
-begin
-b := (z1.re = r) and (z1.im = 0.0)
-end;
-
-
-(* fonctions elementaires *)
-
-function cexp (z : complex) : complex;
-(* exponantielle : r := exp(z) *)
-(* exp(x + iy) = exp(x).exp(iy) = exp(x).[cos(y) + i sin(y)] *)
-var expz : real;
-begin
-expz := exp(z.re);
-cexp.re := expz * cos(z.im);
-cexp.im := expz * sin(z.im);
-end;
-
-function cln (z : complex) : complex;
-(* logarithme naturel : r := ln(z) *)
-(* ln( p exp(i0)) = ln(p) + i0 + 2kpi *)
-var modz : real;
-begin
-with z do modz := (re * re) + (im * im);
-if modz = 0.0
-   then begin
-        writeln('********* function Cln *********');
-        writeln('****** LOGARITHME OF ZERO ******');
-        runerror(200)
-        end
-   else begin
-        cln.re := ln(modz);
-        cln.im := arctan2(z.re, z.im);
-        end
-end;
-
-function csqrt (z : complex) : complex;
-(* racine carre : r := sqrt(z) *)
-var root, q : real;
-begin
-if (z.re <> 0.0) or (z.im <> 0.0)
-   then begin
-        root := sqrt(0.5 * (abs(z.re) + cmod(z)));
-        q := z.im / (2.0 * root);
-        if z.re >= 0.0 then
-                begin
-                csqrt.re := root;
-                csqrt.im := q;
-                end
-           else if z.im < 0.0
-                   then
-                        begin
-                        csqrt.re := - q;
-                        csqrt.im := - root
-                        end
-                   else
-                        begin
-                        csqrt.re :=  q;
-                        csqrt.im :=  root
-                        end
-        end
-   else result := z;
-end;
-
-operator ^ (z1, z2 : complex) z : complex;
-(* multiplication : z := z1 * z2 *)
-begin
-z.re := (z1.re * z2.re) - (z1.im * z2.im);
-z.im := (z1.re * z2.im) + (z1.im * z2.re);
-end;
-
-operator * (z1 : complex; r : real) z : complex;
-(* multiplication : z := z1 * r *)
-begin
-z.re := z1.re * r;
-z.im := z1.im * r;
-end;
-
-operator * (r : real; z1 : complex) z : complex;
-(* multiplication : z := r + z1 *)
-begin
-z.re := z1.re * r;
-z.im := z1.im * r;
-end;
-
-(* fonctions trigonometriques directes *)
-
-function ccos (z : complex) : complex;
-(* cosinus complex *)
-(* cos(x+iy) = cos(x).cos(iy) - sin(x).sin(iy) *)
-(* cos(ix) = ch(x) et sin(ix) = i.sh(x) *)
-begin
-ccos.re := cos(z.re) * ch(z.im);
-ccos.im := - sin(z.re) * sh(z.im);
-end;
-
-function csin (z : complex) : complex;
-(* sinus complex *)
-(* sin(x+iy) = sin(x).cos(iy) + cos(x).sin(iy) *)
-(* cos(ix) = ch(x) et sin(ix) = i.sh(x) *)
-begin
-csin.re := sin(z.re) * ch(z.im);
-csin.im := cos(z.re) * sh(z.im);
-end;
-
-function ctg (z : complex) : complex;
-(* tangente *)
-var ccosz, temp : complex;
-begin
-ccosz := ccos(z);
-if (ccosz.re = 0.0) and (ccosz.im = 0.0)
-   then begin
-        writeln('********* function Ctg *********');
-        writeln('******* DIVISION BY ZERO ******');
-        runerror(200)
-        end
-   else begin
-        temp := csin(z);
-        ctg := temp / ccosz;
-        end
-end;
-
-(* fonctions trigonometriques inverses *)
-
-function carc_cos (z : complex) : complex;
-(* arc cosinus complex *)
-(* arccos(z) = -i.argch(z) *)
-begin
-z := carg_ch(z);
-carc_cos := c_iz(z);
-end;
-
-function carc_sin (z : complex) : complex;
-(* arc sinus complex *)
-(* arcsin(z) = -i.argsh(i.z) *)
-begin
-z := ciz(z);
-z := carg_sh(z);
-carc_sin := c_iz(z);
-end;
-
-function carc_tg (z : complex) : complex;
-(* arc tangente complex *)
-(* arctg(z) = -i.argth(i.z) *)
-begin
-z := ciz(z);
-z := carg_th(z);
-carc_tg := c_iz(z);
-end;
-
-(* fonctions trigonometriques hyperboliques *)
-
-function cch (z : complex) : complex;
-(* cosinus hyperbolique *)
-(* ch(x+iy) = ch(x).ch(iy) + sh(x).sh(iy) *)
-(* ch(iy) = cos(y) et sh(iy) = i.sin(y) *)
-begin
-cch.re := ch(z.re) * cos(z.im);
-cch.im := sh(z.re) * sin(z.im);
-end;
-
-function csh (z : complex) : complex;
-(* sinus hyperbolique *)
-(* sh(x+iy) = sh(x).ch(iy) + ch(x).sh(iy) *)
-(* ch(iy) = cos(y) et sh(iy) = i.sin(y) *)
-begin
-csh.re := sh(z.re) * cos(z.im);
-csh.im := ch(z.re) * sin(z.im);
-end;
-
-function cth (z : complex) : complex;
-(* tangente hyperbolique complex *)
-(* th(x) = sh(x) / ch(x) *)
-(* ch(x) > 1 qq x *)
-var temp : complex;
-begin
-temp := cch(z);
-z := csh(z);
-cth := z / temp;
-end;
-
-(* fonctions trigonometriques hyperboliques inverses *)
-
-function carg_ch (z : complex) : complex;
-(*   arg cosinus hyperbolique    *)
-(*                          _________  *)
-(* argch(z) = -/+ ln(z + i.V 1 - z.z)  *)
-var temp : complex;
-begin
-with temp do begin
-             re := 1 - z.re * z.re + z.im * z.im;
-             im := - 2 * z.re * z.im
-             end;
-temp := csqrt(temp);
-temp := ciz(temp);
-temp := temp + z;
-temp := cln(temp);
-carg_ch := cneg(temp);
-end;
-
-function carg_sh (z : complex) : complex;
-(*   arc sinus hyperbolique    *)
-(*                    ________  *)
-(* argsh(z) = ln(z + V 1 + z.z) *)
-var temp : complex;
-begin
-with temp do begin
-             re := 1 + z.re * z.re - z.im * z.im;
-             im := 2 * z.re * z.im
-             end;
-temp := csqrt(temp);
-temp := cadd(temp, z);
-carg_sh := cln(temp);
-end;
-
-function carg_th (z : complex) : complex;
-(* arc tangente hyperbolique *)
-(* argth(z) = 1/2 ln((z + 1) / (1 - z)) *)
-var temp : complex;
-begin
-with temp do begin
-             re := 1 + z.re;
-             im := z.im
-             end;
-with result do begin
-          re := 1 - re;
-          im := - im
-          end;
-result := temp / result;
-carg_th.re := 0.5 * re;
-carg_th.im := 0.5 * im
-end;
-
-end.
-{
-  $Log$
-  Revision 1.2  1998-05-12 10:42:44  peter
-    * moved getopts to inc/, all supported OS's need argc,argv exported
-    + strpas, strlen are now exported in the systemunit
-    * removed logs
-    * removed $ifdef ver_above
-
-}

+ 2 - 2
rtl/inc/readme

@@ -15,5 +15,5 @@ mathh.inc	Declarations of mathematical functions.
 
 
 The unit files are:
 The unit files are:
 
 
-complex.pp	Complex functions using operator overloading
-getops.pp	Pascal implementation of the GNU Getops
+ucomplex.pp	Complex functions using operator overloading
+getopts.pp	Pascal implementation of the GNU Getops

+ 642 - 0
rtl/inc/ucomplex.pp

@@ -0,0 +1,642 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1997,98 by Pierre Muller,
+    member of the Free Pascal development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+Unit UComplex;
+
+{ created for FPC by Pierre Muller }
+{ inpired from the complex unit from  JD GAYRARD mai 95 }
+{ FPC supports operator overloading }
+
+
+  interface
+
+    uses math;
+
+    type complex = record
+                     re : real;
+                     im : real;
+                   end;
+    
+    pcomplex = ^complex;
+    
+    const i : complex = (re : 0.0; im : 1.0);
+          _0 : complex = (re : 0.0; im : 0.0);
+    
+    
+    { assignment overloading is also used in type conversions
+      (beware also in implicit type conversions)
+      after this operator any real can be passed to a function
+      as a complex arg !! }
+      
+    operator := (r : real) z : complex;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    { operator := (i : longint) z : complex;
+      not needed because longint can be converted to real }
+    
+    
+    { four operator : +, -, * , /  and comparison = }
+    operator + (z1, z2 : complex) z : complex;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    { these ones are created because the code
+      is simpler and thus faster }
+    operator + (z1 : complex; r : real) z : complex;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    operator + (r : real; z1 : complex) z : complex;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    
+    operator - (z1, z2 : complex) z : complex;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    operator - (z1 : complex;r : real) z : complex;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    operator - (r : real; z1 : complex) z : complex;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    
+    operator * (z1, z2 : complex) z : complex;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    operator * (z1 : complex; r : real) z : complex;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    operator * (r : real; z1 : complex) z : complex;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    
+    operator / (znum, zden : complex) z : complex;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    operator / (znum : complex; r : real) z : complex;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    operator / (r : real; zden : complex) z : complex;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    { ** is the exponentiation operator }
+    operator ** (z1, z2 : complex) z : complex;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    operator ** (z1 : complex; r : real) z : complex;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    operator ** (r : real; z1 : complex) z : complex;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    
+    operator = (z1, z2 : complex) b : boolean;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    operator = (z1 : complex;r : real) b : boolean;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    operator = (r : real; z1 : complex) b : boolean;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    operator - (z1 : complex) z : complex;
+    {$ifdef TEST_INLINE}
+    inline;
+    {$endif TEST_INLINE}
+    
+    
+    { complex functions }
+    function cong (z : complex) : complex;      { conjuge }
+    
+    { complex functions with real return values }
+    function cmod (z : complex) : real;           { module }
+    function carg (z : complex) : real;           { argument : a / z = p.e^ia }
+    
+    { fonctions elementaires }
+    function cexp (z : complex) : complex;       { exponential }
+    function cln (z : complex) : complex;        { natural logarithm }
+    function csqrt (z : complex) : complex;      { square root }
+    
+    { complex trigonometric functions  }
+    function ccos (z : complex) : complex;       { cosinus }
+    function csin (z : complex) : complex;       { sinus }
+    function ctg  (z : complex) : complex;       { tangent }
+    
+    { inverse complex trigonometric functions }
+    function carc_cos (z : complex) : complex;   { arc cosinus }
+    function carc_sin (z : complex) : complex;   { arc sinus }
+    function carc_tg  (z : complex) : complex;   { arc tangent }
+    
+    { hyperbolic complex functions }
+    function cch (z : complex) : complex;        { hyperbolic cosinus }
+    function csh (z : complex) : complex;        { hyperbolic sinus }
+    function cth (z : complex) : complex;        { hyperbolic tangent }
+    
+    { inverse hyperbolic complex functions }
+    function carg_ch (z : complex) : complex;    { hyperbolic arc cosinus }
+    function carg_sh (z : complex) : complex;    { hyperbolic arc sinus }
+    function carg_th (z : complex) : complex;    { hyperbolic arc tangente }
+
+    { functions to write out a complex value }
+    function cstr(z : complex) : string;
+    function cstr(z:complex;len : integer) : string;
+    function cstr(z:complex;len,dec : integer) : string;
+    
+  implementation
+
+  operator := (r : real) z : complex;
+  {$ifdef TEST_INLINE}
+  inline;
+  {$endif TEST_INLINE}
+  
+    begin
+       z.re:=r;
+       z.im:=0.0;
+    end;
+    
+  { four base operations  +, -, * , / }
+  
+  operator + (z1, z2 : complex) z : complex;
+  {$ifdef TEST_INLINE}
+  inline;
+  {$endif TEST_INLINE}
+    { addition : z := z1 + z2 }
+    begin
+       z.re := z1.re + z2.re;
+       z.im := z1.im + z2.im;
+    end;
+  
+  operator + (z1 : complex; r : real) z : complex;
+  { addition : z := z1 + r }
+  {$ifdef TEST_INLINE}
+  inline;
+  {$endif TEST_INLINE}
+    begin
+       z.re := z1.re + r;
+       z.im := z1.im;
+    end;
+  
+  operator + (r : real; z1 : complex) z : complex;
+  { addition : z := r + z1 }
+  {$ifdef TEST_INLINE}
+  inline;
+  {$endif TEST_INLINE}
+  
+    begin
+       z.re := z1.re + r;
+       z.im := z1.im;
+    end;
+  
+  operator - (z1, z2 : complex) z : complex;
+  {$ifdef TEST_INLINE}
+  inline;
+  {$endif TEST_INLINE}
+    { substraction : z := z1 - z2 }
+    begin
+       z.re := z1.re - z2.re;
+       z.im := z1.im - z2.im;
+    end;
+  
+  operator - (z1 : complex; r : real) z : complex;
+  {$ifdef TEST_INLINE}
+  inline;
+  {$endif TEST_INLINE}
+    { substraction : z := z1 - r }
+    begin
+       z.re := z1.re - r;
+       z.im := z1.im;
+    end;
+  
+  operator - (z1 : complex) z : complex;
+  {$ifdef TEST_INLINE}
+  inline;
+  {$endif TEST_INLINE}
+    { substraction : z := - z1 }
+    begin
+       z.re := -z1.re;
+       z.im := -z1.im;
+    end;
+  
+  operator - (r : real; z1 : complex) z : complex;
+  {$ifdef TEST_INLINE}
+  inline;
+  {$endif TEST_INLINE}
+    { substraction : z := r - z1 }
+    begin
+       z.re := r - z1.re;
+       z.im := - z1.im;
+    end;
+  
+  operator * (z1, z2 : complex) z : complex;
+  { multiplication : z := z1 * z2 }
+  {$ifdef TEST_INLINE}
+  inline;
+  {$endif TEST_INLINE}
+    begin
+       z.re := (z1.re * z2.re) - (z1.im * z2.im);
+       z.im := (z1.re * z2.im) + (z1.im * z2.re);
+    end;
+  
+  operator * (z1 : complex; r : real) z : complex;
+  {$ifdef TEST_INLINE}
+  inline;
+  {$endif TEST_INLINE}
+    { multiplication : z := z1 * r }
+    begin
+       z.re := z1.re * r;
+       z.im := z1.im * r;
+    end;
+  
+  operator * (r : real; z1 : complex) z : complex;
+  {$ifdef TEST_INLINE}
+  inline;
+  {$endif TEST_INLINE}
+  { multiplication : z := r * z1 }
+    begin
+       z.re := z1.re * r;
+       z.im := z1.im * r;
+    end;
+  
+  operator / (znum, zden : complex) z : complex;
+  {$ifdef TEST_INLINE}
+  inline;
+  {$endif TEST_INLINE}
+    { division : z := znum / zden }
+    var
+       denom : real;
+    begin
+       with zden do denom := (re * re) + (im * im);
+       { generates a fpu exception if denom=0 as for reals }
+       z.re := ((znum.re * zden.re) + (znum.im * zden.im)) / denom;
+       z.im := ((znum.im * zden.re) - (znum.re * zden.im)) / denom;
+    end;
+  
+    operator / (znum : complex; r : real) z : complex;
+      { division : z := znum / r }
+      begin
+         z.re := znum.re / r;
+         z.im := znum.im / r;
+      end;
+  
+  operator / (r : real; zden : complex) z : complex;
+    { division : z := r / zden }
+    var denom : real;
+    begin
+       with zden do denom := (re * re) + (im * im);
+       { generates a fpu exception if denom=0 as for reals }
+       z.re := (r * zden.re) / denom;
+       z.im := - (r * zden.im) / denom;
+    end;
+  
+  function cmod (z : complex): real;
+    { module : r = |z| }
+    begin
+       with z do
+         cmod := sqrt((re * re) + (im * im));
+    end;
+  
+  function carg (z : complex): real;
+    { argument : 0 / z = p ei0 }
+    begin
+       carg := arctan2(z.re, z.im);
+    end;
+  
+  function cong (z : complex) : complex;
+    { complex conjugee :
+       if z := x + i.y
+       then cong is x - i.y }
+    begin
+       cong.re := z.re;
+       cong.im := - z.im;
+    end;
+  
+  function cinv (z : complex) : complex;
+    { inverse : r := 1 / z }
+    var
+       denom : real;
+    begin
+       with z do denom := (re * re) + (im * im);
+       { generates a fpu exception if denom=0 as for reals }
+       cinv.re:=z.re/denom;
+       cinv.im:=-z.im/denom;
+    end;
+  
+  operator = (z1, z2 : complex) b : boolean;
+    { returns TRUE if z1 = z2 }
+    begin
+       b := (z1.re = z2.re) and (z1.im = z2.im);
+    end;
+  
+  operator = (z1 : complex; r :real) b : boolean;
+    { returns TRUE if z1 = r }
+    begin
+       b := (z1.re = r) and (z1.im = 0.0)
+    end;
+    
+  operator = (r : real; z1 : complex) b : boolean;
+    { returns TRUE if z1 = r }
+    begin
+       b := (z1.re = r) and (z1.im = 0.0)
+    end;
+    
+  
+  { fonctions elementaires }
+  
+  function cexp (z : complex) : complex;
+    { exponantial : r := exp(z) }
+    { exp(x + iy) = exp(x).exp(iy) = exp(x).[cos(y) + i sin(y)] }
+    var expz : real;
+    begin
+       expz := exp(z.re);
+       cexp.re := expz * cos(z.im);
+       cexp.im := expz * sin(z.im);
+    end;
+  
+  function cln (z : complex) : complex;
+    { natural logarithm : r := ln(z) }
+    { ln( p exp(i0)) = ln(p) + i0 + 2kpi }
+    var modz : real;
+    begin
+       with z do
+         modz := (re * re) + (im * im);
+       cln.re := ln(modz);
+       cln.im := arctan2(z.re, z.im);
+    end;
+  
+  function csqrt (z : complex) : complex;
+    { square root : r := sqrt(z) }
+    var
+       root, q : real;
+    begin
+      if (z.re<>0.0) or (z.im<>0.0) then
+        begin
+           root := sqrt(0.5 * (abs(z.re) + cmod(z)));
+           q := z.im / (2.0 * root);
+           if z.re >= 0.0 then
+             begin
+                csqrt.re := root;
+                csqrt.im := q;
+             end
+           else if z.im < 0.0 then
+             begin
+                csqrt.re := - q;
+                csqrt.im := - root
+             end
+           else
+             begin
+                csqrt.re :=  q;
+                csqrt.im :=  root
+             end
+        end
+       else csqrt := z;
+    end;
+    
+  
+  operator ** (z1, z2 : complex) z : complex;
+    { exp : z := z1 ** z2 }
+    begin
+       z := cexp(z2*cln(z1));
+    end;
+
+  operator ** (z1 : complex; r : real) z : complex;
+    { multiplication : z := z1 * r }
+    begin
+       z := cexp( r *cln(z1));
+    end;
+  
+  operator ** (r : real; z1 : complex) z : complex;
+    { multiplication : z := r + z1 }
+    begin
+       z := cexp(z1*ln(r));
+    end;
+  
+  { direct trigonometric functions }
+  
+  function ccos (z : complex) : complex;
+    { complex cosinus }
+    { cos(x+iy) = cos(x).cos(iy) - sin(x).sin(iy) }
+    { cos(ix) = cosh(x) et sin(ix) = i.sinh(x) }
+    begin
+       ccos.re := cos(z.re) * cosh(z.im);
+       ccos.im := - sin(z.re) * sinh(z.im);
+    end;
+  
+  function csin (z : complex) : complex;
+    { sinus complex }
+    { sin(x+iy) = sin(x).cos(iy) + cos(x).sin(iy) }
+    { cos(ix) = cosh(x) et sin(ix) = i.sinh(x) }
+    begin
+       csin.re := sin(z.re) * cosh(z.im);
+       csin.im := cos(z.re) * sinh(z.im);
+    end;
+    
+  function ctg (z : complex) : complex;
+    { tangente }
+    var ccosz, temp : complex;
+    begin
+       ccosz := ccos(z);
+       temp := csin(z);
+       ctg := temp / ccosz;
+    end;
+  
+  { fonctions trigonometriques inverses }
+  
+  function carc_cos (z : complex) : complex;
+    { arc cosinus complex }
+    { arccos(z) = -i.argch(z) }
+    begin
+       carc_cos := -i*carg_ch(z);
+    end;
+    
+  function carc_sin (z : complex) : complex;
+    { arc sinus complex }
+    { arcsin(z) = -i.argsh(i.z) }
+    begin
+       carc_sin := -i*carg_sh(i*z);
+    end;
+  
+  function carc_tg (z : complex) : complex;
+    { arc tangente complex }
+    { arctg(z) = -i.argth(i.z) }
+    begin
+       carc_tg := -i*carg_th(i*z);
+    end;
+    
+  { hyberbolic complex functions }
+  
+  function cch (z : complex) : complex;
+    { hyberbolic cosinus }
+    { cosh(x+iy) = cosh(x).cosh(iy) + sinh(x).sinh(iy) }
+    { cosh(iy) = cos(y) et sinh(iy) = i.sin(y) }
+    begin
+       cch.re := cosh(z.re) * cos(z.im);
+       cch.im := sinh(z.re) * sin(z.im);
+    end;
+  
+  function csh (z : complex) : complex;
+    { hyberbolic sinus }
+    { sinh(x+iy) = sinh(x).cosh(iy) + cosh(x).sinh(iy) }
+    { cosh(iy) = cos(y) et sinh(iy) = i.sin(y) }
+    begin
+       csh.re := sinh(z.re) * cos(z.im);
+       csh.im := cosh(z.re) * sin(z.im);
+    end;
+  
+  function cth (z : complex) : complex;
+    { hyberbolic complex tangent }
+    { th(x) = sinh(x) / cosh(x) }
+    { cosh(x) > 1 qq x }
+    var temp : complex;
+    begin
+       temp := cch(z);
+       z := csh(z);
+       cth := z / temp;
+    end;
+  
+  { inverse complex hyperbolic functions }
+  
+  function carg_ch (z : complex) : complex;
+    {   hyberbolic arg cosinus }
+    {                          _________  }
+    { argch(z) = -/+ ln(z + i.V 1 - z.z)  }
+    begin
+       carg_ch:=-cln(z+i*csqrt(z*z-1.0));
+    end;
+  
+  function carg_sh (z : complex) : complex;
+    {   hyperbolic arc sinus       }
+    {                    ________  }
+    { argsh(z) = ln(z + V 1 + z.z) }
+    begin
+       carg_sh:=cln(z+csqrt(z*z+1.0));
+    end;
+  
+  function carg_th (z : complex) : complex;
+    { hyperbolic arc tangent }
+    { argth(z) = 1/2 ln((z + 1) / (1 - z)) }
+    begin
+       carg_th:=cln((z+1.0)/(z-1.0))/2.0;
+    end;
+  
+  { functions to write out a complex value }
+  function cstr(z : complex) : string;
+    var
+       istr : string;
+    begin
+       str(z.im,istr);
+       str(z.re,cstr);
+       while istr[1]=' ' do
+         delete(istr,1,1);
+       if z.im<0 then
+         cstr:=cstr+istr+'i'
+       else if z.im>0 then
+         cstr:=cstr+'+'+istr+'i';
+    end;
+    
+    function cstr(z:complex;len : integer) : string;
+    var
+       istr : string;
+    begin
+       str(z.im:len,istr);
+       while istr[1]=' ' do
+         delete(istr,1,1);
+       str(z.re:len,cstr);
+       if z.im<0 then
+         cstr:=cstr+istr+'i'
+       else if z.im>0 then
+         cstr:=cstr+'+'+istr+'i';
+    end;
+    
+    function cstr(z:complex;len,dec : integer) : string;
+    var
+       istr : string;
+    begin
+       str(z.im:len:dec,istr);
+       while istr[1]=' ' do
+         delete(istr,1,1);
+       str(z.re:len:dec,cstr);
+       if z.im<0 then
+         cstr:=cstr+istr+'i'
+       else if z.im>0 then
+         cstr:=cstr+'+'+istr+'i';
+    end;
+    
+    
+end.
+{
+  $Log$
+  Revision 1.1  1998-06-15 15:45:42  pierre
+    + complex.pp replaced by ucomplex.pp
+      complex operations working
+
+  Revision 1.1.1.1  1998/03/25 11:18:43  root
+  * Restored version
+
+  Revision 1.3  1998/01/26 11:59:25  michael
+  + Added log at the end
+
+
+  
+  Working file: rtl/inc/complex.pp
+  description:
+  ----------------------------
+  revision 1.2
+  date: 1997/12/01 15:33:30;  author: michael;  state: Exp;  lines: +14 -0
+  + added copyright reference in header.
+  ----------------------------
+  revision 1.1
+  date: 1997/11/27 08:33:46;  author: michael;  state: Exp;
+  Initial revision
+  ----------------------------
+  revision 1.1.1.1
+  date: 1997/11/27 08:33:46;  author: michael;  state: Exp;  lines: +0 -0
+  FPC RTL CVS start
+  =============================================================================
+}