--- /dev/null
+/
+/EXPIC
+/INTEGER OR REAL RAISED TO COMPLEX
+/
+/ VERSION 5A 4-26-77 MH
+/
+/(A)^(C+I*D)
+/A=0 YIELDS 0
+/D=0 MEANS USE EXP3 TO CALCULATE A^C
+/C+D=0 YIELDS 1.0
+/ENTER + EXIT IN STARTE
+ SECT #EXPIC
+ DPCHK
+ EXTERN #CAC
+ EXTERN EXP
+ EXTERN COS
+ EXTERN SIN
+ EXTERN ALOG
+ EXTERN EXP3
+ EXTERN SQRT
+ BASE 0
+EXPIC, JA .
+ FSTA C,0
+ STARTF
+ FLDA 0 /BASE
+ FSTA A,0
+ BASE .+2000
+ XTA 0
+ FSTA T1 /SAVE XR 0
+ FLDA A
+ JNE EX1 /A NOT 0
+ STARTE /A=B=0
+ FCLA
+EX, FSTA #CAC /RESULT = 0
+ JA EXPIC
+EX1, FLDA C /C+D=0?
+ JNE EX2
+ FLDA D
+ JNE EX2
+ STARTE
+ FLDA FP1 /RESULT = 1 IF C=D=0
+ JA EX
+EX2, FLDA D
+ JNE EX3 /USE EXP3 IF D=0
+ JSR EXP3
+ JA .+6
+ JA A
+ JA C
+ FSTA A
+ STARTE
+ FLDA A /RETURN AS REAL PART
+ JA EX
+/
+/LOGR=ALOG(SQRT(A*A))
+EX3, FLDA A
+ FMUL A
+ FSTA LOGR
+ JSR SQRT
+ JA .+4
+ JA LOGR
+ FSTA LOGR
+ JSR ALOG
+ JA .+4
+ JA LOGR
+ FSTA LOGR
+/ARG=C+D*LOGR
+ FLDA D
+ FMUL LOGR
+ FADD C
+ FSTA ARG
+/
+/CALCULATE SIN AND COS OF ARG. SAVE SIGN OF EACH
+ JSR SIN
+ JA .+4
+ JA ARG
+ FSTA SINE
+ JSR COS
+ JA .+4
+ JA ARG
+ FSTA CSINE
+/CALL C*LOGR-D
+ FLDA C
+ FMUL LOGR
+ FSUB D
+ FSTA REST
+/REAL = EXP(REST+ALOG(CSINE))
+ FLDA CSINE /REAL
+ JLT .+6
+ LDX 0,1 /=1 IF POSITIVE
+ JA .+3
+ FNEG
+ JSA DO
+ JXN .+3,0 /SKIP IF POS
+ FNEG
+ FSTA C
+ FLDA SINE /IMAG
+ JLT .+6
+ LDX 0,1
+ JA .+5
+ LDX 0,0
+ FNEG
+ JSA DO
+ JXN .+3,0
+ FNEG /RESTORE SIGN
+ FSTA D
+ FLDA T1 /RESTORE XR0
+ ATX 0
+ STARTE
+ FLDA C
+ FSTA #CAC
+ JA EXPIC
+/
+DO, JA .
+ FSTA LOGR
+ JSR ALOG
+ JA .+4
+ JA LOGR
+ FADD REST
+ FSTA ARG
+ JSR EXP
+ JA .+4
+ JA ARG
+ FSTA ARG
+ FLDA LOGR /CHECK SIGN
+ JGE DOX
+ FLDA ARG
+ FNEG
+ FSTA ARG
+DOX, FLDA ARG
+ JA DO
+A, F 0.0
+C, F 0.0
+D, F 0.0
+LOGR, F 0.0
+ARG, F 0.0
+SINE, F 0.0
+CSINE, F 0.0
+REST, F 0.0
+FP1, F 1.0
+ F 0.0
+T1, F 0.0
+\f