home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol022 / cosine.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  1.0 KB  |  56 lines
  1. (**************************************************
  2. *
  3. *    Add this to your library. Ray Penley wrote
  4. *  this when the furnished program had a bug but it
  5. *  is still nice to have.
  6. *
  7. *  donated Sept,1980
  8. ***************************************************)
  9.  
  10. PROGRAM COSINE_DUMMY;
  11. (*$I+*)
  12. FUNCTION COSINE(X:REAL):REAL;
  13. {+++   COSINE ROUTINE, ANGLE "X" MUST BE IN RADIANS   +++}
  14. CONST    PI = 3.1415926536;
  15.     J = 2;
  16. VAR    M,N : INTEGER;
  17.     R,S,T,U,V : REAL;
  18. (*
  19.     NAME COSINE
  20.     ENTRY COSINE
  21. *)
  22.     FUNCTION FIX(Y,P: REAL): REAL;
  23.     VAR    SGN : -1..1;
  24.     BEGIN
  25.       IF Y>0.0 THEN
  26.         SGN := 1
  27.       ELSE IF Y=0.0 THEN
  28.         SGN := 0
  29.       ELSE
  30.         SGN := -1;
  31.       FIX := SGN * TRUNC(ABS(Y)/P);
  32.     END;
  33. (*
  34. COSINE:
  35. *)
  36. BEGIN
  37.   R := 0.0;
  38.   IF ABS(X)>PI THEN R := FIX(X,PI);
  39.   X := X - R * PI;
  40.   M := -1;
  41.   N := 0;
  42.   S := 1.0;
  43.   T := 1.0;
  44.   U := -X * X;
  45.   REPEAT
  46.     V := S;
  47.     M := M + J; N := N + J;
  48.     T := T*U/(M*N) ;
  49.     S := S + T;
  50.   UNTIL (S = V);
  51.   IF (TRUNC(R) MOD J<>0) THEN S := -S;
  52.   COSINE := S;
  53. END;
  54. (*$I-*)
  55. begin end.
  56.