(*==========================================================================*)
(*                                                                          *)
(*  PASCAL-XSC - MODUL  CITAYLOR                                    000221  *)
(*                                                                          *)
(*  MODUL ZUR BERECHNUNG VON TAYLORKOEFFIZIENTEN                            *)
(*  VON KOMPLEXEN FUNKTIONEN MIT EINFACHER GENAUIGKEIT                      *)
(*                                                                          *)
(*==========================================================================*)

MODULE citaylor;

USE i_ari, c_ari, ci_ari, icf_ari;

GLOBAL TYPE CITAYLOR = GLOBAL DYNAMIC ARRAY [*] OF CINTERVAL;

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

GLOBAL FUNCTION PLUS( IT1, IT2 : CITAYLOR; K : INTEGER ) : CINTERVAL;

BEGIN
   PLUS := IT1[K] + IT2[K];
END;

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

GLOBAL FUNCTION MINUS( IT1 , IT2 : CITAYLOR; K : INTEGER ) : CINTERVAL;

BEGIN
   MINUS := IT1[K] - IT2[K];
END;

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

GLOBAL FUNCTION TIMES( IT1 , IT2 : CITAYLOR; K : INTEGER ) : CINTERVAL;

VAR I : INTEGER;

BEGIN
   TIMES := ##(FOR I := 0 TO K SUM(IT1[I]*IT2[K-I]));
END;

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

GLOBAL FUNCTION DIVIDE( IT1 , IT2 , IT1_2 : CITAYLOR; K : INTEGER ) : CINTERVAL;

VAR I : INTEGER;

BEGIN
   DIVIDE := ( IT1[K] -
               ##( FOR I := 1 TO K SUM( IT1_2[K-I] * IT2[I] ) ) ) / IT2[0];
END;

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

GLOBAL FUNCTION SQR( IT : CITAYLOR; K : INTEGER ) : CINTERVAL;

VAR I : INTEGER;

BEGIN
   IF K = 0 THEN
	SQR := IT[0] * IT[0]
   ELSE
   BEGIN
	IF ODD( K ) THEN
	   SQR := 2 * ##( FOR I := 0 TO ( ( K - 1 ) DIV 2 )
                              SUM ( IT[I] * IT[K-I] ) )
	ELSE
	   SQR := 2 * ##( FOR I := 0 TO ( ( K - 2 ) DIV 2 )
                                SUM ( IT[I] * IT[K-I] ) )
                                    + IT[K DIV 2] * IT[K DIV 2];
   END;	
END;

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

GLOBAL FUNCTION EXP( IT , ITEXP : CITAYLOR; K : INTEGER ) : CINTERVAL;

VAR I    : INTEGER;
    CINT : CINTERVAL;

BEGIN
   IF K = 0 THEN
      EXP := EXP( IT[0] )
   ELSE
   BEGIN
      CINT := 0;
      FOR I := 0 TO K-1 DO
         CINT := CINT + ( K - I ) * ITEXP[I] * IT[K-I];
      EXP := CINT / K;
   END;
END;

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

GLOBAL FUNCTION SIN( IT , ITSIN : CITAYLOR; K : INTEGER ) : CINTERVAL;

VAR CINT1, CINT2 : CINTERVAL;
    I , J        : INTEGER;

BEGIN
   IF K < 2 THEN
   BEGIN
      IF K = 0 THEN
         SIN := SIN( IT[0] )
      ELSE
         SIN := COS( IT[0] ) * IT[1]
      END
   ELSE BEGIN
      CINT1 := 0;
      FOR J := 1 TO K - 1 DO
      BEGIN
         CINT2 := 0;
         FOR I := 0 TO J - 1 DO
            CINT2 := CINT2 + ( J - I ) * ITSIN[I] * IT[J-I];
         CINT1 := CINT1 + ( K - J ) * IT[K-J] * CINT2 / J;
      END;
      SIN := COS( IT[0] ) * IT[K] - CINT1 / K;
   END;
END;

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

GLOBAL FUNCTION COS( IT , ITCOS : CITAYLOR; K : INTEGER ) : CINTERVAL;

VAR CINT1 , CINT2 : CINTERVAL;
    I , J         : INTEGER;

BEGIN
   IF K < 2 THEN
   BEGIN
      IF K = 0 THEN
         COS := COS( IT[0] )
      ELSE
         COS := - SIN( IT[0] ) * IT[1]
      END
   ELSE
   BEGIN
      CINT1 := 0;
      FOR J := 1 TO K-1 DO
      BEGIN
         CINT2 := 0;
         FOR I := 0 TO J - 1 DO
            CINT2 := CINT2 + ( J - I ) * ITCOS[I] * IT[J-I];
         CINT1 := CINT1 + ( K - J ) * IT[K-J] * CINT2 / J;
      END;
      COS := - SIN( IT[0] ) * IT[K] - CINT1 / K;
   END;
END;

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

GLOBAL PROCEDURE SIN_COS( VAR IT , ITSIN , ITCOS : CITAYLOR; K : INTEGER);

VAR I                 : INTEGER;
    CINTSIN , CINTCOS : CINTERVAL;

BEGIN
   IF K = 0 THEN
   BEGIN
      ITSIN[K] := SIN( IT[0] );
      ITCOS[K] := COS( IT[0] )
      END
   ELSE BEGIN
      CINTSIN := 0;
      CINTCOS := 0;
      FOR I := 0 TO K-1 DO
      BEGIN
         CINTSIN := CINTSIN + ( K - I ) * ITCOS[I] * IT[K-I];
         CINTCOS := CINTCOS + ( K - I ) * ITSIN[I] * IT[K-I];
      END;
      ITSIN[K] := CINTSIN / K;
      ITCOS[K] := - CINTCOS / K;
   END;
END;

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

GLOBAL FUNCTION SINH( IT , ITSINH : CITAYLOR; K : INTEGER ) : CINTERVAL;

VAR CINT1 , CINT2 : CINTERVAL;
    I , J         : INTEGER;

BEGIN
   IF K < 2 THEN
   BEGIN
      IF K = 0 THEN
         SINH := SINH( IT[0] )
      ELSE
         SINH := COSH( IT[0] ) * IT[1]
      END
   ELSE
   BEGIN
      CINT1 := 0;
      FOR J := 1 TO K - 1 DO
      BEGIN
         CINT2 := 0;
         FOR I := 0 TO J - 1 DO
            CINT2 := CINT2 + ( J - I ) * ITSINH[I] * IT[J-I];
         CINT1 := CINT1 + ( K - J ) * IT[K-J] * CINT2 / J;
      END;
      SINH := COSH( IT[0] ) * IT[K] + CINT1 / K;
   END;
END;

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

GLOBAL FUNCTION COSH( IT , ITCOSH : CITAYLOR; K : INTEGER ) : CINTERVAL;

VAR CINT1 , CINT2 : CINTERVAL;
    I , J         : INTEGER;

BEGIN
   IF K < 2 THEN
   BEGIN
      IF K = 0 THEN
         COSH := COSH( IT[0] )
      ELSE
         COSH := SINH( IT[0] ) * IT[1]
      END
   ELSE
   BEGIN
      CINT1 := 0;
      FOR J := 1 TO K - 1 DO
      BEGIN
         CINT2 := 0;
         FOR I := 0 TO J - 1 DO
            CINT2 := CINT2 + ( J - I ) * ITCOSH[I] * IT[J-I];
         CINT1 := CINT1 + ( K - J ) * IT[K-J] * CINT2 / J;
      END;
      COSH := SINH( IT[0] ) * IT[K] + CINT1 / K;
   END;
END;

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

GLOBAL PROCEDURE SINH_COSH( VAR IT , ITSINH , ITCOSH : CITAYLOR; K : INTEGER );

VAR I                   : INTEGER;
    CINTSINH , CINTCOSH : CINTERVAL;

BEGIN
   IF K = 0 THEN
   BEGIN
      ITSINH[K] := SINH( IT[0] );
      ITCOSH[K] := COSH( IT[0] )
   END
   ELSE
   BEGIN
      CINTSINH := 0;
      CINTCOSH := 0;
      FOR I := 0 TO K - 1 DO
      BEGIN
         CINTSINH := CINTSINH + ( K - I ) * ITCOSH[I] * IT[K-I];
         CINTCOSH := CINTCOSH + ( K - I ) * ITSINH[I] * IT[K-I];
      END;
      ITSINH[K] := CINTSINH / K;
      ITCOSH[K] := CINTCOSH / K;
   END;
END;

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

GLOBAL FUNCTION LN ( IT , ITLN : CITAYLOR; K : INTEGER ) : CINTERVAL;

VAR I    : INTEGER;
    CINT : CINTERVAL;

BEGIN
   IF K = 0 THEN
      LN := LNF( IT[0] )
   ELSE
   BEGIN
      CINT := 0;
      FOR I := 1 TO K - 1 DO
         CINT := CINT + I * ITLN[I] * IT[K-I];
      LN := ( IT[K] - CINT / K) / IT[0];
   END;
END;

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

END.

(*==========================================================================*)
(*                                                                          *)
(*  PASCAL-XSC - MODUL  CITAYLOR                                            *)
(*                                                                          *)
(*  MODUL ZUR BERECHNUNG VON TAYLORKOEFFIZIENTEN                            *)
(*  VON KOMPLEXEN FUNKTIONEN MIT EINFACHER GENAUIGKEIT                      *)
(*                                                                          *)
(*==========================================================================*)