sw/os8/v3d/sources/fortran/dectapes/dectape2/dsqrt.ra

   1 /
   2 /
   3 /       D S Q R T
   4 /
   5 / VERSION 5A 4-27-77  PT
   6 /
   7         SECT    DSQRT
   8         JA      #DSQRT
   9         DPCHK
  10         TEXT    +DSQRT +
  11 /
  12 DSQXR,  SETX    XRDSQ
  13         SETB    BPDSQ
  14         JA      .+3
  15 BPDSQ,  F 0.0
  16 XRDSQ,  F 0.0
  17 DARSAV, F 0.0
  18         F 0.0
  19 DSQ2,   F 2.0
  20         F 0.0
  21 SNGL,   F 0.0
  22         F 0.0
  23         ORG 10*3+BPDSQ
  24         FNOP
  25         JA      DSQXR
  26 /
  27         0
  28 DSQRTN, JA      .
  29 DSQ1,   F 0.0
  30         F 0.0
  31 /PICK UP ARGUMENTS
  32         BASE    0
  33 #DSQRT, STARTD
  34         FLDA    10*3
  35         FSTA    DSQRTN
  36         FLDA    0
  37         SETX    XRDSQ
  38         SETB    BPDSQ
  39         BASE    BPDSQ
  40         LDX     1,1
  41         FSTA    BPDSQ
  42         FLDA%   BPDSQ,1 /ADDR OF X
  43         FSTA    BPDSQ
  44 /
  45 /DO GENERAL TESTS ON THE ARGUMENT
  46 /
  47         STARTE
  48         FLDA%   BPDSQ
  49         JEQ     DSQRTN  /RETURN IF 0
  50         JLT     DSQER   /<0 ERROR
  51         FSTA    DARSAV  /SAVE DOUBLE
  52         STARTF          /F MODE + ROUND
  53         FSTA    SNGL    /SAVE
  54 /
  55 /GET INITIAL APPROXIMATION BY CALLING
  56 /SINGLE PRECISION ROUTINE
  57 /
  58         EXTERN  SQRT
  59         JSR     SQRT
  60         JA      .+4
  61         JA      SNGL
  62         FSTA    SNGL    /FIRST APPROX
  63         STARTE          /BACK TO E
  64 /
  65 /TAKE N ITERATIONS OF
  66 /X(K+1)=1/2(X(K)+X/X(K))
  67 /
  68         LDX     -3,0    /3 TIMES
  69 DSIT,   FLDA    DARSAV  /GET X
  70         FDIV    SNGL    /X(K)
  71         FADD    SNGL    /X(K)
  72         FDIV    DSQ2    /DIVIDE BY 2
  73         FSTA    SNGL    /X(K+1)
  74         JXN     DSIT,0+ /ITERATE
  75         FLDA    SNGL    /GET ANSWER
  76         JA      DSQRTN  /RETURN
  77         EXTERN  #ARGER
  78 DSQER,  TRAP4   #ARGER
  79 \f