DEFINITION MODULE SpezFunkt1;
(*------------------------------------------------------------------------*)
(* Stellt einige "Sonderfunktionen" fuer Polynome und Nullstellen- *)
(* berechnungen bereit. *)
(* Provides some special procedure for the evaluation of polynominals and *)
(* for the calculation of roots. *)
(*------------------------------------------------------------------------*)
(* Implementation : Michael Riedl *)
(* Licence : GNU Lesser General Public License (LGPL) *)
(*------------------------------------------------------------------------*)
(* $Id: SpezFunkt1.def,v 1.5 2016/10/12 09:22:17 mriedl Exp mriedl $ *)
FROM LMathLib IMPORT Funktion1;
PROCEDURE Horner(VAR x : LONGREAL;
VAR Koeff : ARRAY OF LONGREAL;
n : CARDINAL) : LONGREAL;
(*-----------------------------------------------------------------*)
(* Berechnet den Funktionswert eines Polynoms *)
(* F(x) = \sum_{i=0}^n Koeff_i x^i *)
(*-----------------------------------------------------------------*)
PROCEDURE Clenshaw(x : LONGREAL; (* Funktionswert *)
n : CARDINAL; (* Grad d. T-Entwicklung *)
VAR C : ARRAY OF LONGREAL;
U,O : LONGREAL) : LONGREAL;
(*-----------------------------------------------------------------*)
(* Berechnet den Funktionswert des Tschebytscheffpolynoms C *)
(* an der Stelle x. n ist der Grad des T-Polynoms und U,O die *)
(* Unter- und Obergrenzen, f"ur die die T-Entwicklung gelten soll. *)
(* Transformation : y \eqiv {x - (1/2)(O + U) \over (1/2)(O-U)} *)
(*-----------------------------------------------------------------*)
PROCEDURE EvalCheb1Coeff( x : LONGREAL;
VAR T : ARRAY OF LONGREAL;
n : CARDINAL);
(*----------------------------------------------------------------*)
(* Procedure to calculate the chebychev coefficient(s) T for *)
(* chebychev polynominals of the first kind at point x up to *)
(* order n. *)
(*----------------------------------------------------------------*)
PROCEDURE ChebPoly1Sum( n : CARDINAL;
x : LONGREAL;
VAR A : ARRAY OF LONGREAL) : LONGREAL;
(*----------------------------------------------------------------*)
(* Procedure to evaluate the chebychev polynominal(s) of the *)
(* first kind at point x with given coefficients A and order n *)
(* *)
(* Returns the value of the chebyshev sum *)
(* A[0] + A[1]*t[1](x) + .... + A[n]*t[n](x), *)
(* where t[1](x),....,t[n](x) are chebyshev polynomials of the *)
(* first kind, of degree 1,....,n, respectively. *)
(* *)
(* The meaning of the formal parameters is : *)
(* *)
(* n : The degree of the polynomial represented by the chebyshev *)
(* sum (n>=0) *)
(* x : The argument of the chebyshev polynomials, abs(x)<=1 *)
(* A : On entry the coefficients of the chebyshev sum must be *)
(* given in array A, where a[k] is the coefficient of the *)
(* chebyshev polynomial of degree k, 0<=k<=n. *)
(* *)
(* Transcript of Algol60 procedure chepolsum form NumAl library *)
(*----------------------------------------------------------------*)
PROCEDURE RatPoly( x : LONGREAL;
VAR A,B : ARRAY OF LONGREAL;
n,m : CARDINAL) : LONGREAL;
(*----------------------------------------------------------------*)
(* Berechnet den Funktionswert einer rationalen Funktion *)
(* F(x) = {\sum_{i=0}^n A_i x^i \over \sum_{j=0}^m B_j x^j} *)
(*----------------------------------------------------------------*)
PROCEDURE QuadGl( A,B,C : LONGREAL;
VAR X1,X2 : LONGCOMPLEX);
(*----------------------------------------------------------------*)
(* Berechnet die Wurzeln der quadratischen Gleichung *)
(* A x^2 + B x + C = 0 *)
(*----------------------------------------------------------------*)
PROCEDURE KubGl( A,B,C,D : LONGREAL;
VAR X1,X2,X3 : LONGCOMPLEX);
(*----------------------------------------------------------------*)
(* Berechnet die Nullstellen der Gleichung 3. Grades *)
(* A x^3 + B x^2 + C*x + D = 0 *)
(*----------------------------------------------------------------*)
PROCEDURE CubicEq( A,B,C,D : LONGCOMPLEX; (* coeffs of the polynomial *)
VAR X1,X2,X3 : LONGCOMPLEX);
(*----------------------------------------------------------------*)
(* Cubic equation solver for complex polynomial with degree 3, *)
(* Lagrange's method *)
(* *)
(* f(x) = A*x**3 + B*x**2 + C*x + D *)
(* *)
(* Procedure is a modification of a Fortran routine provided by *)
(* Skowron, Jan and Gould, Andrew under the LGPL, see *)
(* www.astrouw.edu.pl/~jskowron/cmplx_roots_sg/cmplx_roots_sg.f90 *)
(*----------------------------------------------------------------*)
PROCEDURE Regula(VAR Funkt : Funktion1; (* y:=Funkt(x), mit x,y:LONGREAL *)
Xu,Xo : LONGREAL; (* Startwerte f"ur die Nullstelle *)
fXu,fXo : LONGREAL; (* Funktionswerte von Xu,Xo *)
VAR X0 : LONGREAL; (* Nullstelle von Funkt *)
genau : LONGREAL); (* Geforderte Genauigkeit *)
(*----------------------------------------------------------------*)
(* Berechnet die Nullstelle von Funkt(x) im Intervall [Xu,Xo] mit *)
(* Xu*Xo < 0 , Xu < Xo nach der Regula Falsi. *)
(*----------------------------------------------------------------*)
PROCEDURE NullStellen(u,o : LONGREAL; (* Intervallgrenzen *)
dH : LONGREAL; (* Schrittweite *)
f : Funktion1;
VAR X0 : ARRAY OF LONGREAL; (* Nullstellen von f *)
VAR nx0 : CARDINAL; (* Anzahl der Nullstellen *)
n : CARDINAL; (* Anzahl zu suchender Nullst. *)
genau : LONGREAL);
(*-----------------------------------------------------------------*)
(* Wenn n = 0 werden alle Nullstellen des Intervalls [u,o] gesucht *)
(* Wenn die Funktion ein Intervall aufweisst in dem sie 0 ist *)
(* wird diese "immer wieder" gefunden". Dann sind die Nullstellen *)
(* jeweils nur um dH verschoben ... *)
(*-----------------------------------------------------------------*)
END SpezFunkt1.