home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol082 / cos.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  1.0 KB  |  65 lines
  1. extern
  2. function cos ( x : real ): real;
  3.  
  4. const
  5. half_pi = 1.5707963267948;
  6. pi = 3.1415926535897;
  7. two_pi = 6.2831853071796;
  8.  
  9. var
  10. i : integer;
  11.  
  12. procedure compute_cos;
  13. var
  14. result,result2,f,exclam,x2,power,odd1 : real;
  15. i : integer;
  16.  
  17. procedure factorial;
  18. begin
  19. f:=f+2.0;
  20. exclam:=exclam * (f-1.0) * f;
  21. end;
  22.  
  23. begin (* compute_cos *)
  24. x2:=sqr(x);
  25. power:=x*x2;
  26. odd1:=-1.0;
  27. i:=0;
  28. result:=x;
  29. exclam:=6.0;
  30. f:=3.0;
  31.  
  32. repeat
  33.   result2:=result;
  34.   result:=result + odd1 * (power/exclam);
  35.   power:=power*x2;
  36.   odd1:=-odd1;
  37.   factorial;
  38.   i:=i+1;
  39.   if i > 5 then
  40.     begin
  41.     i:=0;
  42.     if abs(result-result2) < (1e-12*result) then
  43.       result2:=result;
  44.     end;
  45. until result = result2;
  46.  
  47. cos:=result;
  48. end; (* compute_cos *)
  49.  
  50. begin (* cos *)
  51. if x = 0.0 then cos:=1.0 else
  52. begin (* else_1 *)
  53. x:=x+half_pi;
  54.  
  55. if (x=0.0) or (x=pi) or (x=two_pi) then cos:=0.0 else
  56. begin
  57. while x < 0.0 do x:=x+two_pi;
  58. while x > two_pi do x:=x-two_pi;
  59.  
  60. compute_cos;
  61.  
  62. end; (* else *)
  63. end; (* else_1 *)
  64. end;.  (* cos *)
  65.