Turbo Toolbox/Turbo_Toolbox.iso/sonderh1/complex.inc

Text File | 1987-02-03 | 10KB | 335 lines

(*****************************************************************************)
(*                                                                           *)
(*         COMPLEX.INC - Modul zur Verarbeitung von komplexen Zahlen         *)
(*                                                                           *)
(*                           ---  Vers 4.1  ---                              *)
(*                                                                           *)
(*****************************************************************************)


Type Complex   = String [12];
     CString   = String [40];
     Dummy     = Record
                    StrLen    :Byte;
                    RealPart,
                    ImagPart  :Real
                 End;


Const i1 :Complex = #0#0#0#0#0#0#129#0#0#0#0#0;       (* imaginaere Einheit  *)
      r1 :Complex = #129#0#0#0#0#0#0#0#0#0#0#0;       (* die reelle Zahl "1" *)


(***********************  Komplexe Transferroutinen  *************************)

(* ------------------------------------------------------------------------- *)
(*                      Realteil einer komplexen Zahl                        *)
(* ------------------------------------------------------------------------- *)

Function Re (z :Complex) :Real;

   Var ComplStr :Complex;
       Rec      :Dummy absolute ComplStr;

   Begin
   ComplStr := z;
   Re := Rec.RealPart
   End;


(* ------------------------------------------------------------------------- *)
(*                    Imaginaerteil einer komplexen Zahl                     *)
(* ------------------------------------------------------------------------- *)

Function Im (z :Complex) :Real;

   Var ComplStr :Complex;
       Rec      :Dummy absolute ComplStr;

   Begin
   ComplStr := z;
   Im := Rec.ImagPart
   End;


(* ------------------------------------------------------------------------- *)
(*          Zusammenfuegen zweier reeller Zahlen zu einer komplexen          *)
(* ------------------------------------------------------------------------- *)

Function cval (Re,Im :Real) :Complex;

   Var Rec      :Dummy;
       ComplStr :Complex absolute Rec;

   Begin
   Rec.StrLen   := SizeOf (Real) shl 1;
   Rec.RealPart := Re;
   Rec.ImagPart := Im;
   cval := ComplStr
   End;


(* ------------------------------------------------------------------------- *)
(*           Umwandlung eines Eingabe-Strings ins COMPLEX-Format             *)
(* ------------------------------------------------------------------------- *)

Function Value (InputString :CString) :Complex;

   Var Re,Im       :Real;
       p,
       RealResult,
       ImagResult  :Integer;
       valid       :Boolean;
       c           :CString;

   Begin
   c := InputString;
   While Pos(' ',c) > 0 do Delete (c,Pos(' ',c),1);
   If c[Length(c)]<>'i' then
      Begin
      Im := 0;
      Val (c,Re,RealResult);
      valid := (RealResult=0)
      End
   else
      Begin
      Re := 0;
      Delete (c,Length(c),1);
      If (c='') or (c[Length(c)] in ['+','-'])
         then c := c + '1';
      Val (c,Im,p);
      valid := (p=0);
      If not valid then
         Begin
         Val (Copy(c,1,pred(p)), Re, RealResult);
         If c[p]='+' then p := succ (p);
         Val (Copy(c,p,Length(c)), Im, ImagResult);
         valid := (RealResult + ImagResult = 0)
         End
      End;
   If valid then
      Value := cval (Re,Im)
   else
      Begin
      WriteLn (^M^J'Error:  invalid complex number "',InputString,'"');
      Halt
      End
   End;


(*************************  Komplexe IO-Routinen  ****************************)

(* ------------------------------------------------------------------------- *)
(*                      Ausgeben einer komplexen Zahl                        *)
(* ------------------------------------------------------------------------- *)

Procedure WriteC (Var Medium :Text; z :Complex; m,n :Byte);

   Var OutStr,ImagStr :CString;
       k              :Integer;

   Begin
   Str (Re(z):m:n,OutStr);
   While OutStr[1]=' ' do Delete (OutStr,1,1);
   If Im(z) >= 0 then
      OutStr := OutStr + '+'
   else
      OutStr := OutStr + '-';
   Str (Abs(Im(z)):m:n,ImagStr);
   While ImagStr[1]=' ' do Delete (ImagStr,1,1);
   OutStr := OutStr + ImagStr + 'i';
   For k:=1 to (m-Length(OutStr)) do
       OutStr := ' ' + OutStr;
   Write (Medium,OutStr)
   End;


Procedure WriteLnC (Var Medium :Text; z :Complex; m,n :Byte);

   Begin
   WriteC (Medium,z,m,n);
   WriteLn (Medium);
   End;


(* ------------------------------------------------------------------------- *)
(*                      Einlesen einer komplexen Zahl                        *)
(* ------------------------------------------------------------------------- *)

Procedure ReadC (Var Medium :Text; Var z :Complex);

   Var InputString :CString;
       Character   :Char;
       TermChars   :Set of Char;

   Begin
   InputString := '';
   If Addr(Medium) = Addr(CON) then        (* Ist Eingabemedium die Konsole? *)
      TermChars := [^M,^Z,#33..#127]
   else
      TermChars := [^Z,#33..#127];
   Repeat
      Read (Medium,Character)
   until Character in TermChars;
   While ord (Character) in [33..127] do
      Begin
      InputString := InputString + Character;
      Read (Medium,Character)
      End;
   If InputString<>'' then z := Value (InputString)
   End;


Procedure ReadLnC (Var Medium :Text; Var z :Complex);

   Begin
   ReadC (Medium,z);
   ReadLn (Medium);
   End;


(************************  Komplexe Rechenroutinen  **************************)

(* ------------------------------------------------------------------------- *)
(*                Komplex konjugiertes einer komplexen Zahl                  *)
(* ------------------------------------------------------------------------- *)

Function conj (z :Complex) :Complex;

   Begin
   conj := cval (Re(z),-Im(z));
   End;


(* ------------------------------------------------------------------------- *)
(*                   Absolutbetrag einer komplexen Zahl                      *)
(* ------------------------------------------------------------------------- *)

Function cabs (z :Complex) :Real;

   Begin
   cabs := sqrt (sqr(Re(z)) + sqr(Im(z)))
   End;


(* ------------------------------------------------------------------------- *)
(*          Transformation:   z = x + iy   --->   z = r*exp(i*phi)           *)
(* ------------------------------------------------------------------------- *)

Procedure polar (z :Complex; Var r,phi :Real);

   Begin
   r   := cabs (z);
   If r<>0 then
      If abs(Im(z)/r)=1 then
         phi := pi/2 * (Im(z)/r)/abs(Im(z)/r)
      else
         phi := arctan ((Im(z))/Re(z))
   else
      phi := 0;
   If Re(z)<0 then
      If Im(z)<>0 then
         phi := phi + pi * abs(Im(z))/Im(z)
      else
         phi := pi
   End;


(* ------------------------------------------------------------------------- *)
(*          Transformation:   z = r*exp(i*phi)   --->   z = x + iy           *)
(* ------------------------------------------------------------------------- *)

Function rect (r,phi :Real) :Complex;

   Begin
   rect := cval (r*cos(phi), r*sin(phi))
   End;


(* ------------------------------------------------------------------------- *)
(*         Division einer komplexen Zahl durch eine reelle Konstante         *)
(* ------------------------------------------------------------------------- *)

Function divk (z :Complex; k :Real) :Complex;

   Begin
   divk := cval (Re(z)/k, Im(z)/k)
   End;


(* ------------------------------------------------------------------------- *)
(*     Multiplikation einer komplexen Zahl mit einer reellen Konstanten      *)
(* ------------------------------------------------------------------------- *)

Function multk (z :Complex; k :Real) :Complex;

   Begin
   multk := cval (Re(z)*k, Im(z)*k)
   End;


(* ------------------------------------------------------------------------- *)
(*                           Komplexe Addition                               *)
(* ------------------------------------------------------------------------- *)

Function cadd (a,b :Complex) :Complex;

   Begin
   cadd := cval (Re(a)+Re(b), Im(a)+Im(b))
   End;


(* ------------------------------------------------------------------------- *)
(*                         Komplexe Subtraktion                              *)
(* ------------------------------------------------------------------------- *)

Function csub (a,b :Complex) :Complex;

   Begin
   csub := cval (Re(a)-Re(b), Im(a)-Im(b))
   End;


(* ------------------------------------------------------------------------- *)
(*                        Komplexe Multiplikation                            *)
(* ------------------------------------------------------------------------- *)

Function cmult (a,b :Complex) :Complex;

   Begin
   cmult := cval (Re(a)*Re(b)-Im(a)*Im(b), Re(a)*Im(b)+Im(a)*Re(b))
   End;


(* ------------------------------------------------------------------------- *)
(*                           Komplexe Division                               *)
(* ------------------------------------------------------------------------- *)

Function cdiv (a,b :Complex) :Complex;

   Begin
   cdiv := divk (cmult(a,conj(b)), sqr(cabs(b)));
   End;


(* ------------------------------------------------------------------------- *)
(*                      Kehrwert einer komplexen Zahl                        *)
(* ------------------------------------------------------------------------- *)

Function cinv (z :Complex) :Complex;

   Begin
   cinv := divk (conj(z), sqr(cabs(z)))
   End;


(* ------------------------------------------------------------------------- *)
(*                  Negieren einer komplexen Zahl (z := -z)                  *)
(* ------------------------------------------------------------------------- *)

Function cneg (z :Complex) :Complex;

   Begin
   cneg := cval (-Re(z),-Im(z))
   End;