(*==========================================================================*)
(*                                                                          *)
(*  PASCAL-XSC - MODUL  ICF_ARI                                     000221  *)
(*                                                                          *)
(*  MODUL FšR EINIGE KOMPLEXE STANDARDFUNKTIONEN                            *)
(*                                                                          *)
(*==========================================================================*)

MODULE icf_ari;

USE i_ari , c_ari , ci_ari;

CONST PI = 3.1415926535897932;

(*----------------------------------------------------------------------*)

GLOBAL FUNCTION ARG( Z: COMPLEX) : REAL;

(*  - PI <= ARG(Z) < PI     *)
(*  ARG( 0 ) NICHT ERLAUBT  *)

VAR X , Y : REAL;

BEGIN
   X := Z.RE;
   Y := Z.IM;
   IF ( X = 0 ) AND ( Y = 0 ) THEN
      ARG := 1 / X;
   IF ( X > 0 ) AND ( Y >= 0 ) THEN
      ARG := ARCTAN( Y / X );
   IF ( X <= 0 ) AND ( Y > 0 ) THEN
      ARG := PI / 2 - ARCTAN( X / Y );
   IF ( X >= 0 ) AND ( Y < 0 ) THEN
      ARG := - PI / 2 - ARCTAN( X / Y );
   IF ( X < 0 ) AND ( Y <= 0 ) THEN
      ARG := - PI + ARCTAN( Y / X );
END;

(*----------------------------------------------------------------------*)

GLOBAL FUNCTION ARG( Z: CINTERVAL) : INTERVAL;

(*  IM INTERVALL DARF KEIN PUNKT Z  *)
(*  ENTHALTEN SEIN MIT              *)
(*  Z.IM = 0 UND Z.RE <= 0          *)

VAR RV  : ARRAY[1..4] OF REAL;
    CV  : ARRAY[1..4] OF COMPLEX;
    RES : INTERVAL;
    I   : INTEGER;

BEGIN
   IF (Z.RE.INF <= 0) AND (Z.IM.INF*Z.IM.SUP <= 0) THEN
      RES := 1/0;
   CV[1].RE := Z.RE.INF;
   CV[1].IM := Z.IM.INF;
   CV[2].RE := Z.RE.INF;
   CV[2].IM := Z.IM.SUP;
   CV[3].RE := Z.RE.SUP;
   CV[3].IM := Z.IM.INF;
   CV[4].RE := Z.RE.SUP;
   CV[4].IM := Z.IM.SUP;
   FOR I := 1 TO 4 DO
      RV[I] := ARG( CV[I] );
   RES := RV[1];
   FOR I := 2 TO 4 DO
   BEGIN
      IF RV[I] > RES.SUP THEN
         RES.SUP := RV[I];
      IF RV[I] < RES.INF THEN
         RES.INF := RV[I];
   END;
   ARG := RES;
END;

(*----------------------------------------------------------------------*)

GLOBAL OPERATOR ** ( CI : CINTERVAL; J : INTEGER ) RES : CINTERVAL;

VAR K   : INTEGER;
    ERR : REAL;
    ERG : CINTERVAL;

BEGIN IF J < 0 THEN
         ERR := 1 / 0   
      ELSE BEGIN
         ERG := 1;
         FOR K := 1 TO J DO
             ERG := ERG * CI;
      END; 
      RES := ERG;
END; 

(*----------------------------------------------------------------------*)

GLOBAL FUNCTION EXP( Z: CINTERVAL ) : CINTERVAL;

VAR X , Y : INTERVAL;
    RES   : CINTERVAL;

BEGIN
   X := Z.RE;
   Y := Z.IM;
   RES.RE := EXP( X ) * COS( Y );
   RES.IM := EXP( X ) * SIN( Y );
   EXP := RES;
END;

(*----------------------------------------------------------------------*)

GLOBAL FUNCTION COS( Z : CINTERVAL ) : CINTERVAL;

VAR X , Y : INTERVAL;
    RES   : CINTERVAL;

BEGIN
   X := Z.RE;
   Y := Z.IM;
   RES.RE := COS( X ) * COSH( Y );
   RES.IM := - SIN(X) * SINH( Y );
   COS := RES;
END;

(*----------------------------------------------------------------------*)

GLOBAL FUNCTION SIN( Z : CINTERVAL ) : CINTERVAL;

VAR X , Y : INTERVAL;
    RES   : CINTERVAL;

BEGIN
   X := Z.RE;
   Y := Z.IM;
   RES.RE := SIN( X ) * COSH( Y );
   RES.IM := COS( X ) * SINH( Y );
   SIN := RES;
END;

(*----------------------------------------------------------------------*)

GLOBAL FUNCTION COSH( Z : CINTERVAL ) : CINTERVAL;

VAR X , Y : INTERVAL;
    RES   : CINTERVAL;

BEGIN
   X := Z.RE;
   Y := Z.IM;
   RES.RE := COS( Y ) * COSH( X );
   RES.IM := SIN( Y ) * SINH( X );
   COSH := RES;
END;

(*----------------------------------------------------------------------*)

GLOBAL FUNCTION SINH( Z : CINTERVAL ) : CINTERVAL;

VAR X , Y : INTERVAL;
    RES   : CINTERVAL;

BEGIN
   X := Z.RE;
   Y := Z.IM;
   RES.RE := COS( Y ) * SINH( X );
   RES.IM := SIN( Y ) * COSH( X );
   SINH := RES;
END;

(*----------------------------------------------------------------------*)

GLOBAL FUNCTION LNF( Z : CINTERVAL ) : CINTERVAL;

VAR RES : CINTERVAL;

(*------------ NUR ZULAESSIGE Z ------------*)

BEGIN
   RES.RE := LN( ABS( Z ) );
   RES.IM := ARG( Z );
   LNF := RES;
END;

(*----------------------------------------------------------------------*)

GLOBAL PROCEDURE LNP( CIEIN : CINTERVAL; VAR CIAUS : CINTERVAL;
                      VAR ERR : INTEGER );

(*---- ERR=1 FUER CIEIN SCHNEIDET NEGATIVE REELLE ACHSE ---*)			    
			    
BEGIN
   IF ( CIEIN.RE.INF <= 0 ) AND ( 0 IN CIEIN.IM ) THEN
   (*  CIEIN SCHNEIDET NEGATIVE REELE ACHSE  *)
   BEGIN
      CIAUS := 0;
      ERR := 1
   END
   ELSE
      CIAUS := LNF( CIEIN );
END;

(*----------------------------------------------------------------------*)

GLOBAL FUNCTION ABSSQRTF( Z : CINTERVAL ) : INTERVAL;

(*------------ NUR ZULAESSIGE Z ------------*)
(*  FUNKTIONSAUFRUF OHNE ARGUMENTšBERPRšFUNG  *)

BEGIN
   ABSSQRTF := SQRT( ABS( Z ) );
END;

(*----------------------------------------------------------------------*)

GLOBAL PROCEDURE ABSSQRTP( CIEIN : CINTERVAL; VAR CIAUS : CINTERVAL;
                           VAR ERR : INTEGER );

(*------ ERR=1 FUER CIEIN SCHNEIDET NEGATIVE REELLE ACHSE ------*)
(*  FUNKTIONSAUFRUF MIT ARGUMENTšBERPRšFUNG  *)

BEGIN
   IF ( CIEIN.RE.INF <= 0 ) AND ( 0 IN CIEIN.IM ) THEN
   (* CIEIN SCHNEIDET NEGATIVE REELE ACHSE *)
   BEGIN
      CIAUS := 0;
      ERR := 1
   END
   ELSE
      CIAUS := ABSSQRTF( CIEIN );
END;

(*----------------------------------------------------------------------*)

END.

(*==========================================================================*)
(*                                                                          *)
(*  PASCAL-XSC - MODUL  ICF_ARI                                             *)
(*                                                                          *)
(*  MODUL FšR EINIGE KOMPLEXE STANDARDFUNKTIONEN                            *)
(*                                                                          *)
(*==========================================================================*)