(*********************************************************************
 
    :Program.  	 MathLibExt.mod
    :Author.   	 Gary Struhlik  
    :Address.    -
    :Phone.      -
    :shortcut. 	 [gs]
    :Version.  	 1.0   
    :Date.     	 06.10.1988
    :Copyright.  PD
    :Language. 	 Modula-II
    :Translator. M2Amiga
    :Imports.	 -
    :UpDate.	 -
    :Contents.	 Zusätzliche mathematische Funktionen
    :Remark.	 Für den Amiga Modula-2 Klub / Stuttgart
    :Remark.     Am 01.01.1989 mit M2Amiga 3.2d neu kompiliert

**********************************************************************)

IMPLEMENTATION MODULE MathLibExt; (* für Datentyp REAL *)

FROM Mathlib0 IMPORT sin,cos,ln,exp,sqrt,arctan;

PROCEDURE round ( x : REAL ) : LONGINT;
BEGIN
   IF    x >= 0.0 THEN RETURN TRUNC( x + 0.5 )
   ELSE  RETURN TRUNC( x - 0.5 )
   END (* IF *)
END round;        

PROCEDURE sqr ( x : REAL ) : REAL;
BEGIN
   RETURN x*x
END sqr;   	
 
PROCEDURE tan ( x : REAL ) : REAL;
BEGIN
   RETURN sin(x)/cos(x)
END tan;

PROCEDURE arcsin ( x : REAL ) : REAL;
BEGIN
   IF x=1.0 THEN RETURN pi/2.0
    ELSIF x=-1.0 THEN RETURN -pi/2.0
   ELSE
    RETURN arctan(x/sqrt(1.0-x*x))
   END
END arcsin;

PROCEDURE arccos ( x : REAL ) : REAL;
BEGIN
   IF x=1.0 THEN RETURN 0.0
    ELSIF x=-1.0 THEN RETURN pi
   ELSE
    RETURN pi/2.0-arcsin(x)
   END
END arccos;

PROCEDURE sinh ( x : REAL ) : REAL;
BEGIN
   RETURN 0.5*(exp(x)-exp(-x))
END sinh;

PROCEDURE cosh ( x : REAL ) : REAL;
BEGIN
   RETURN 0.5*(exp(x)+exp(-x))
END cosh;

PROCEDURE tanh ( x : REAL ) : REAL;
BEGIN
   RETURN sinh(x)/cosh(x)
END tanh;

PROCEDURE log ( x : REAL ) : REAL;
BEGIN
   RETURN ln(x)/ln10
END log;

PROCEDURE PwrOfTen ( x : REAL ) : REAL;
BEGIN
   RETURN exp(x*ln10)
END PwrOfTen;

PROCEDURE lb ( x : REAL ) : REAL;
BEGIN
   RETURN ln(x)/ln2
END lb;

PROCEDURE PwrOfTwo ( x : REAL ) : REAL;
BEGIN
   RETURN exp(x*ln2)
END PwrOfTwo;

PROCEDURE arsinh ( x : REAL ) : REAL;
BEGIN
   RETURN ln( x + sqrt( x*x + 1.0))
END arsinh;

PROCEDURE arcosh ( x : REAL ) : REAL;
BEGIN
   IF (x > 1.0) THEN RETURN ln( x + sqrt( x*x - 1.0))  (* für x # 1.0  *)
    ELSIF x=1.0 THEN RETURN 0.0
   END (* IF *)
END arcosh;

PROCEDURE artanh ( x : REAL ) : REAL;
BEGIN
   RETURN 0.5*ln( (1.0+x)/(1.0-x) )  (* für x # 1.0   *)
END artanh;

PROCEDURE power ( x,y : REAL ) : REAL; (* x^y *)
VAR
	wert,n : REAL;
        i      : INTEGER;
BEGIN
   IF (x = 0.0) AND (y = 0.0) THEN
       RETURN 1.0E-38
     ELSIF x = 0.0 THEN
           RETURN 0.0
       ELSIF y = 0.0 THEN
             RETURN 1.0
	   ELSIF x > 0.0 THEN
             IF ( y-REAL(TRUNC(y)) <> 0.0 ) THEN
                RETURN exp(y*ln(x))
             ELSE
                n:=1.0;
                FOR i:=1 TO ABS(TRUNC(y)) DO
                   n:=n*x
                END; (* FOR *)
                IF y > 0.0 THEN
                   RETURN n
                ELSE
                   RETURN 1.0/n
                END (* IF y > 0.0 *)
             END (* IF y-REAL... *)
           ELSE	
	     IF (y-REAL(TRUNC(y)) <> 0.0) THEN
                RETURN 1.0E-38
             ELSE
                n:=1.0;
                FOR i:=1 TO ABS(TRUNC(y)) DO
                   n:=n*x
                END; (* FOR *)
                IF y > 0.0 THEN 
                   RETURN n
                ELSE
                   RETURN 1.0/n
                END
	     END
   END
END power;   
                                     	
PROCEDURE fact ( x : REAL ) : REAL; (*  Fakultät  *)
VAR
	i : INTEGER;
        fac : REAL;
BEGIN
   fac:=1.0;
   IF (x = 1.0) OR (x = 0.0) THEN
      RETURN 1.0
    ELSIF x < 0.0 THEN
      RETURN 1.0E-38
    ELSE
      FOR i:=2 TO TRUNC(x) DO
          fac:=fac+fac*( REAL(i)-1.0 )   
      END; (* FOR *)
      RETURN fac
   END
END fact;

PROCEDURE sgn ( x : REAL ) : REAL;  (*   Vorzeichen -1.0, 0.0 oder +1.0  *)
BEGIN
   IF x = 0.0 THEN
      RETURN 0.0
   ELSE
      RETURN x/ABS(x)
   END (* IF *)
END sgn;

END MathLibExt.