home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / calculat / pibcal11.zip / MATHROUT.PAS < prev    next >
Pascal/Delphi Source File  |  1985-03-11  |  5KB  |  150 lines
  1. (*--------------------------------------------------------------------------*)
  2. (*                 MATHROUT.PAS --- Mathematical Routines                   *)
  3. (*--------------------------------------------------------------------------*)
  4. (*                                                                          *)
  5. (*     Routines included:                                                   *)
  6. (*                                                                          *)
  7. (*        Log10    -- Base 10 logarithm                                     *)
  8. (*        Log      -- General base logarithm                                *)
  9. (*        Arcsin   -- Inverse sin                                           *)
  10. (*        ArcCos   -- Inverse cosine                                        *)
  11. (*        ArcTan2  -- Inverse tangent                                       *)
  12. (*        PowerI   -- Raise real to integer power                           *)
  13. (*        Power    -- Raise real to real power                              *)
  14. (*                                                                          *)
  15. (*--------------------------------------------------------------------------*)
  16.  
  17. (*--------------------------------------------------------------------------*)
  18. (*                     Log10 -- Base 10 logarithm                           *)
  19. (*--------------------------------------------------------------------------*)
  20.  
  21. FUNCTION Log10( x: REAL ) : REAL;
  22.  
  23. BEGIN (* Log10 *)
  24.    Log10 := LN( x ) * LN( 10.0 );
  25. END   (* Log10 *);
  26.  
  27. (*--------------------------------------------------------------------------*)
  28. (*                     Log -- General base logarithm                        *)
  29. (*--------------------------------------------------------------------------*)
  30.  
  31. FUNCTION Log( x: REAL; y: REAL ) : REAL;
  32.  
  33. BEGIN (* Log *)
  34.    Log := LN( x ) * LN( y );
  35. END   (* Log *);
  36.  
  37. (*--------------------------------------------------------------------------*)
  38. (*                       ArcSin -- Inverse sine                             *)
  39. (*--------------------------------------------------------------------------*)
  40.  
  41. FUNCTION ArcSin( x: REAL ) : REAL;
  42.  
  43. VAR
  44.    AbsX:  REAL;
  45.  
  46. BEGIN (* ArcSin *)
  47.  
  48.    AbsX := ABS( x );
  49.  
  50.    IF AbsX = 1.0 THEN
  51.        IF x < 0.0 THEN
  52.           ArcSin :=  ( -Pi / 2.0 )
  53.        ELSE
  54.           ArcSin := Pi / 2.0
  55.    ELSE ArcSin := ArcTan( x / SQRT( 1.0 - X * X ) );
  56.  
  57. END   (* ArcSin *);
  58.  
  59. (*--------------------------------------------------------------------------*)
  60. (*                       ArcCos -- Inverse cosine                           *)
  61. (*--------------------------------------------------------------------------*)
  62.  
  63. FUNCTION ArcCos( x: REAL ) : REAL;
  64.  
  65. BEGIN (* ArcCos *)
  66.    ArcCos := PI / 2.0 - ArcSin( x );
  67. END   (* ArcCos *);
  68.  
  69. (*--------------------------------------------------------------------------*)
  70. (*                       ArcTan2 -- Inverse tangent (two args)              *)
  71. (*--------------------------------------------------------------------------*)
  72.  
  73. FUNCTION ArcTan2( x: REAL; y: REAL ) : REAL;
  74.  
  75. VAR
  76.    R: REAL;
  77.  
  78. BEGIN (* ArcTan2 *)
  79.  
  80.    IF y = 0.0 THEN
  81.       BEGIN
  82.          Error('Second argument to ATAN2 is 0');
  83.          R := 0.0;
  84.       END
  85.    ELSE
  86.       BEGIN
  87.  
  88.          R := ARCTAN( x / y );
  89.  
  90.          IF y < 0.0 THEN
  91.             IF R < 0.0 THEN
  92.                R := R + PI
  93.             ELSE
  94.                R := R - PI;
  95.  
  96.       END;
  97.  
  98.    ArcTan2 := R;
  99.  
  100. END   (* ArcTan2 *);
  101.  
  102. (*--------------------------------------------------------------------------*)
  103. (*                     PowerI -- raise real to integer power                *)
  104. (*--------------------------------------------------------------------------*)
  105.  
  106. FUNCTION PowerI( x: REAL; i: INTEGER ) : REAL;
  107.  
  108. VAR
  109.    Temp: REAL;
  110.    AbsI: INTEGER;
  111.  
  112. BEGIN (* PowerI *)
  113.  
  114.    IF i < 0 THEN
  115.       BEGIN
  116.          i := -i;
  117.          IF x <> 0.0 THEN x := 1.0 / x;
  118.       END;
  119.  
  120.    Temp := 1.0;
  121.  
  122.    WHILE( i > 0 ) DO
  123.       BEGIN
  124.  
  125.          WHILE ( NOT ODD( i ) ) DO
  126.             BEGIN
  127.                i := i DIV 2;
  128.                x := x * x;
  129.             END;
  130.  
  131.          i    := i - 1;
  132.          Temp := Temp * x;
  133.  
  134.       END;
  135.  
  136.    PowerI := Temp;
  137.  
  138. END   (* PowerI *);
  139.  
  140.  
  141. (*--------------------------------------------------------------------------*)
  142. (*                       Power -- raise real to real power                  *)
  143. (*--------------------------------------------------------------------------*)
  144.  
  145. FUNCTION Power( x: REAL; y: REAL ) : REAL;
  146.  
  147. BEGIN (* Power *)
  148.    power := EXP( y * LN( x ) );
  149. END   (* Power *);
  150.