home *** CD-ROM | disk | FTP | other *** search
/ norge.freeshell.org (192.94.73.8) / 192.94.73.8.tar / 192.94.73.8 / pub / computers / cpm / alphatronic / JRTPAS40.ZIP / SIN.PAS < prev    next >
Pascal/Delphi Source File  |  1999-04-03  |  2KB  |  66 lines
  1.  
  2. EXTERN
  3.  
  4.  
  5. {=================================================================}
  6. FUNCTION sin (x : real) : real;
  7. CONST
  8. pi = 3.1415926535897;
  9. two_pi = 6.2831853071796;
  10. VAR
  11. i : integer;
  12.  
  13.  
  14. {=================================================================}
  15. PROCEDURE compute_sin;
  16. VAR
  17. result, result2, f, exclam, x2, power : real;
  18. odd1, i : integer;
  19.  
  20. BEGIN  (* compute_sin *)
  21.  
  22. x2 := sqr(x);
  23. power := x * x2;
  24. odd1 :=  - 1;
  25. i := 0;
  26. result := x;
  27. exclam := 6.0;
  28. f := 3.0;
  29. REPEAT
  30.        result2 := result;
  31.        IF odd1 = 1 THEN
  32.               result := result + (power / exclam)
  33.        ELSE
  34.               result := result - (power / exclam);
  35.        power := power * x2;
  36.        odd1 :=  - odd1;
  37.        f := f + 2.0;
  38.        exclam := f * (f - 1.0) * exclam;
  39.        i := i + 1;
  40.        IF i > 5 THEN
  41.               BEGIN
  42.               i := 0;
  43.               IF abs(result - result2) < (1e-12 * result) THEN
  44.                      result2 := result;
  45.               END;
  46. UNTIL result = result2;
  47. sin := result;
  48. END;  (* compute_sin *)
  49.  
  50. BEGIN  (* sin *)
  51.  
  52. IF (x = 0.0) OR (x = pi) OR (x = two_pi) THEN
  53.        sin := 0.0
  54. ELSE
  55.        BEGIN
  56.        WHILE x < 0.0 DO
  57.               x := x + two_pi;
  58.        WHILE x > two_pi DO
  59.               x := x - two_pi;
  60.        IF x > 1.0e-08 THEN
  61.               compute_sin
  62.        ELSE
  63.               sin := x;
  64.        END;  (* else *)
  65. END;  (* sin *)  .
  66.