|
|
@@ -1,885 +0,0 @@
|
|
|
-{
|
|
|
- $Id$
|
|
|
- This file is part of the Free Pascal run time library.
|
|
|
- Copyright (c) 1999-2000 by xxxx
|
|
|
- member of the Free Pascal development team
|
|
|
-
|
|
|
- See the file COPYING.FPC, included in this distribution,
|
|
|
- for details about the copyright.
|
|
|
-
|
|
|
- This program is distributed in the hope that it will be useful,
|
|
|
- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
-
|
|
|
- **********************************************************************}
|
|
|
-{*************************************************************************}
|
|
|
-{ math.inc }
|
|
|
-{*************************************************************************}
|
|
|
-{ Copyright Abandoned, 1987, Fred Fish }
|
|
|
-{ }
|
|
|
-{ This previously copyrighted work has been placed into the }
|
|
|
-{ public domain by the author (Fred Fish) and may be freely used }
|
|
|
-{ for any purpose, private or commercial. I would appreciate }
|
|
|
-{ it, as a courtesy, if this notice is left in all copies and }
|
|
|
-{ derivative works. Thank you, and enjoy... }
|
|
|
-{ }
|
|
|
-{ The author makes no warranty of any kind with respect to this }
|
|
|
-{ product and explicitly disclaims any implied warranties of }
|
|
|
-{ merchantability or fitness for any particular purpose. }
|
|
|
-{-------------------------------------------------------------------------}
|
|
|
-{ Copyright (c) 1992 Odent Jean Philippe }
|
|
|
-{ }
|
|
|
-{ The source can be modified as long as my name appears and some }
|
|
|
-{ notes explaining the modifications done are included in the file. }
|
|
|
-{-------------------------------------------------------------------------}
|
|
|
-{ Copyright (c) 1997 Carl Eric Codere }
|
|
|
-{ }
|
|
|
-{ This include implements a template for }
|
|
|
-{ all real (whatever this type maps to) and fixed point standard }
|
|
|
-{ rtl routines. }
|
|
|
-{ NOTE: Trunc and Int must be implemented depending on the target }
|
|
|
-{ for real values.Sqrt must also be implemented for fixed. }
|
|
|
-{*************************************************************************}
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-type
|
|
|
- TabCoef = array[0..6] of Real;
|
|
|
-
|
|
|
-
|
|
|
-const
|
|
|
- PIO2 = 1.57079632679489661923; { pi/2 }
|
|
|
- PIO4 = 7.85398163397448309616E-1; { pi/4 }
|
|
|
- SQRT2 = 1.41421356237309504880; { sqrt(2) }
|
|
|
- SQRTH = 7.07106781186547524401E-1; { sqrt(2)/2 }
|
|
|
- LOG2E = 1.4426950408889634073599; { 1/log(2) }
|
|
|
- SQ2OPI = 7.9788456080286535587989E-1; { sqrt( 2/pi )}
|
|
|
- LOGE2 = 6.93147180559945309417E-1; { log(2) }
|
|
|
- LOGSQ2 = 3.46573590279972654709E-1; { log(2)/2 }
|
|
|
- THPIO4 = 2.35619449019234492885; { 3*pi/4 }
|
|
|
- TWOOPI = 6.36619772367581343075535E-1; { 2/pi }
|
|
|
- lossth = 1.073741824e9;
|
|
|
- MAXLOG = 8.8029691931113054295988E1; { log(2**127) }
|
|
|
- MINLOG = -8.872283911167299960540E1; { log(2**-128) }
|
|
|
-
|
|
|
- DP1 = 7.85398125648498535156E-1;
|
|
|
- DP2 = 3.77489470793079817668E-8;
|
|
|
- DP3 = 2.69515142907905952645E-15;
|
|
|
-
|
|
|
-const sincof : TabCoef = (
|
|
|
- 1.58962301576546568060E-10,
|
|
|
- -2.50507477628578072866E-8,
|
|
|
- 2.75573136213857245213E-6,
|
|
|
- -1.98412698295895385996E-4,
|
|
|
- 8.33333333332211858878E-3,
|
|
|
- -1.66666666666666307295E-1, 0);
|
|
|
- coscof : TabCoef = (
|
|
|
- -1.13585365213876817300E-11,
|
|
|
- 2.08757008419747316778E-9,
|
|
|
- -2.75573141792967388112E-7,
|
|
|
- 2.48015872888517045348E-5,
|
|
|
- -1.38888888888730564116E-3,
|
|
|
- 4.16666666666665929218E-2, 0);
|
|
|
-
|
|
|
-
|
|
|
- function int(d : real) : real;
|
|
|
- { these routine should be implemented all depending on the }
|
|
|
- { target processor/operating system. }
|
|
|
- begin
|
|
|
- end;
|
|
|
-
|
|
|
- function trunc(d : real) : longint;
|
|
|
- { these routine should be implemented all depending on the }
|
|
|
- { target processor/operating system. }
|
|
|
- Begin
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function abs(d : Real) : Real;
|
|
|
- begin
|
|
|
- if( d < 0.0 ) then
|
|
|
- abs := -d
|
|
|
- else
|
|
|
- abs := d ;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function frexp(x:Real; var e:Integer ):Real;
|
|
|
- {* frexp() extracts the exponent from x. It returns an integer *}
|
|
|
- {* power of two to expnt and the significand between 0.5 and 1 *}
|
|
|
- {* to y. Thus x = y * 2**expn. *}
|
|
|
- begin
|
|
|
- e :=0;
|
|
|
- if (abs(x)<0.5) then
|
|
|
- While (abs(x)<0.5) do
|
|
|
- begin
|
|
|
- x := x*2;
|
|
|
- Dec(e);
|
|
|
- end
|
|
|
- else
|
|
|
- While (abs(x)>1) do
|
|
|
- begin
|
|
|
- x := x/2;
|
|
|
- Inc(e);
|
|
|
- end;
|
|
|
- frexp := x;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function ldexp( x: Real; N: Integer):Real;
|
|
|
- {* ldexp() multiplies x by 2**n. *}
|
|
|
- var r : Real;
|
|
|
- begin
|
|
|
- R := 1;
|
|
|
- if N>0 then
|
|
|
- while N>0 do
|
|
|
- begin
|
|
|
- R:=R*2;
|
|
|
- Dec(N);
|
|
|
- end
|
|
|
- else
|
|
|
- while N<0 do
|
|
|
- begin
|
|
|
- R:=R/2;
|
|
|
- Inc(N);
|
|
|
- end;
|
|
|
- ldexp := x * R;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function polevl(var x:Real; var Coef:TabCoef; N:Integer):Real;
|
|
|
- {*****************************************************************}
|
|
|
- { Evaluate polynomial }
|
|
|
- {*****************************************************************}
|
|
|
- { }
|
|
|
- { SYNOPSIS: }
|
|
|
- { }
|
|
|
- { int N; }
|
|
|
- { double x, y, coef[N+1], polevl[]; }
|
|
|
- { }
|
|
|
- { y = polevl( x, coef, N ); }
|
|
|
- { }
|
|
|
- { DESCRIPTION: }
|
|
|
- { }
|
|
|
- { Evaluates polynomial of degree N: }
|
|
|
- { }
|
|
|
- { 2 N }
|
|
|
- { y = C + C x + C x +...+ C x }
|
|
|
- { 0 1 2 N }
|
|
|
- { }
|
|
|
- { Coefficients are stored in reverse order: }
|
|
|
- { }
|
|
|
- { coef[0] = C , ..., coef[N] = C . }
|
|
|
- { N 0 }
|
|
|
- { }
|
|
|
- { The function p1evl() assumes that coef[N] = 1.0 and is }
|
|
|
- { omitted from the array. Its calling arguments are }
|
|
|
- { otherwise the same as polevl(). }
|
|
|
- { }
|
|
|
- { SPEED: }
|
|
|
- { }
|
|
|
- { In the interest of speed, there are no checks for out }
|
|
|
- { of bounds arithmetic. This routine is used by most of }
|
|
|
- { the functions in the library. Depending on available }
|
|
|
- { equipment features, the user may wish to rewrite the }
|
|
|
- { program in microcode or assembly language. }
|
|
|
- {*****************************************************************}
|
|
|
- var ans : Real;
|
|
|
- i : Integer;
|
|
|
-
|
|
|
- begin
|
|
|
- ans := Coef[0];
|
|
|
- for i:=1 to N do
|
|
|
- ans := ans * x + Coef[i];
|
|
|
- polevl:=ans;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function p1evl(var x:Real; var Coef:TabCoef; N:Integer):Real;
|
|
|
- { }
|
|
|
- { Evaluate polynomial when coefficient of x is 1.0. }
|
|
|
- { Otherwise same as polevl. }
|
|
|
- { }
|
|
|
- var
|
|
|
- ans : Real;
|
|
|
- i : Integer;
|
|
|
- begin
|
|
|
- ans := x + Coef[0];
|
|
|
- for i:=1 to N-1 do
|
|
|
- ans := ans * x + Coef[i];
|
|
|
- p1evl := ans;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
- function sqr(d : Real) : Real;
|
|
|
- begin
|
|
|
- sqr := d*d;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function pi : Real;
|
|
|
- begin
|
|
|
- pi := 3.1415926535897932385;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function sqrt(x:Real):Real;
|
|
|
- {*****************************************************************}
|
|
|
- { Square root }
|
|
|
- {*****************************************************************}
|
|
|
- { }
|
|
|
- { SYNOPSIS: }
|
|
|
- { }
|
|
|
- { double x, y, sqrt(); }
|
|
|
- { }
|
|
|
- { y = sqrt( x ); }
|
|
|
- { }
|
|
|
- { DESCRIPTION: }
|
|
|
- { }
|
|
|
- { Returns the square root of x. }
|
|
|
- { }
|
|
|
- { Range reduction involves isolating the power of two of the }
|
|
|
- { argument and using a polynomial approximation to obtain }
|
|
|
- { a rough value for the square root. Then Heron's iteration }
|
|
|
- { is used three times to converge to an accurate value. }
|
|
|
- {*****************************************************************}
|
|
|
- var e : Integer;
|
|
|
- w,z : Real;
|
|
|
- begin
|
|
|
- if( x <= 0.0 ) then
|
|
|
- begin
|
|
|
- if( x < 0.0 ) then
|
|
|
- RunError(207);
|
|
|
- sqrt := 0.0;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- w := x;
|
|
|
- { separate exponent and significand }
|
|
|
- z := frexp( x, e );
|
|
|
-
|
|
|
- { approximate square root of number between 0.5 and 1 }
|
|
|
- { relative error of approximation = 7.47e-3 }
|
|
|
- x := 4.173075996388649989089E-1 + 5.9016206709064458299663E-1 * z;
|
|
|
-
|
|
|
- { adjust for odd powers of 2 }
|
|
|
- if odd(e) then
|
|
|
- x := x*SQRT2;
|
|
|
-
|
|
|
- { re-insert exponent }
|
|
|
- x := ldexp( x, (e div 2) );
|
|
|
-
|
|
|
- { Newton iterations: }
|
|
|
- x := 0.5*(x + w/x);
|
|
|
- x := 0.5*(x + w/x);
|
|
|
- x := 0.5*(x + w/x);
|
|
|
- x := 0.5*(x + w/x);
|
|
|
- x := 0.5*(x + w/x);
|
|
|
- x := 0.5*(x + w/x);
|
|
|
- sqrt := x;
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
- function Exp(x:Real):Real;
|
|
|
- {*****************************************************************}
|
|
|
- { Exponential Function }
|
|
|
- {*****************************************************************}
|
|
|
- { }
|
|
|
- { SYNOPSIS: }
|
|
|
- { }
|
|
|
- { double x, y, exp(); }
|
|
|
- { }
|
|
|
- { y = exp( x ); }
|
|
|
- { }
|
|
|
- { DESCRIPTION: }
|
|
|
- { }
|
|
|
- { Returns e (2.71828...) raised to the x power. }
|
|
|
- { }
|
|
|
- { Range reduction is accomplished by separating the argument }
|
|
|
- { into an integer k and fraction f such that }
|
|
|
- { }
|
|
|
- { x k f }
|
|
|
- { e = 2 e. }
|
|
|
- { }
|
|
|
- { A Pade' form of degree 2/3 is used to approximate exp(f)- 1 }
|
|
|
- { in the basic range [-0.5 ln 2, 0.5 ln 2]. }
|
|
|
- {*****************************************************************}
|
|
|
- const P : TabCoef = (
|
|
|
- 1.26183092834458542160E-4,
|
|
|
- 3.02996887658430129200E-2,
|
|
|
- 1.00000000000000000000E0, 0, 0, 0, 0);
|
|
|
- Q : TabCoef = (
|
|
|
- 3.00227947279887615146E-6,
|
|
|
- 2.52453653553222894311E-3,
|
|
|
- 2.27266044198352679519E-1,
|
|
|
- 2.00000000000000000005E0, 0 ,0 ,0);
|
|
|
-
|
|
|
- C1 = 6.9335937500000000000E-1;
|
|
|
- C2 = 2.1219444005469058277E-4;
|
|
|
- var n : Integer;
|
|
|
- px, qx, xx : Real;
|
|
|
- begin
|
|
|
- if( x > MAXLOG) then
|
|
|
- RunError(205)
|
|
|
- else
|
|
|
- if( x < MINLOG ) then
|
|
|
- begin
|
|
|
- Runerror(205);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
-
|
|
|
- { Express e**x = e**g 2**n }
|
|
|
- { = e**g e**( n loge(2) ) }
|
|
|
- { = e**( g + n loge(2) ) }
|
|
|
-
|
|
|
- px := x * LOG2E;
|
|
|
- qx := Trunc( px + 0.5 ); { Trunc() truncates toward -infinity. }
|
|
|
- n := Trunc(qx);
|
|
|
- x := x - qx * C1;
|
|
|
- x := x + qx * C2;
|
|
|
-
|
|
|
- { rational approximation for exponential }
|
|
|
- { of the fractional part: }
|
|
|
- { e**x - 1 = 2x P(x**2)/( Q(x**2) - P(x**2) ) }
|
|
|
- xx := x * x;
|
|
|
- px := x * polevl( xx, P, 2 );
|
|
|
- x := px/( polevl( xx, Q, 3 ) - px );
|
|
|
- x := ldexp( x, 1 );
|
|
|
- x := x + 1.0;
|
|
|
- x := ldexp( x, n );
|
|
|
- Exp := x;
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function Round(x: Real): longint;
|
|
|
- var
|
|
|
- fr: Real;
|
|
|
- tr: Real;
|
|
|
- Begin
|
|
|
- fr := Frac(x);
|
|
|
- tr := Trunc(x);
|
|
|
- if fr > 0.5 then
|
|
|
- Round:=Trunc(x)+1
|
|
|
- else
|
|
|
- if fr < 0.5 then
|
|
|
- Round:=Trunc(x)
|
|
|
- else { fr = 0.5 }
|
|
|
- { check sign to decide ... }
|
|
|
- { as in Turbo Pascal... }
|
|
|
- if x >= 0.0 then
|
|
|
- Round := Trunc(x)+1
|
|
|
- else
|
|
|
- Round := Trunc(x);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function Ln(x:Real):Real;
|
|
|
- {*****************************************************************}
|
|
|
- { Natural Logarithm }
|
|
|
- {*****************************************************************}
|
|
|
- { }
|
|
|
- { SYNOPSIS: }
|
|
|
- { }
|
|
|
- { double x, y, log(); }
|
|
|
- { }
|
|
|
- { y = ln( x ); }
|
|
|
- { }
|
|
|
- { DESCRIPTION: }
|
|
|
- { }
|
|
|
- { Returns the base e (2.718...) logarithm of x. }
|
|
|
- { }
|
|
|
- { The argument is separated into its exponent and fractional }
|
|
|
- { parts. If the exponent is between -1 and +1, the logarithm }
|
|
|
- { of the fraction is approximated by }
|
|
|
- { }
|
|
|
- { log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). }
|
|
|
- { }
|
|
|
- { Otherwise, setting z = 2(x-1)/x+1), }
|
|
|
- { }
|
|
|
- { log(x) = z + z**3 P(z)/Q(z). }
|
|
|
- { }
|
|
|
- {*****************************************************************}
|
|
|
- const P : TabCoef = (
|
|
|
- { Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x)
|
|
|
- 1/sqrt(2) <= x < sqrt(2) }
|
|
|
-
|
|
|
- 4.58482948458143443514E-5,
|
|
|
- 4.98531067254050724270E-1,
|
|
|
- 6.56312093769992875930E0,
|
|
|
- 2.97877425097986925891E1,
|
|
|
- 6.06127134467767258030E1,
|
|
|
- 5.67349287391754285487E1,
|
|
|
- 1.98892446572874072159E1);
|
|
|
- Q : TabCoef = (
|
|
|
- 1.50314182634250003249E1,
|
|
|
- 8.27410449222435217021E1,
|
|
|
- 2.20664384982121929218E2,
|
|
|
- 3.07254189979530058263E2,
|
|
|
- 2.14955586696422947765E2,
|
|
|
- 5.96677339718622216300E1, 0);
|
|
|
-
|
|
|
- { Coefficients for log(x) = z + z**3 P(z)/Q(z),
|
|
|
- where z = 2(x-1)/(x+1)
|
|
|
- 1/sqrt(2) <= x < sqrt(2) }
|
|
|
-
|
|
|
- R : TabCoef = (
|
|
|
- -7.89580278884799154124E-1,
|
|
|
- 1.63866645699558079767E1,
|
|
|
- -6.41409952958715622951E1, 0, 0, 0, 0);
|
|
|
- S : TabCoef = (
|
|
|
- -3.56722798256324312549E1,
|
|
|
- 3.12093766372244180303E2,
|
|
|
- -7.69691943550460008604E2, 0, 0, 0, 0);
|
|
|
-
|
|
|
- var e : Integer;
|
|
|
- z, y : Real;
|
|
|
-
|
|
|
- Label Ldone;
|
|
|
- begin
|
|
|
- if( x <= 0.0 ) then
|
|
|
- RunError(207);
|
|
|
- x := frexp( x, e );
|
|
|
-
|
|
|
- { logarithm using log(x) = z + z**3 P(z)/Q(z),
|
|
|
- where z = 2(x-1)/x+1) }
|
|
|
-
|
|
|
- if( (e > 2) or (e < -2) ) then
|
|
|
- begin
|
|
|
- if( x < SQRTH ) then
|
|
|
- begin
|
|
|
- { 2( 2x-1 )/( 2x+1 ) }
|
|
|
- Dec(e, 1);
|
|
|
- z := x - 0.5;
|
|
|
- y := 0.5 * z + 0.5;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { 2 (x-1)/(x+1) }
|
|
|
- z := x - 0.5;
|
|
|
- z := z - 0.5;
|
|
|
- y := 0.5 * x + 0.5;
|
|
|
- end;
|
|
|
- x := z / y;
|
|
|
- { /* rational form */ }
|
|
|
- z := x*x;
|
|
|
- z := x + x * ( z * polevl( z, R, 2 ) / p1evl( z, S, 3 ) );
|
|
|
- goto ldone;
|
|
|
- end;
|
|
|
-
|
|
|
- { logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) }
|
|
|
-
|
|
|
- if( x < SQRTH ) then
|
|
|
- begin
|
|
|
- Dec(e, 1);
|
|
|
- x := ldexp( x, 1 ) - 1.0; { 2x - 1 }
|
|
|
- end
|
|
|
- else
|
|
|
- x := x - 1.0;
|
|
|
-
|
|
|
- { rational form }
|
|
|
- z := x*x;
|
|
|
- y := x * ( z * polevl( x, P, 6 ) / p1evl( x, Q, 6 ) );
|
|
|
- y := y - ldexp( z, -1 ); { y - 0.5 * z }
|
|
|
- z := x + y;
|
|
|
-
|
|
|
- ldone:
|
|
|
- { recombine with exponent term }
|
|
|
- if( e <> 0 ) then
|
|
|
- begin
|
|
|
- y := e;
|
|
|
- z := z - y * 2.121944400546905827679e-4;
|
|
|
- z := z + y * 0.693359375;
|
|
|
- end;
|
|
|
-
|
|
|
- Ln:= z;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
- function Sin(x:Real):Real;
|
|
|
- {*****************************************************************}
|
|
|
- { Circular Sine }
|
|
|
- {*****************************************************************}
|
|
|
- { }
|
|
|
- { SYNOPSIS: }
|
|
|
- { }
|
|
|
- { double x, y, sin(); }
|
|
|
- { }
|
|
|
- { y = sin( x ); }
|
|
|
- { }
|
|
|
- { DESCRIPTION: }
|
|
|
- { }
|
|
|
- { Range reduction is into intervals of pi/4. The reduction }
|
|
|
- { error is nearly eliminated by contriving an extended }
|
|
|
- { precision modular arithmetic. }
|
|
|
- { }
|
|
|
- { Two polynomial approximating functions are employed. }
|
|
|
- { Between 0 and pi/4 the sine is approximated by }
|
|
|
- { x + x**3 P(x**2). }
|
|
|
- { Between pi/4 and pi/2 the cosine is represented as }
|
|
|
- { 1 - x**2 Q(x**2). }
|
|
|
- {*****************************************************************}
|
|
|
- var y, z, zz : Real;
|
|
|
- j, sign : Integer;
|
|
|
-
|
|
|
- begin
|
|
|
- { make argument positive but save the sign }
|
|
|
- sign := 1;
|
|
|
- if( x < 0 ) then
|
|
|
- begin
|
|
|
- x := -x;
|
|
|
- sign := -1;
|
|
|
- end;
|
|
|
-
|
|
|
- { above this value, approximate towards 0 }
|
|
|
- if( x > lossth ) then
|
|
|
- begin
|
|
|
- sin := 0.0;
|
|
|
- exit;
|
|
|
- end;
|
|
|
-
|
|
|
- y := Trunc( x/PIO4 ); { integer part of x/PIO4 }
|
|
|
-
|
|
|
- { strip high bits of integer part to prevent integer overflow }
|
|
|
- z := ldexp( y, -4 );
|
|
|
- z := Trunc(z); { integer part of y/8 }
|
|
|
- z := y - ldexp( z, 4 ); { y - 16 * (y/16) }
|
|
|
-
|
|
|
- j := Trunc(z); { convert to integer for tests on the phase angle }
|
|
|
- { map zeros to origin }
|
|
|
- if odd( j ) then
|
|
|
- begin
|
|
|
- inc(j);
|
|
|
- y := y + 1.0;
|
|
|
- end;
|
|
|
- j := j and 7; { octant modulo 360 degrees }
|
|
|
- { reflect in x axis }
|
|
|
- if( j > 3) then
|
|
|
- begin
|
|
|
- sign := -sign;
|
|
|
- dec(j, 4);
|
|
|
- end;
|
|
|
-
|
|
|
- { Extended precision modular arithmetic }
|
|
|
- z := ((x - y * DP1) - y * DP2) - y * DP3;
|
|
|
-
|
|
|
- zz := z * z;
|
|
|
-
|
|
|
- if( (j=1) or (j=2) ) then
|
|
|
- y := 1.0 - ldexp(zz,-1) + zz * zz * polevl( zz, coscof, 5 )
|
|
|
- else
|
|
|
- { y = z + z * (zz * polevl( zz, sincof, 5 )); }
|
|
|
- y := z + z * z * z * polevl( zz, sincof, 5 );
|
|
|
-
|
|
|
- if(sign < 0) then
|
|
|
- y := -y;
|
|
|
- sin := y;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
- function frac(d : Real) : Real;
|
|
|
- begin
|
|
|
- frac := d - Int(d);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function sqrt(d : fixed) : fixed;
|
|
|
- begin
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function Cos(x:Real):Real;
|
|
|
- {*****************************************************************}
|
|
|
- { Circular cosine }
|
|
|
- {*****************************************************************}
|
|
|
- { }
|
|
|
- { Circular cosine }
|
|
|
- { }
|
|
|
- { SYNOPSIS: }
|
|
|
- { }
|
|
|
- { double x, y, cos(); }
|
|
|
- { }
|
|
|
- { y = cos( x ); }
|
|
|
- { }
|
|
|
- { DESCRIPTION: }
|
|
|
- { }
|
|
|
- { Range reduction is into intervals of pi/4. The reduction }
|
|
|
- { error is nearly eliminated by contriving an extended }
|
|
|
- { precision modular arithmetic. }
|
|
|
- { }
|
|
|
- { Two polynomial approximating functions are employed. }
|
|
|
- { Between 0 and pi/4 the cosine is approximated by }
|
|
|
- { 1 - x**2 Q(x**2). }
|
|
|
- { Between pi/4 and pi/2 the sine is represented as }
|
|
|
- { x + x**3 P(x**2). }
|
|
|
- {*****************************************************************}
|
|
|
- var y, z, zz : Real;
|
|
|
- j, sign : Integer;
|
|
|
- i : LongInt;
|
|
|
- begin
|
|
|
- { make argument positive }
|
|
|
- sign := 1;
|
|
|
- if( x < 0 ) then
|
|
|
- x := -x;
|
|
|
-
|
|
|
- { above this value, round towards zero }
|
|
|
- if( x > lossth ) then
|
|
|
- begin
|
|
|
- cos := 0.0;
|
|
|
- exit;
|
|
|
- end;
|
|
|
-
|
|
|
- y := Trunc( x/PIO4 );
|
|
|
- z := ldexp( y, -4 );
|
|
|
- z := Trunc(z); { integer part of y/8 }
|
|
|
- z := y - ldexp( z, 4 ); { y - 16 * (y/16) }
|
|
|
-
|
|
|
- { integer and fractional part modulo one octant }
|
|
|
- i := Trunc(z);
|
|
|
- if odd( i ) then { map zeros to origin }
|
|
|
- begin
|
|
|
- inc(i);
|
|
|
- y := y + 1.0;
|
|
|
- end;
|
|
|
- j := i and 07;
|
|
|
- if( j > 3) then
|
|
|
- begin
|
|
|
- dec(j,4);
|
|
|
- sign := -sign;
|
|
|
- end;
|
|
|
- if( j > 1 ) then
|
|
|
- sign := -sign;
|
|
|
-
|
|
|
- { Extended precision modular arithmetic }
|
|
|
- z := ((x - y * DP1) - y * DP2) - y * DP3;
|
|
|
-
|
|
|
- zz := z * z;
|
|
|
-
|
|
|
- if( (j=1) or (j=2) ) then
|
|
|
- { y = z + z * (zz * polevl( zz, sincof, 5 )); }
|
|
|
- y := z + z * z * z * polevl( zz, sincof, 5 )
|
|
|
- else
|
|
|
- y := 1.0 - ldexp(zz,-1) + zz * zz * polevl( zz, coscof, 5 );
|
|
|
-
|
|
|
- if(sign < 0) then
|
|
|
- y := -y;
|
|
|
-
|
|
|
- cos := y ;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
- function ArcTan(x:Real):Real;
|
|
|
- {*****************************************************************}
|
|
|
- { Inverse circular tangent (arctangent) }
|
|
|
- {*****************************************************************}
|
|
|
- { }
|
|
|
- { SYNOPSIS: }
|
|
|
- { }
|
|
|
- { double x, y, atan(); }
|
|
|
- { }
|
|
|
- { y = atan( x ); }
|
|
|
- { }
|
|
|
- { DESCRIPTION: }
|
|
|
- { }
|
|
|
- { Returns radian angle between -pi/2 and +pi/2 whose tangent }
|
|
|
- { is x. }
|
|
|
- { }
|
|
|
- { Range reduction is from four intervals into the interval }
|
|
|
- { from zero to tan( pi/8 ). The approximant uses a rational }
|
|
|
- { function of degree 3/4 of the form x + x**3 P(x)/Q(x). }
|
|
|
- {*****************************************************************}
|
|
|
- const P : TabCoef = (
|
|
|
- -8.40980878064499716001E-1,
|
|
|
- -8.83860837023772394279E0,
|
|
|
- -2.18476213081316705724E1,
|
|
|
- -1.48307050340438946993E1, 0, 0, 0);
|
|
|
- Q : TabCoef = (
|
|
|
- 1.54974124675307267552E1,
|
|
|
- 6.27906555762653017263E1,
|
|
|
- 9.22381329856214406485E1,
|
|
|
- 4.44921151021319438465E1, 0, 0, 0);
|
|
|
-
|
|
|
- { tan( 3*pi/8 ) }
|
|
|
- T3P8 = 2.41421356237309504880;
|
|
|
- { tan( pi/8 ) }
|
|
|
- TP8 = 0.41421356237309504880;
|
|
|
-
|
|
|
- var y,z : Real;
|
|
|
- Sign : Integer;
|
|
|
-
|
|
|
- begin
|
|
|
- { make argument positive and save the sign }
|
|
|
- sign := 1;
|
|
|
- if( x < 0.0 ) then
|
|
|
- begin
|
|
|
- sign := -1;
|
|
|
- x := -x;
|
|
|
- end;
|
|
|
-
|
|
|
- { range reduction }
|
|
|
- if( x > T3P8 ) then
|
|
|
- begin
|
|
|
- y := PIO2;
|
|
|
- x := -( 1.0/x );
|
|
|
- end
|
|
|
- else if( x > TP8 ) then
|
|
|
- begin
|
|
|
- y := PIO4;
|
|
|
- x := (x-1.0)/(x+1.0);
|
|
|
- end
|
|
|
- else
|
|
|
- y := 0.0;
|
|
|
-
|
|
|
- { rational form in x**2 }
|
|
|
-
|
|
|
- z := x * x;
|
|
|
- y := y + ( polevl( z, P, 3 ) / p1evl( z, Q, 4 ) ) * z * x + x;
|
|
|
-
|
|
|
- if( sign < 0 ) then
|
|
|
- y := -y;
|
|
|
- Arctan := y;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function int(d : fixed) : fixed;
|
|
|
- {*****************************************************************}
|
|
|
- { Returns the integral part of d }
|
|
|
- {*****************************************************************}
|
|
|
- begin
|
|
|
- int:=d and $ffff0000; { keep only upper bits }
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function trunc(d : fixed) : longint;
|
|
|
- {*****************************************************************}
|
|
|
- { Returns the Truncated integral part of d }
|
|
|
- {*****************************************************************}
|
|
|
- begin
|
|
|
- trunc:=longint(integer(d shr 16)); { keep only upper 16 bits }
|
|
|
- end;
|
|
|
-
|
|
|
- function frac(d : fixed) : fixed;
|
|
|
- {*****************************************************************}
|
|
|
- { Returns the Fractional part of d }
|
|
|
- {*****************************************************************}
|
|
|
- begin
|
|
|
- frac:=d AND $ffff; { keep only decimal parts - lower 16 bits }
|
|
|
- end;
|
|
|
-
|
|
|
- function abs(d : fixed) : fixed;
|
|
|
- {*****************************************************************}
|
|
|
- { Returns the Absolute value of d }
|
|
|
- {*****************************************************************}
|
|
|
- var
|
|
|
- w: integer;
|
|
|
- begin
|
|
|
- w:=integer(d shr 16);
|
|
|
- if w < 0 then
|
|
|
- begin
|
|
|
- w:=-w; { invert sign ... }
|
|
|
- d:=d and $ffff;
|
|
|
- d:=d or (fixed(w) shl 16); { add this to fixed number ... }
|
|
|
- abs:=d;
|
|
|
- end
|
|
|
- else
|
|
|
- abs:=d; { already positive... }
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function sqr(d : fixed) : fixed;
|
|
|
- {*****************************************************************}
|
|
|
- { Returns the Absolute squared value of d }
|
|
|
- {*****************************************************************}
|
|
|
- begin
|
|
|
- {16-bit precision needed, not 32 =)}
|
|
|
- sqr := d*d;
|
|
|
-{ sqr := (d SHR 8 * d) SHR 8; }
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function Round(x: fixed): longint;
|
|
|
- {*****************************************************************}
|
|
|
- { Returns the Rounded value of d as a longint }
|
|
|
- {*****************************************************************}
|
|
|
- var
|
|
|
- lowf:integer;
|
|
|
- highf:integer;
|
|
|
- begin
|
|
|
- lowf:=x and $ffff; { keep decimal part ... }
|
|
|
- highf :=integer(x shr 16);
|
|
|
- if lowf > 5 then
|
|
|
- highf:=highf+1
|
|
|
- else
|
|
|
- if lowf = 5 then
|
|
|
- begin
|
|
|
- { here we must check the sign ... }
|
|
|
- { if greater or equal to zero, then }
|
|
|
- { greater value will be found by adding }
|
|
|
- { one... }
|
|
|
- if highf >= 0 then
|
|
|
- Highf:=Highf+1;
|
|
|
- end;
|
|
|
- Round:= longint(highf);
|
|
|
- end;
|
|
|
-
|
|
|
- function power(bas,expo : real) : real;
|
|
|
- begin
|
|
|
- if bas=0 then
|
|
|
- begin
|
|
|
- if expo<>0 then
|
|
|
- power:=0.0
|
|
|
- else
|
|
|
- HandleError(207);
|
|
|
- end
|
|
|
- else if expo=0 then
|
|
|
- power:=1
|
|
|
- else
|
|
|
- { bas < 0 is not allowed }
|
|
|
- if bas<0 then
|
|
|
- handleerror(207)
|
|
|
- else
|
|
|
- power:=exp(ln(bas)*expo);
|
|
|
- end;
|
|
|
-
|
|
|
- function power(bas,expo : longint) : longint;
|
|
|
- begin
|
|
|
- if bas=0 then
|
|
|
- begin
|
|
|
- if expo<>0 then
|
|
|
- power:=0
|
|
|
- else
|
|
|
- HandleError(207);
|
|
|
- end
|
|
|
- else if expo=0 then
|
|
|
- power:=1
|
|
|
- else
|
|
|
- begin
|
|
|
- if bas<0 then
|
|
|
- begin
|
|
|
- if odd(expo) then
|
|
|
- power:=-round(exp(ln(-bas)*expo))
|
|
|
- else
|
|
|
- power:=round(exp(ln(-bas)*expo));
|
|
|
- end
|
|
|
- else
|
|
|
- power:=round(exp(ln(bas)*expo));
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
-{
|
|
|
- $Log$
|
|
|
- Revision 1.3 2002-09-07 16:01:26 peter
|
|
|
- * old logs removed and tabs fixed
|
|
|
-
|
|
|
-}
|
carl