\ tests for ftran201.f

MARKER -ftntest

FVARIABLE a  FVARIABLE b  FVARIABLE c  FVARIABLE x  FVARIABLE w

: test0   CR  f" b+c"  FE.
          CR  f" b-c"  FE.
          CR  f" 10000000*(b-c)/(b+c)"  FE.
;

f$" b = 3"
f$" c = 4"
test0

: test1   f" a = b*c-3.17e-5/TANH(w)+ABS(x)"  CR  f" a" F. ;

f$" w = 1.e-3"  f$" x = -2.5"  CR CR  test1

FVARIABLE HALFPI
f$" HALFPI = 2*ATAN(1)"
f$" HALFPI" FDUP F+ F.

FVARIABLE disc                    ( Used for discriminant )

: quadraticroot                   ( F: a b c -- r1 r2 )
    c F!  b F!  a F!                         \ Pickup coefficients.
    f" disc = SQRT(b*b-4*a*c)"               \ Set discriminant.
    f" (-b+disc)/(2*a)" f" (-b-disc)/(2*a)"  \ Put values on f-stack.
;

( Solve x*x-3*x+2 )  f$" quadraticroot(1,-3, 2)"  F. F.
( Find goldenratio ) f$" MAX(quadraticroot (1,-1,-1))" F.