home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / gp / powers.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-17  |  1.5 KB  |  80 lines
  1. UNIT POWERS;
  2. INTERFACE
  3. function pwrr(x,y: REAL) : REAL;
  4. function pwri(x: REAL; n: integer): REAL;
  5.  
  6. IMPLEMENTATION
  7. function pwrr(x,y: REAL) : REAL;
  8. { evaluates X**Y, use pwri if y integer; see pc tech may '85 p213}
  9. begin
  10.    if x>0
  11.       then pwrr := exp(y*ln(x))
  12.    else if x<0
  13.       then
  14.         begin
  15.           writeln('x < 0.0. HALT');
  16.           halt
  17.         end
  18.    else if (x=0) and(y=0)
  19.       then
  20.         begin
  21.           writeln('0 to the 0 power. HALT.');
  22.           halt
  23.         end
  24.    else if (x=0) and (y<0)
  25.       then
  26.         begin
  27.           writeln('0 to a negative power. HALT.');
  28.           halt
  29.         end
  30.    else pwrr := 0.0
  31. end;
  32.  
  33.  
  34. function rlscan(x: REAL; n: integer): REAL;
  35. { used by pwri }
  36. var  y,z: REAL;
  37.        oh: boolean;
  38.     bign: integer;
  39.  
  40. begin
  41.   bign :=n;
  42.   y := 1.0;
  43.   z := x;
  44.   while bign > 0 do
  45.     begin
  46.       oh := odd(bign);
  47.       bign := bign div 2;
  48.       if oh then
  49.         begin
  50.           y := y*z;
  51.           rlscan := y
  52.         end;
  53.       z := z*z
  54.     end;
  55. end;
  56.  
  57.  
  58. function pwri(x: REAL; n: integer): REAL;
  59. { computes X**I, uses rlscan above }
  60. begin
  61.   if ( n>0 ) then pwri := rlscan(x,n)
  62.   else if ( x <> 0.0 ) and ( n < 0 ) then
  63.     begin
  64.       n := -n;
  65.       pwri := 1.0/rlscan(x,n)
  66.     end
  67.   else if ( n = 0 ) and ( x <> 0.0 ) then pwri := 1.0
  68.   else if (n = 0) and (x = 0.0) then
  69.     begin
  70.       writeln('0 to the 0 power. HALT.');
  71.       halt
  72.     end
  73.   else if (n < 0) and (x = 0.0) then
  74.     begin
  75.       writeln('division by zero. HALT.');
  76.       halt
  77.     end
  78. end;
  79. END.
  80.