'*************************************************
'Program to demonstrate the hyperbolic subroutines
'-------------------------------------------------
'Reference: BASIC Scientific Subroutines, Vol. II
'  By F.R. Ruckdeschel, BYTE/McGRAWW-HILL, 1981.
'  [BIBLI 01].
'*************************************************
defint i-n
defdbl a-h,o-z
cls
dim A(10),W(10)
F1$="  ##.#" : F2$="  ###.##########"
ligne=1
print
print "   X        SINH(X)         COSH(X)         TANH(X) "
print " ---------------------------------------------------"
for x=-5# to 5.2# step 0.2#
  print using F1$; X;
'get sinh(x)
  gosub 1000
  print using F2$; Y;
'get cosh(x)
  gosub 1500
  print using F2$; Y;
'get tanh(x)
  gosub 2000
  print using F2$; Y
  if ligne=20 then
    ligne=0
    input "",R$
    cls
    print:print
  end if
  ligne=ligne+1
next X
print
end

500 'Modified cordic exponential subroutine
' This subroutine takes an input value and returns Y=EXP(X)
' X may be any positive or negative real value
' Get coefficients
gosub 900
' Reduce the range of X
  K=INT(X)
  X=X-K
' Determine the weighting coeffs, W(I)
gosub 800
' Calculate products
  Y=1#
  for I=1 to N
    if W(I)>0# then Y=Y*A(I)
  next I
' Perform residual multiplication
  Y=Y*(1#+Z*(1#+Z/2#*(1#+Z/3#*(1#+Z/4#))))
' Account for factor EXP(K)
  if K<0 then E=1#/E
  if ABS(K)<1 then goto 510
  for I=1 to ABS(K)
    Y=Y*E
  next I
' Restore X
  X=X+K
510 return

800 A=0.5#
  Z=X
  for I=1 to N
    W(I)=0#
    if Z>A then W(I)=1#
    Z=Z-W(I)*A
    A=A/2#
  next I
return

900 N=9
  E=2.718281828459045
  A(1)=1.648721270700128
  A(2)=1.284025416687742
  A(3)=1.133148453066826
  A(4)=1.064494458917859
  A(5)=1.031743407499103
  A(6)=1.015747708586686
  A(7)=1.007843097206448
  A(8)=1.003913889338348
  A(9)=1.001955033591003
return

'--------------------------------------------
'        Hyperbolic sine subroutine
' ------------------------------------------
' This subroutine uses the definition of the
' hyperbolic sine and the modified cordic
' exponential subroutine 500 to approximate
' SINH(X) over the entire range of real X.
'--------------------------------------------
' Is X small enough to cause round off erroe ?
1000 if ABS(X)<0.35 then goto 1100
' Calculate SINH(X) using exponential definition
' Get Y=EXP(X)
  gosub 500
  Y=(Y-(1#/Y))/2#
  return
1100 'series approximation (for X small)
  Z=1# : Y=1#
  for I=1 to 8
    Z=Z*X*X/((2*I)*(2*I+1))
    Y=Y+Z
  next I
  Y=X*Y
return

1500 'hyperbolic cosine subroutine
  gosub 500
  Y=(Y+(1#/Y))/2#
return

2000 'hyperbolic tangent subroutine
'     TANH(X)=SINH(X)/COSH(X)
  gosub 1000 'get SINH(X)
  V=Y
  gosub 1500 'get COSH(X)
  Y=V/Y
return

' End of file hyper.bas