(*********************************************************************
 
    :Program.  	 LongComplexLib.mod
    :Author.   	 Gary Struhlik  
    :Address.    -
    :Phone.      -
    :shortcut. 	 [gs]
    :Version.  	 1.0   
    :Date.     	 08.10.1988
    :Copyright.  PD
    :Language. 	 Modula-II
    :Translator. M2Amiga
    :Imports.	 LongMathLibExt [gs]
    :UpDate.	 -
    :Contents.   Dieses Modul unterstützt das Rechnen mit komplexen Zahlen 
    :Contents.   Es werden die Grundrechenarten und wichtige mathematische
    :Contents.   Funktionen zur Verfügung gestellt, welche in den Bereichen
    :Contents.   Naturwissenschaft und Technik häufig benötigt werden.
    :Remark.	 Für den Amiga Modula-2 Klub / Stuttgart
    :Remark.     Am 01.01.1989 mit M2Amiga 3.2d neu kompiliert

**********************************************************************)

IMPLEMENTATION MODULE LongComplexLib;  (* für LONGREAL *)

FROM MathLibLong IMPORT sin,cos,ln,exp,arctan,sqrt;
FROM LongMathLibExt IMPORT sinh,cosh; 

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*  PROCEDURE: compop                                                      *)
(*                                                                         *)
(*  AUFGABE: Grundrechenarten mit komplexen Zahlen [ +, -, *, / ]          *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)  

PROCEDURE compop (VAR Z:LONGCOMPLEX; A:LONGCOMPLEX; OP:CHAR; B:LONGCOMPLEX); 
VAR
   	Y : LONGREAL;        (*      Z:=A OP B      *)
BEGIN                    (* mit OP +,-,* oder / *) 
	CASE OP OF

	'+' :  (* Addition *)
		Z.RE:=A.RE+B.RE;   
		Z.IM:=A.IM+B.IM
	      |
	'-' : (* Subtraktion *)
		Z.RE:=A.RE-B.RE;
		Z.IM:=A.IM-B.IM
	      |
	'*' : (* Multiplikation *)
		Z.RE:=A.RE*B.RE-A.IM*B.IM;
		Z.IM:=A.IM*B.RE+A.RE*B.IM
	      |
 	'/' : (* Division *)
		Y:=B.RE*B.RE+B.IM*B.IM;
		Z.RE:=(A.RE*B.RE+A.IM*B.IM)/Y;
		Z.IM:=(A.IM*B.RE-A.RE*B.IM)/Y
	END (* CASE OP OF *)
END compop;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: conjg                                                        *)
(*                                                                         *)
(* AUFGABE: konjugiert komplexe Zahl                                       *)
(*-------------------------------------------------------------------------*)

PROCEDURE conjg (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX); 
BEGIN
	Z.RE:=A.RE;   (* Z:=conjg(A) *)
	Z.IM:=-A.IM
END conjg;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* FUNCTION: cabs                                                          *)
(*                                                                         *)
(* AUFGABE: Betrag der komplexen Zahl                                      *)
(*-------------------------------------------------------------------------*)

PROCEDURE cabs (A : LONGCOMPLEX) : LONGREAL; 
BEGIN
	RETURN sqrt(A.RE*A.RE+A.IM*A.IM)     (* Y:=cabs(A); Y ist reell *)
END cabs;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* FUNCTION: carg                                                          *)
(*                                                                         *)
(* AUFGABE: Winkel der komplexen Zahl im Bogenmaß                          *)
(*-------------------------------------------------------------------------*)

PROCEDURE carg (A : LONGCOMPLEX) : LONGREAL;	
VAR
	X : LONGREAL;          (* Y:=carg(A); Y ist reell *)
BEGIN	
	IF ((A.RE=0.0) AND (A.IM<0.0)) THEN X:=-PI/2.0
	   ELSE
	      IF ((A.RE=0.0) AND (A.IM>0.0)) THEN X:=PI/2.0
		 ELSE IF
		    ((A.RE<0.0) AND (A.IM=0.0)) THEN X:=PI
	            ELSE 
	   		   X:=arctan (A.IM/A.RE);
			   IF (A.RE<0.0) AND (A.IM>0.0) THEN
			      X:=PI+X;
                           END;   
			   IF (A.RE<0.0) AND (A.IM<0.0) THEN
			      X:=-PI+X
                           END
                    END
              END
        END;                 
	RETURN X
END carg;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: cpol                                                         *)
(*                                                                         *)
(* AUFGABE: Umwandlung komplexer Zahlen von Normalform in Exponentialform  *)
(* Wichtig: Der Winkel wird in Grad ausgegeben !                           *)
(*-------------------------------------------------------------------------*)

PROCEDURE cpol (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX); 
        (* Hinweis: Z.RE ist der Betrag und Z.IM der Winkel ! *)
	(* Z:=cpol(A) *)
BEGIN    
	Z.RE:=sqrt(A.RE*A.RE+A.IM*A.IM); (* Betrag der komplexen Zahl *)
	Z.IM:=carg(A)*180.0/PI; (* Winkel in Grad ! *)
END cpol;		

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: crec                                                         *)
(*                                                                         *)
(* AUFGABE: Umwandlung komplexer Zahlen von Exponentialform in Normalform  *)
(* Wichtig: Der Winkel muß in Grad übergeben werden !                      *)
(*-------------------------------------------------------------------------*)

PROCEDURE crec (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX); 
VAR
	X : LONGREAL;  (* Hinweis: A.RE ist der Betrag und A.IM der Winkel ! *)
	(* Z:=crec(A) *)
BEGIN
	X:=PI/180.0*A.IM; (* Umwandlung von Grad in Bogenmaß *)
	Z.RE:=A.RE*cos(X); (* Realteil *)	
	Z.IM:=A.RE*sin(X); (* Imaginärteil *)
END crec;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: crcp                                                         *)
(*                                                                         *)
(* AUFGABE: Kehrwert der komplexen Zahl                                    *)
(*-------------------------------------------------------------------------*)

PROCEDURE crcp (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX); 
VAR
	X : LONGREAL;        (* Z:=crcp(A) *)
BEGIN
	X:=A.RE*A.RE+A.IM*A.IM;
	Z.RE:=A.RE/X; 
	Z.IM:=-A.IM/X
END crcp;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: cexp                                                         *)
(*                                                                         *)
(* AUFGABE: komplexe Exponentialfunktion                                   *)
(*-------------------------------------------------------------------------*)

PROCEDURE cexp (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX); 
VAR
	X : LONGREAL;  (* Z:=cexp(A) *)
BEGIN
	X:=exp(A.RE);
	Z.RE:=X*cos(A.IM);
	Z.IM:=X*sin(A.IM)
END cexp;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: cln                                                          *)
(*                                                                         *)
(* AUFGABE: komplexer natürlicher Logarithmus                              *)
(*-------------------------------------------------------------------------*)

PROCEDURE cln (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX); 
BEGIN                                              (* Z:=cln(A) *)
	Z.RE:=(ln (A.RE*A.RE+A.IM*A.IM))/2.0;
	Z.IM:=carg(A)
END cln;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: csqr                                                         *)
(*                                                                         *)
(* AUFGABE: quadrierte komplexe Zahl                                       *)
(*-------------------------------------------------------------------------*)

PROCEDURE csqr (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX); 
BEGIN                                      (* Z:=csqr(A) *)
	Z.RE:=A.RE*A.RE-A.IM*A.IM;
	Z.IM:=2.0*A.RE*A.IM
END csqr;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* FUNCTION : root                                                         *)
(*                                                                         *)
(* AUFGABE: n-te reelle Wurzel                                             *)
(*-------------------------------------------------------------------------*)

PROCEDURE root (N,X : LONGREAL) : LONGREAL;
BEGIN
	RETURN exp(ln(X)/N)   (* N-te Wurzel aus X *)
END root;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: csqrt                                                        *)
(*                                                                         *)
(* AUFGABE: komplexe Quadratwurzel (nur Hauptwert ! )                      *)
(*-------------------------------------------------------------------------*)

PROCEDURE csqrt (VAR Z:LONGCOMPLEX; A : LONGCOMPLEX); 
		(* Z:=csqrt(A); nur Hauptwert (k=0) *)
VAR
	R,PHI,KONST : LONGREAL;
BEGIN
	R:=sqrt(cabs(A)); (* Betrag von A *)
	PHI:=carg(A); (* Winkel von A im Bogenmaß *)
	KONST:=PHI/2.0;
	Z.RE:=R*cos(KONST);
	Z.IM:=R*sin(KONST)
END csqrt; 


(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: csin                                                         *)
(*                                                                         *)
(* AUFGABE: komplexer Sinus                                                *)
(*-------------------------------------------------------------------------*)

PROCEDURE csin (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX); 
BEGIN                                  (* Z:=csin(A) *)
	Z.RE:=sin(A.RE)*cosh(A.IM);
	Z.IM:=cos(A.RE)*sinh(A.IM)
END csin;	

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: carcsin                                                      *)
(*                                                                         *)
(* AUFGABE: komplexer Arkussinus                                           *)
(*-------------------------------------------------------------------------*)

PROCEDURE carcsin (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX); 
VAR 
	B,C,D,E : LONGCOMPLEX;              (* Z:=carcsin(A) *)
BEGIN
	B.RE:=0.0; B.IM:=1.0;
	C.RE:=1.0; C.IM:=0.0;
	csqr(E,A); compop(D,C,'-',E); csqrt(D,D); compop(E,B,'*',A);
	compop(D,D,'+',E); cln(E,D); compop(D,B,'*',E);
	Z.RE:=-D.RE;
	Z.IM:=-D.IM
END carcsin;
	
(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: ccos                                                         *)
(*                                                                         *)
(* AUFGABE: komplexer Kosinus                                              *)
(*-------------------------------------------------------------------------*)

PROCEDURE ccos (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX); 
BEGIN                                   (* Z:=ccos(A) *)
	Z.RE:=cos(A.RE)*cosh(A.IM);
	Z.IM:=-sin(A.RE)*sinh(A.IM)
END ccos;		

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: carccos                                                      *)
(*                                                                         *)
(* AUFGABE: komplexer Arkuskosinus                                         *)
(*-------------------------------------------------------------------------*)

PROCEDURE carccos (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX); 
VAR 
	B,C,D,E : LONGCOMPLEX;
BEGIN                              (* Z:=carccos(A) *)
	B.RE:=0.0; B.IM:=1.0;
	C.RE:=1.0; C.IM:=0.0;
	csqr(E,A); compop(D,E,'-',C); csqrt(D,D); compop(D,A,'+',D);
	cln(E,D); compop(D,B,'*',E);
	Z.RE:=-D.RE;
	Z.IM:=-D.IM
END carccos;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: ctan                                                         *)
(*                                                                         *)
(* AUFGABE: komplexer Tangens                                              *)
(*-------------------------------------------------------------------------*)

PROCEDURE ctan (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX); 
VAR
	X : LONGREAL;
BEGIN                                      (* Z:=ctan(A) *)
	X:=cos(2.0*A.RE)+cosh(2.0*A.IM);
	Z.RE:=sin(2.0*A.RE)/X;
	Z.IM:=sinh(2.0*A.IM)/X
END ctan;	

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: carctan                                                      *)
(*                                                                         *)
(* AUFGABE: komplexer Arkustangens                                         *)
(*-------------------------------------------------------------------------*)

PROCEDURE carctan (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX);
VAR 
	B,C,D,E,F,U,V : LONGCOMPLEX;
BEGIN                                   (* Z:=carctan(A) *)
	B.RE:=0.0; B.IM:=1.0;
	C.RE:=1.0; C.IM:=0.0;
	F.RE:=0.0; F.IM:=-0.5;
	compop(U,B,'*',A); 
	compop(E,C,'-',U); compop(D,C,'+',U); compop(V,D,'/',E);
	cln(E,V); compop(D,F,'*',E); 
	Z.RE:=D.RE;
	Z.IM:=D.IM
END carctan;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: csinh                                                        *)
(*                                                                         *)
(* AUFGABE: komplexer Hyperbelsinus                                        *)
(*-------------------------------------------------------------------------*)

PROCEDURE csinh (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX); 
BEGIN                                  (* Z:=csinh(A) *)
	Z.RE:=sinh(A.RE)*cos(A.IM);
	Z.IM:=cosh(A.RE)*sin(A.IM)
END csinh;		

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: carsinh                                                      *)
(*                                                                         *)
(* AUFGABE: komplexer Areasinus                                            *)
(*-------------------------------------------------------------------------*)

PROCEDURE carsinh (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX); 
VAR 
	B,C,D,E : LONGCOMPLEX;              (* Z:=carsinh(A) *)
BEGIN
	B.RE:=0.0; B.IM:=1.0;
	C.RE:=1.0; C.IM:=0.0;
	csqr(E,A); compop(D,C,'+',E); csqrt(D,D); compop(D,D,'+',A);
	cln(D,D);
	Z.RE:=D.RE;
	Z.IM:=D.IM
END carsinh;
	
(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: ccosh                                                        *)
(*                                                                         *)
(* AUFGABE: komplexer Hyperbelkosinus                                      *)
(*-------------------------------------------------------------------------*)

PROCEDURE ccosh (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX); 
BEGIN                                      (* Z:=ccosh(A) *)
	Z.RE:=cosh(A.RE)*cos(A.IM);
	Z.IM:=sinh(A.RE)*sin(A.IM)
END ccosh;		

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: carcosh                                                      *)
(*                                                                         *)
(* AUFGABE: komplexer Areakosinus                                          *)
(*-------------------------------------------------------------------------*)

PROCEDURE carcosh (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX); 
VAR 
	B,C,D,E : LONGCOMPLEX;            (* Z:=carcosh(A) *)
BEGIN
	B.RE:=0.0; B.IM:=1.0;
	C.RE:=1.0; C.IM:=0.0;
	csqr(E,A); compop(D,E,'-',C); csqrt(D,D); compop(D,A,'+',D);
	cln(D,D); 
	Z.RE:=D.RE;
	Z.IM:=D.IM
END carcosh;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: ctanh                                                        *)
(*                                                                         *)
(* AUFGABE: komplexer Hyperbeltangens                                      *)
(*-------------------------------------------------------------------------*)

PROCEDURE ctanh (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX);
VAR
	X : LONGREAL;                      (* Z:=ctanh(A) *)
BEGIN
	X:=cosh(2.0*A.RE)+cos(2.0*A.IM);
	Z.RE:=sinh(2.0*A.RE)/X;
	Z.IM:=sin(2.0*A.IM)/X
END ctanh;		

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: cartanh                                                      *)
(*                                                                         *)
(* AUFGABE: komplexer Areatangens                                          *)
(*-------------------------------------------------------------------------*)

PROCEDURE cartanh (VAR Z : LONGCOMPLEX; A : LONGCOMPLEX); 
VAR 
	C,D,E,V : LONGCOMPLEX;            (* Z:=cartanh(A) *)
BEGIN
	C.RE:=1.0; C.IM:=0.0;
 	compop(E,C,'-',A); compop(D,C,'+',A); compop(V,D,'/',E);
	cln(D,V);  
	Z.RE:=D.RE/2.0;
	Z.IM:=D.IM/2.0
END cartanh;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: cpower                                                       *)
(*                                                                         *)
(* AUFGABE: komplexe Potenzfunktion                                        *)
(*-------------------------------------------------------------------------*)

PROCEDURE cpower (VAR Z : LONGCOMPLEX; A,B : LONGCOMPLEX); 
                  (* Z:=A^B *)
VAR
	X : LONGCOMPLEX;
BEGIN
	cln(X,A); compop(X,B,'*',X); cexp(Z,X)
END cpower;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(* PROCEDURE: croot                                                        *)
(*                                                                         *)
(* AUFGABE: n-te komplexe Wurzel mit Haupt- und Nebenwerten                *)
(*-------------------------------------------------------------------------*)

PROCEDURE croot (VAR Z:LONGCOMPLEX; K,N:LONGREAL; A : LONGCOMPLEX); 
		(* Z:=N-te Wurzel(A); mit Haupt- und Nebenwert K *)
VAR
	R,PHI,KONST : LONGREAL;
BEGIN
	R:=root(N,cabs(A)); (* Betrag von A *)
	PHI:=carg(A); (* Winkel von A im Bogenmaß *)
	KONST:=(PHI+2.0*K*PI)/N;
	Z.RE:=R*cos(KONST);
	Z.IM:=R*sin(KONST)
END croot;

END LongComplexLib.