software: Added more and more
[pdp8.git] / sw / f4 / FRTSRC / csqrt.ra
diff --git a/sw/f4/FRTSRC/csqrt.ra b/sw/f4/FRTSRC/csqrt.ra
new file mode 100644 (file)
index 0000000..161769d
--- /dev/null
@@ -0,0 +1,92 @@
+/
+/   C S Q R T
+/   - - - - - 
+/
+/ VERSION 5A 4-27-77  PT
+/
+/COMPLEX SQUARE ROOT ROUTINE
+/ENTER+ EXIT IN COMPLEX
+/Z=X+IX
+/
+/SQRT(Z)=SQRT(R)*COS(THETA)+SIN(THETA))
+/
+/R=SQRT(X*X+Y*Y)
+/THETA=ATAN2(Y/X)/2
+/
+/CALLS SQRT,ATAN2,SIN,COS
+/
+       SECT    CSQRT
+       JA      #CSQRT
+       DPCHK
+       TEXT    +CSQRT +
+CSQRTX,        SETX    XR
+       SETB    BP
+       JA      .+3
+BP,    F 0.0
+XR,    F 0.0
+ARG,   F 0.0
+       F 0.0
+THETA, F 0.0
+FP2,   F 2.0
+       ORG 10*3+BP
+       FNOP
+       JA      CSQRTX
+       0
+RT,    JA      .
+       BASE    0
+#CSQRT,        STARTD
+       FLDA    10*3
+       FSTA    RT
+       FLDA    0
+       SETB    BP
+       SETX    XR
+       BASE    BP
+       LDX     1,1
+       FSTA    BP
+       FLDA%   BP,1
+       FSTA    BP
+       STARTE
+       FLDA%   BP
+       FSTA    ARG
+       STARTF
+       EXTERN  ATAN2
+       JSR     ATAN2           /ATAN(Y/X)
+       JA      CSA
+       JA      ARG+3
+       JA      ARG
+CSA,   FDIV    FP2             /ATAN/2
+       FSTA    THETA
+       FLDA    ARG
+       FMULM   ARG             /X*X
+       FLDA    ARG+3
+       FMUL    ARG+3           /Y*Y
+       FADD    ARG             /X*X+Y*Y
+       FSTA    ARG
+       EXTERN  SQRT            /SQRT(X*X+Y*Y)
+       JSR     SQRT
+       JA      CSB
+       JA      ARG
+CSB,   FSTA    ARG             /R
+       EXTERN  SQRT
+       JSR     SQRT
+       JA      CSC
+       JA      ARG             /SQRT(R)
+CSC,   FSTA    ARG             /SQRT(R)
+       EXTERN  SIN
+       JSR     SIN             /SIN(THETA/2)
+       JA      CSD
+       JA      THETA
+CSD,   FMUL    ARG             /*SQRT(X)
+       FSTA    ARG+3
+       EXTERN  COS
+       JSR     COS             /COS(THETA/2)*SQRT(R)
+       JA      CSE
+       JA      THETA
+CSE,   FMUL    ARG
+       FSTA    ARG
+       STARTE
+       FLDA    ARG
+       FSTA    #CAC
+       JA      RT
+       EXTERN  #CAC
+\f