Unit HYPERBOL;

(* Bibliotheque mathematique des fonctions hyperboliques *)
(* JD GAYRARD mars 94 *)

(* revision 1.0 de Oct 95 pour :
- correction de arg_th (test valeur negative) *)

{$G+}
{$N+}
{$E-}

interface

uses MATHLIB;

const author  = 'GAYRARD J-D';
      version = 'ver 1.0 - 10/95';

const TANH_MAX = 13;       (* argument maximum de th(x) pour type real *)
      SQR_MAX = 1.3E+19;   (* argument maximum d'un carre pour type real *)
      EXP_MAX = 88.0288;   (* argument maximum de exp pour type real *)

(* fonctions trigonometriques directes *)
function ch(x : float): float;
function sh(x : float): float;
function th(x : float): float;

(* fonctions trigonometriques inverses *)
function arg_ch(x : float): float;
function arg_sh(x : float): float;
function arg_th(x : float): float;

implementation

(* fonctions trigonometriques directes *)

function ch(x : float): float;
(* retourne le cosinus hyperbolique de l'argument *)
(* ch(x) = [exp(x) + exp(-x)] / 2 *)
begin
if (x > EXP_MAX) or (x < - EXP_MAX)
   then begin
        writeln('******** Fonction ch ********');
        writeln('********* OVERFLOW **********');
        halt
        end
   else begin
        x := exp(x);
        ch := 0.5 * (x + 1.0 / x)
        end
end;

function sh(x : float): float;
(* retourne le sinus hyperbolique de l'argument *)
(* sh(x) = [exp(x) - exp(-x)] / 2 *)
begin
if (x > EXP_MAX) or (x < -EXP_MAX)
   then begin
        writeln('******** Fonction sh ********');
        writeln('********* UNDERFLOW *********');
        halt
        end
   else begin
        x := exp(x);
        sh := 0.5 * (x - (1.0 / x))
        end
end;

function th(x : float): float;
(* retourne la tangente hyperbolique de l'argument *)
(* th(x) = sh(x) / ch(x) *)
(* th(x) = [exp(x) - exp(x)] / [exp(x) + exp(-x)] *)
begin
if (x > TANH_MAX) or (x < - TANH_MAX)
   then if x > 0.0 then th := 1.0
                   else th := - 1.0
   else th := sh(x) / ch(x)
end;

(* fonctions trigonometriques inverses *)

function arg_ch(x : float): float;
(* retourne l'arc cosinus hyperbolique de l'argument *)
(*                       ________          *)
(* arg ch(x) = ln ( x + V x.x - 1 )  fonction definie pour x >=1 *)
begin
if x < 1.0
   then begin
        writeln('******** Fonction arg_ch ********');
        writeln('********** RANGE ERROR **********');
        halt
        end
   else if x > SQR_MAX
           then begin
                writeln('******** Fonction  arg_ch ********');
                writeln('************ OVERFLOW ************');
                halt
                end
           else arg_ch := ln(x + sqrt(x * x - 1.0))
end;

function arg_sh(x : float): float;
(* retourne l'arc sinus hyperbolique de l'argument *)
(*                       _________   *)
(* arg sh(x) = ln ( x + V x.x + 1 )  *)
begin
if (x < -SQR_MAX) or (x > SQR_MAX)
   then begin
        writeln('******** Fonction Arg_sh ********');
        writeln('************ OVERFLOW ***********');
        halt
        end
   else arg_sh := ln(x + sqrt(x * x + 1.0))
end;

function arg_th(x : float): float;
(* retourne l'arc tangente hyperbolique de l'argument *)
(* arg th(x) = 1/2 ln [ (1 + x) / (1 - x) fonction definie pour |x| < 1 *)
begin
if (x <= -1.0) or (x >= 1.0)
   then begin
        writeln('******** Fonction Arg_th ********');
        writeln('********** RANGE ERROR **********');
        halt
        end
   else arg_th := signe(0.5 * ln((1.0 + x) / (1.0 - x)),x)

end;

end.