IMPLEMENTATION MODULE CmplxMath;
(*------------------------------------------------------------------------*)
(* Einige Routinen fuer grundlegende komplexe Arithmetik. *)
(* Some routinen for basic complex arithmetic. *)
(*------------------------------------------------------------------------*)
(* Letzte Veraenderung *)
(* *)
(* 16.01.17, MRi: Erstellen der ersten Verion *)
(*------------------------------------------------------------------------*)
(* Implementation : Michael Riedl *)
(* Licence : GNU Lesser General Public License (LGPL) *)
(*------------------------------------------------------------------------*)
(* $Id: CmplxMath.mod,v 1.1 2017/09/27 08:15:18 mriedl Exp mriedl $ *)
IMPORT Errors;
PROCEDURE CDIV( ar,ai : LONGREAL;
br,bi : LONGREAL;
VAR cr,ci : LONGREAL);
VAR tmp: LONGREAL;
BEGIN
IF ((br = 0.0) AND (bi = 0.0)) THEN
Errors.FatalError('denominator of complex division is null');
ELSE
IF (ABS(br) > ABS(bi)) THEN
tmp := bi / br;
br := tmp*bi + br;
cr := (ar + tmp*ai) / br;
ci := (ai - tmp*ar) / br
ELSE
tmp := br / bi;
bi := tmp*br + bi;
cr := (tmp*ar + ai) / bi;
ci := (tmp*ai - ar) / bi;
END;
END;
END CDIV;
PROCEDURE CMUL( Xr,Xi : LONGREAL;
Yr,Yi : LONGREAL;
VAR Zr,Zi : LONGREAL);
BEGIN
Zr := Xr*Yr - Xi*Yi;
Zi := Xr*Yi + Xi*Yr;
END CMUL;
PROCEDURE CMULconj( Xr,Xi : LONGREAL;
Yr,Yi : LONGREAL;
VAR Zr,Zi : LONGREAL);
BEGIN
Zr := Xr*Yr + Xi*Yi;
Zi := Xi*Yr - Xr*Yi ;
END CMULconj;
PROCEDURE CABS(ar,ai : LONGREAL) : LONGREAL;
VAR p,r,s,t,u,su : LONGREAL;
BEGIN
IF (ABS(ar) >= ABS(ai)) THEN
p:=ABS(ar);
ELSE
p:=ABS(ai);
END;
IF (p <> 0.0) THEN
IF (ABS(ar) >= ABS(ai)) THEN
r:=ABS(ai);
ELSE
r:=ABS(ar);
END;
r:=r / p; r:=r*r;
LOOP
t := 4.0 + r;
IF (t = 4.0) THEN EXIT; END;
s := r / t;
u := 1.0 + 2.0*s;
p := u*p;
su := s / u;
r := (su*su)*r;
END;
END;
RETURN p;
END CABS;
END CmplxMath.