A large commit.

[pdp8.git] / sw / os8 / v3d / sources / fortran / dectapes / dectape1 / expci.ra

diff --git a/sw/os8/v3d/sources/fortran/dectapes/dectape1/expci.ra b/sw/os8/v3d/sources/fortran/dectapes/dectape1/expci.ra
new file mode 100644 (file)
index 0000000..9b9b76b
--- /dev/null
+++ b/sw/os8/v3d/sources/fortran/dectapes/dectape1/expci.ra
@@ -0,0 +1,88 @@
+/
+/EXPCI
+/COMPLEX RAISED TO INTEGER OR REAL
+/
+/ VERSION 5A 4-26-77 MH
+/
+/
+/C=A+I*B
+/C^D=R^D*EXP(D*I*THETA)
+/
+/C IS IN #BASE
+/D IS IN AC
+/
+/ENTER IN STARTF,EXIT IN STARTE
+/
+       SECT    #EXPCI
+       ENTRY   #EXPCR
+       DPCHK
+       EXTERN  SQRT
+       EXTERN  ATAN2
+       EXTERN  SIN
+       EXTERN  COS
+       EXTERN  EXP3
+       EXTERN  #CAC
+       BASE    0
+#EXPCR,        JA      .
+       FSTA    EXPON,0
+       FLDA    0               /REAL
+       FSTA    A,0
+       FLDA    3               /IMAG
+       FSTA    B,0
+/SET DUMMY BASE PAGE
+       BASE    .+2000
+/
+/R=SQRT(A*A+B*B)
+       FLDA    A
+       FMUL    A
+       FSTA    R
+       FLDA    B
+       FMUL    B
+       FADDM   R
+       JSR     SQRT
+       JA      .+4
+       JA      R
+       FSTA    R
+/R^EXPON
+       JSR     EXP3
+       JA      .+6
+       JA      R
+       JA      EXPON
+       FSTA    R
+/THETA=ATAN(B/A)
+       JSR     ATAN2
+       JA      .+6
+       JA      B
+       JA      A
+/THETA*EXPON
+       FMUL    EXPON
+       FSTA    A               /PHASE ANGLE
+/IMAG=R*SIN(PHASE)
+       JSR     SIN
+       JA      .+4
+       JA      A
+       FMUL    R
+       FSTA    B
+/REAL=R*COS(PHASE)
+       JSR     COS
+       JA      .+4
+       JA      A
+       FMUL    R
+       FSTA    A
+       JGE     .+3     /SKIP IF RESULT IS POS
+       FNEG            /IF NOT,MAKE IT POS
+       FSUB    LOWLIM  /TEST FOR ZERO
+       JGE     .+5     /JUMP IF NOT 0
+       FCLA            /ASSUME RESULT SHOULD BE 0
+       FSTA    A       /AND STORE A 0
+/RETURN RESULT IN #CAC AND STARTE
+       STARTE
+       FLDA    A
+       FSTA    #CAC
+       JA      #EXPCR
+A,     F 0.0
+B,     F 0.0
+EXPON, F 0.0
+R,     F 0.0
+LOWLIM,        F 0.000009      /NUMBERS >= 1.E-5 OK
+\f