home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / math / trigonom / trigfunc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-05-17  |  3.4 KB  |  105 lines
  1. { ******************************************************************** }
  2. { *                     TrigFun.bas   %INCLUDE FILE                  * }
  3. { *          Trigonometric functions For CBASIC-80 version 2.08      * }
  4. { *                   Copyright (c) 1982, Robert Lurie               * }
  5. { ******************************************************************** }
  6.  
  7.  
  8. { ******************************* constants ************************** }
  9.  
  10. CONST Pi     =  3.14159265358979;
  11.       Sqrt2  =  1.41421356237310;
  12.  
  13.       LocT0  =  0.103851714551977E4;
  14.       LocT1  = -0.178056467143863E2;
  15.       LocT2  =  0.262478645943200E-1;
  16.       LocT3  =  0.264456219512224E4;
  17.       LocT4  = -0.181283283485401E3;
  18.  
  19.       LocT5  =  0.216062307897243E3;
  20.       LocT6  =  0.322662070013251E3;
  21.       LocT7  =  0.132702398163977E3;
  22.       LocT8  =  0.128883830341573E2;
  23.       LocT9  =  0.216062307897243E3;
  24.       LocT10 =  0.394682839312283E3;
  25.       LocT11 =  0.221050883028418E3;
  26.       LocT12 =  0.385014865083512E2;
  27.  
  28. { ****************************** functions *************************** }
  29.  
  30. FUNCTION TanHalf(x:REAL):REAL;
  31.    VAR O, OSquare : REAL;
  32.        Loop       : INTEGER;
  33.    BEGIN O := ABS(x) / (pi + pi);
  34.          O := 8.0 * (O - INT(O));
  35.          Loop := 0;
  36.          WHILE (O > 1.0) DO  BEGIN
  37.             O := 0.5 * O;
  38.             Loop := Loop + 1
  39.          END;
  40.          OSquare := Sqr(O);
  41.          O := O*((LocT2*OSquare + LocT1)*OSquare + LocT0)
  42.                      / ((OSquare + LocT4)*OSquare + LocT3);
  43.          WHILE Loop > 0 DO  BEGIN
  44.             O := (O + O) / (1.0 - Sqr(O));
  45.             Loop := Loop - 1
  46.          END;
  47.          IF x < 0.0 THEN TanHalf := -O  ELSE TanHalf := O
  48.    END;
  49.  
  50. FUNCTION Sine(x:REAL):REAL;
  51.    BEGIN x := TanHalf(x);
  52.          Sine := (x + x) / (1.0 + Sqr(x))
  53.    END;
  54.  
  55. FUNCTION Cosine(x:REAL):REAL;
  56.    BEGIN x := TanHalf(x);
  57.          x := Sqr(x);
  58.          Cosine := (1.0 - x) / (1.0 + x)
  59.    END;
  60.  
  61. FUNCTION Tan(x:REAL):REAL;
  62.    BEGIN x := TanHalf(x);
  63.          Tan := (x + x) / (1.0 - Sqr(x))
  64.    END;
  65.  
  66. FUNCTION ATan(x:REAL):REAL;
  67.    VAR O, OSquare : REAL;
  68.        Loop       : INTEGER;
  69.    BEGIN O  := ABS(x);
  70.          Loop := 0;
  71.          IF (O > Sqrt2 + 1.0) THEN  BEGIN
  72.               Loop := 2; O := -1.0 / O
  73.          END;
  74.          IF (O > Sqrt2 - 1.0) THEN  BEGIN
  75.               Loop := 1; O := 1.0 - 2.0 / (1.0 + O)
  76.          END;
  77.          OSquare := Sqr(O);
  78.          O := O * (((LocT8 * OSquare + LocT7)
  79.                     * OSquare + LocT6) * OSquare + LocT5);
  80.          OSquare := (((OSquare + LocT12) * OSquare + LocT11)
  81.                     * OSquare + LocT10) * OSquare + LocT9;
  82.          O := O / OSquare;
  83.          IF Loop = 1 THEN O := O + 0.25 * pi;
  84.          IF Loop = 2 THEN O := O + 0.50 * pi;
  85.          IF x < 0.0 THEN ATan := -O ELSE ATan := O
  86.    END;
  87.  
  88. FUNCTION ASin(x:REAL):REAL;
  89.    VAR O, OSquare : REAL;
  90.    BEGIN O := ABS(x);
  91.         IF O > 1.0 THEN WRITE('Illegal arguement');
  92.         IF O = 1.0 THEN BEGIN
  93.              IF x < 0.0 THEN ASin :=  -0.5 * pi
  94.                         ELSE ASin := 0.5 * pi
  95.              END
  96.         ELSE ASin := ATan(x / SQR(1.0 - Sqr(x)))
  97.    END;
  98.  
  99. FUNCTION ACos(x:REAL):REAL;
  100.    BEGIN ACos := (0.5 * pi) - ASin(x)
  101.    END;
  102.  
  103. { ************************** end of TrigFunc.bas ********************* }
  104.  
  105.