--
--	Inmos Libraries
--	Copyright (C) 1988, 1989, 1990, 1991, 1993  Inmos Limited
--
--	This library is free software; you can redistribute it and/or
--	modify it under the terms of the GNU Lesser General Public
--	License as published by the Free Software Foundation; either
--	version 2 of the License, or (at your option) any later version.
--
--	This library is distributed in the hope that it will be useful,
--	but WITHOUT ANY WARRANTY; without even the implied warranty of
--	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--	Lesser General Public License for more details.
--
--	You should have received a copy of the GNU Lesser General Public
--	License along with this library; if not, write to the Free Software
--	Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
--

--** @module maths

#OPTION "V"  -- no vector space
#COMMENT "Floating point maths library, V1.3 11/02/91"
#COMMENT "(c) Copyright INMOS Limited 1988"
#INCLUDE "mathhdr.inc"
#PRAGMA TRANSLATE Dexp "Dexp%O"

--{{{  history
-- V1.0 1-Jul-88
-- V1.1 11-Oct-88
-- Added OPTION "V"; V1.2 27-Mar-90 SRH
-- Moved Dexp out of each routine so that there was only one copy of it
-- thus reducing code size and easing maintainability; V1.3 11-Feb-91 SRH
--}}}

--{{{  hyperbolic function coefficients
VAL REAL64 XMax   RETYPES #408633CE9708893B(INT64) :
VAL REAL64 XBig   RETYPES #40325E4F7B2737FA(INT64) : -- (BitsInFrac/2)log(2)
VAL REAL64 VBy2M1 RETYPES #3EED0112EB0202D5(INT64) :
VAL REAL64 LnV    RETYPES #3FE62E6000000000(INT64) :
--}}}
--{{{  reduced Dexp
--* Double-precision exponential without input guards, for hyperbolic
-- functions.
-- @private
REAL64 FUNCTION Dexp (VAL REAL64 X)

  REAL64 RWork :
  VALOF
    --{{{  definitions
    VAL REAL64 DLn2     RETYPES #3FE62E42FEFA39EF(INT64) :
    VAL REAL64 DLn2.err RETYPES #3C7ABC9E3B39803F(INT64) :
    VAL P2 IS 3.1555192765684646356E-5(REAL64) :
    VAL P1 IS 7.5753180159422776666E-3(REAL64) :
    VAL P0 IS 0.25(REAL64) :
    VAL Q3 IS 7.5104028399870046114E-7(REAL64) :
    VAL Q2 IS 6.3121894374398503557E-4(REAL64) :
    VAL Q1 IS 5.6817302698551221787E-2(REAL64) :
    VAL Q0 IS 0.5(REAL64) :
    --}}}
    REAL64 XWork :
    INT32 N :
    SEQ
      BOOL ok :  -- it will be, because the range of X has been limited.
      ok, N, XWork := DARGUMENT.REDUCE (X, DLn2, DLn2.err)
      VAL Z IS XWork * XWork :
      VAL GPZ IS ((((P2 * Z) + P1) * Z) + P0) * XWork :
      RWork := DSCALEB (Q0 +
                       (GPZ /(((((((Q3 * Z) + Q2) * Z) + Q1) * Z) + Q0) - GPZ)),
                        (INT N) + 1) -- N guaranteed small
    RESULT RWork
:
--}}}
--{{{  DSINH   (floating point) 
--* Double-precision hyperbolic sine.
--
-- @param X Hyperbolic angle
-- @return Hyperbolic sine of X
REAL64 FUNCTION DSINH (VAL REAL64 X)

  REAL64 Result :
  VALOF
    IF
      DNOTFINITE (X)
        Result := X -- transmit Infs and NaNs
      VAL XWork IS DABS (X) :
      IF
        XWork > XMax
          --{{{  + or - Inf
          IF
            X < DZero
              Result := DMINUSX(DRInf)
            TRUE
              Result := DRInf
          --}}}
        XWork > XBig
          --{{{  modify argument and use exponential
          VAL EX IS Dexp (XWork - LnV) :
          IF
            X < DZero
              Result := - (EX + (EX * VBy2M1))
            TRUE
              Result := EX + (EX * VBy2M1)
          --}}}
        XWork >= DOne
          --{{{  use exponential and modify result
          VAL EX IS Dexp (XWork) :
          IF
            X < DZero
              Result := - DDIVBY2 (EX - (DOne/EX))
            TRUE
              Result := DDIVBY2 (EX - (DOne/EX))
          --}}}
        TRUE
          --{{{  use rational approximation
          VAL P3 IS -7.8966127417357099479E-1(REAL64) :
          VAL P2 IS -1.6375798202630751372E+2(REAL64) :
          VAL P1 IS -1.1563521196851768270E+4(REAL64) :
          VAL P0 IS -3.5181283430177117881E+5(REAL64) :
          VAL Q2 IS -2.7773523119650701667E+2(REAL64) :
          VAL Q1 IS  3.6162723109421836460E+4(REAL64) :
          VAL Q0 IS -2.1108770058106271242E+6(REAL64) :
          VAL G IS XWork * XWork :
          Result := (((((((((P3*G)+P2)*G)+P1)*G)+P0)/(((((G+Q2)*G)+Q1)*G)+Q0))*G)*X)+X
          --}}}
    RESULT Result
:
--}}}
--{{{  DCOSH   (floating point)
--* Double-precision hyperbolic cosine.
--
-- @param X Hyperbolic angle
-- @return Hyperbolic cosine of X
REAL64 FUNCTION DCOSH (VAL REAL64 X)

  REAL64 Result :
  VALOF
    IF
      --{{{  Inf or NaN
      DNOTFINITE (X)
        IF
          DISNAN (X)
            Result := X
          TRUE -- +/- Inf
            Result := DRInf
      --}}}
      VAL XWork IS DABS (X) :
      IF
        XWork > XMax
          Result := DRInf
        XWork > XBig
          VAL EX IS Dexp (XWork - LnV) :
          Result := EX + (EX * VBy2M1)
        TRUE
          VAL EX IS Dexp (XWork) :
          Result := DDIVBY2 (EX + (DOne/EX))
    RESULT Result
:
--}}}
--{{{  DTANH   (floating point)
--* Double-precision hyperbolic tangent.
--
-- @param X Hyperbolic angle
-- @return Hyperbolic tangent of X
REAL64 FUNCTION DTANH (VAL REAL64 X)

  REAL64 RWork :
  VALOF
    IF
      DNOTFINITE (X)
        --{{{  deal with infs and NaNs
        INT order :
        SEQ
          order := DIEEECOMPARE (X, DZero)
          CASE order
            less.than
              RWork := DOne
            greater.than
              RWork := DOne
            is.nan
              RWork := X     -- transmit NaN
        --}}}
      --{{{  definitions
      -- ((DBitsInFrac + 2)ln2)/2, rounded up a bit. See C&W p242.
      VAL REAL64 XMax RETYPES #40330FC193B3A68B(INT64) :
      VAL REAL64 Ln3By2 RETYPES #3FE193EA7AAD030B(INT64) :
      VAL XWork IS DABS (X) :
      --}}}
      IF
        XWork > XMax
          --{{{  +/- One
          IF
            X < DZero
              RWork := - DOne
            TRUE
              RWork := DOne
          --}}}
        XWork > Ln3By2
          --{{{  use exponential
          IF
            X > DZero
              RWork := DOne - (DTwo/(DOne + Dexp (DMULBY2 (XWork))))
            TRUE
              RWork := (DTwo/(DOne + Dexp (DMULBY2 (XWork)))) - DOne
          --}}}
        TRUE
          --{{{  rational approximation
          VAL P2 IS -9.6437492777225469787E-1(REAL64) :
          VAL P1 IS -9.9225929672236083313E+1(REAL64) :
          VAL P0 IS -1.6134119023996228053E+3(REAL64) :
          VAL Q2 IS  1.1274474380534949335E+2(REAL64) :
          VAL Q1 IS  2.2337720718962312926E+3(REAL64) :
          VAL Q0 IS  4.8402357071988688686E+3(REAL64) :
          VAL G IS XWork * XWork :
          RWork := X+(X*((((((P2*G)+P1)*G)+P0)*G)/(((((G+Q2)*G)+Q1)*G)+Q0)))
          --}}}
    RESULT RWork
:
--}}}

