File: EXPCC.RA of Tape: Sources/Fortran/os8-f4-3
(Source file text)
/C=C**C EXPCC COMPLEX RAISED TO COMPLEX INT. FUNC. / / / VERSION 40A 27-MAY-80 WVDM / / /(A+I*B)^(C+I*D) /A+B=0 YIELDS 0 /B+D=0 MEANS USE EXP3 TO CALCULATTE A^C /A+B=0,C+D=0 YIELDS 1.0 /ENTER + EXIT IN STARTE / SECT #EXPCC DPCHK EXTERN #CAC EXTERN EXP EXTERN COS EXTERN SIN EXTERN ALOG EXTERN EXP3 EXTERN ATAN2 EXTERN SQRT / BASE 0 EXPCC, JA . FSTA C,0 FLDA 0 FSTA A,0 STARTF BASE .+2000 XTA 0 FSTA T1 /SAVE XR 0 FLDA A JNE EX1 /A NOT 0 FLDA B JNE EX1 STARTE /A=B=0 FCLA EX, FSTA #CAC /RESULT = 0 JA EXPCC / 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 B JNE EX3 /USE EXP3 IF B=D=0 FLDA D JNE EX3 STARTF JSR EXP3 JA .+6 JA A JA C FSTA A STARTE FLDA A /RETURN AS REAL PART JA EX / EX3, STARTF JSR ATAN2 /TH=ATAN(B/A) JA .+6 JA B JA A FSTA TH FLDA A /LOGR=ALOG(SQRT(A*A+B*B)) FMUL A FSTA LOGR FLDA B FMUL B FADD LOGR FSTA LOGR JSR SQRT JA .+4 JA LOGR FSTA LOGR JSR ALOG JA .+4 JA LOGR FSTA LOGR FLDA C /ARG=C*TH+D*LOGR FMUL TH FSTA ARG FLDA D FMUL LOGR FADD ARG FSTA ARG JSR SIN /CALCULATE IN AND COS OF ARG. JA .+4 /SAVE SIGN OF EACH JA ARG FSTA SINE JSR COS JA .+4 JA ARG FSTA CSINE FLDA D /CALL C*LOGR-D*TH FMUL TH FSTA REST FLDA C FMUL LOGR FSUB REST FSTA REST FLDA CSINE /REAL = EXP(REST+ALOG(CSINE)) JLT .+6 LDX 0,1 /=1 IF POSITIVE JA .+3 FNEG JSA DO JXN .+3,0 /SKIP IF POS FNEG FSTA A FLDA SINE /IMAG JLT .+6 LDX 0,1 JA .+5 LDX 0,0 FNEG JSA DO JXN .+3,0 FNEG /RESTORE SIGN FSTA B FLDA T1 /RESTORE XR0 ATX 0 STARTE FLDA A FSTA #CAC JA EXPCC / DO, JA . FSTA TH JSR ALOG JA .+4 JA TH FADD REST FSTA ARG JSR EXP JA .+4 JA ARG FSTA ARG FLDA TH /CHECK SIGN JGE DOX FLDA ARG FNEG FSTA ARG DOX, FLDA ARG JA DO A, F 0.0 B, F 0.0 C, F 0.0 D, F 0.0 LOGR, F 0.0 TH, 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