sw/f4/FRTSRC/cosh.ra

   1 /
   2 / VERSION 5A 4-27-77  PT
   3 /
   4 /       C  O  S  H
   5 /       -  -  -  -
   6 /
   7 /SUBROUTINE     COSH(X)
   8 /
   9 / VERSION 5A 4-27-77  PT
  10         SECT    COSH
  11         JA      #COSH
  12 COSHE,  FLDA    COSHB           /GIVE INFINITY IN CASE OF NO REC
  13         EXTERN  #ARGER
  14         TRAP4   #ARGER
  15         TEXT    +COSH  +
  16 COSHXR, SETX    XRCOSH
  17         SETB    BPCOSH
  18 BPCOSH, FNOP
  19         0
  20         0
  21 XRCOSH, F 0.0
  22 COSH7,  F 0.0
  23 COSH8,  F 0.0
  24 F1COSH, F 1.
  25 F2COSH, F 2.
  26         ORG     10*3+BPCOSH
  27         FNOP
  28         JA      COSHXR
  29         0
  30 CSHRTN, JA      .
  31 /
  32 COSHLG, 0
  33         2613
  34         4412
  35 /
  36 COSHB,  3777
  37         3777
  38         7777
  39 /
  40 /
  41 COSH1,  F 88.029                        /LIMIT FACTOR.
  42         BASE    0
  43 #COSH,  STARTD
  44         FLDA    10*3
  45         FSTA    CSHRTN
  46         FLDA    0
  47         SETX    XRCOSH
  48         SETB    BPCOSH
  49         BASE    BPCOSH
  50         LDX     1,1
  51         FSTA    BPCOSH
  52         FLDA%   BPCOSH,1        /ADDR OF X
  53         FSTA    BPCOSH
  54         STARTF
  55         FLDA%   BPCOSH  /GET X
  56         FSTA    COSH8           /SAVE ARGUMENT
  57         JGE     .+3             /ABS(X)
  58         FNEG
  59         FSTA    COSH7
  60         FSUB    COSH1           /TEST FOR LIMITS.
  61         JGE     COSHBG
  62         EXTERN  EXP
  63         JSR     EXP             /EXP(X)
  64         JA      .+4
  65         JA      COSH8
  66         FSTA    COSH7
  67         FLDA    F1COSH          /1.
  68         FDIV    COSH7           / 1./EXP(X)
  69         FADD    COSH7           / EXP(X)+1./EXP(X)
  70         FDIV    F2COSH          / (EXP(X)+1./EXP(X))2.
  71         JA      CSHRTN          /AND THAT IS THE DEFINITION OF COSH.
  72 /
  73 /
  74 COSHBG, FSUB    COSHLG          /SEE IF TOO BIG
  75         JGT     COSHE           /YEP. ERROR
  76         FADD    COSH1           /READD IN SUBTRACTION FACTOR.
  77         FSTA    COSH8           / EXP(ABS(X)-LN(2))
  78         EXTERN  EXP
  79         JSR     EXP
  80         JA      .+4
  81         JA      COSH8
  82         JA      CSHRTN          / A VERY GOOD APPROXIMATION.
  83 \f