[pdp8.git] / sw / os8 / v3d / sources / fortran / dectapes / dectape2 / expcc.ra

/
/EXPCC
/COMPLEX RAISED TO COMPLEX
/
/ VERSION 5A 4-26-77 MH
/
/(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
/TH=ATAN(B/A)
	JSR	ATAN2
	JA	.+6
	JA	B
	JA	A
	FSTA	TH
/
/LOGR=ALOG(SQRT(A*A+B*B))
	FLDA	A
	FMUL	A
	FSTA	LOGR
	FLDA	B
	FMUL	B
	FADDM	LOGR
	JSR	SQRT
	JA	.+4
	JA	LOGR
	FSTA	LOGR
	JSR	ALOG
	JA	.+4
	JA	LOGR
	FSTA	LOGR
/ARG=C*TH+D*LOGR
	FLDA	C
	FMUL	TH
	FSTA	ARG
	FLDA	D
	FMUL	LOGR
	FADDM	ARG
/
/CALCULATE IN 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*TH
	FLDA	D
	FMUL	TH
	FSTA	REST
	FLDA	C
	FMUL	LOGR
	FSUB	REST
	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	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
\f
Commit	Line	Data
81e70d48 PH	1	/
	2	/EXPCC
	3	/COMPLEX RAISED TO COMPLEX
	4	/
	5	/ VERSION 5A 4-26-77 MH
	6	/
	7	/(A+IB)^(C+ID)
	8	/A+B=0 YIELDS 0
	9	/B+D=0 MEANS USE EXP3 TO CALCULATTE A^C
	10	/A+B=0,C+D=0 YIELDS 1.0
	11	/ENTER + EXIT IN STARTE
	12	SECT #EXPCC
	13	DPCHK
	14	EXTERN #CAC
	15	EXTERN EXP
	16	EXTERN COS
	17	EXTERN SIN
	18	EXTERN ALOG
	19	EXTERN EXP3
	20	EXTERN ATAN2
	21	EXTERN SQRT
	22	BASE 0
	23	EXPCC, JA .
	24	FSTA C,0
	25	FLDA 0
	26	FSTA A,0
	27	STARTF
	28	BASE .+2000
	29	XTA 0
	30	FSTA T1 /SAVE XR 0
	31	FLDA A
	32	JNE EX1 /A NOT 0
	33	FLDA B
	34	JNE EX1
	35	STARTE /A=B=0
	36	FCLA
	37	EX, FSTA #CAC /RESULT = 0
	38	JA EXPCC
	39	EX1, FLDA C /C+D=0?
	40	JNE EX2
	41	FLDA D
	42	JNE EX2
	43	STARTE
	44	FLDA FP1 /RESULT = 1 IF C=D=0
	45	JA EX
	46	EX2, FLDA B
	47	JNE EX3 /USE EXP3 IF B=D=0
	48	FLDA D
	49	JNE EX3
	50	STARTF
	51	JSR EXP3
	52	JA .+6
	53	JA A
	54	JA C
	55	FSTA A
	56	STARTE
	57	FLDA A /RETURN AS REAL PART
	58	JA EX
	59	EX3, STARTF
	60	/TH=ATAN(B/A)
	61	JSR ATAN2
	62	JA .+6
	63	JA B
	64	JA A
65	FSTA TH
66	/
67	/LOGR=ALOG(SQRT(AA+BB))
68	FLDA A
69	FMUL A
70	FSTA LOGR
71	FLDA B
72	FMUL B
73	FADDM LOGR
74	JSR SQRT
75	JA .+4
76	JA LOGR
77	FSTA LOGR
78	JSR ALOG
79	JA .+4
80	JA LOGR
81	FSTA LOGR
82	/ARG=CTH+DLOGR
83	FLDA C
84	FMUL TH
85	FSTA ARG
86	FLDA D
87	FMUL LOGR
88	FADDM ARG
89	/
90	/CALCULATE IN AND COS OF ARG. SAVE SIGN OF EACH
91	JSR SIN
92	JA .+4
93	JA ARG
94	FSTA SINE
95	JSR COS
96	JA .+4
97	JA ARG
98	FSTA CSINE
99	/CALL CLOGR-DTH
100	FLDA D
101	FMUL TH
102	FSTA REST
103	FLDA C
104	FMUL LOGR
105	FSUB REST
106	FSTA REST
107	/REAL = EXP(REST+ALOG(CSINE))
108	FLDA CSINE /REAL
109	JLT .+6
110	LDX 0,1 /=1 IF POSITIVE
111	JA .+3
112	FNEG
113	JSA DO
114	JXN .+3,0 /SKIP IF POS
115	FNEG
116	FSTA A
117	FLDA SINE /IMAG
118	JLT .+6
119	LDX 0,1
120	JA .+5
121	LDX 0,0
122	FNEG
123	JSA DO
124	JXN .+3,0
125	FNEG /RESTORE SIGN
126	FSTA B
127	FLDA T1 /RESTORE XR0
128	ATX 0
129	STARTE
130	FLDA A
131	FSTA #CAC
132	JA EXPCC
133	/
134	DO, JA .
135	FSTA TH
136	JSR ALOG
137	JA .+4
138	JA TH
139	FADD REST
140	FSTA ARG
141	JSR EXP
142	JA .+4
143	JA ARG
144	FSTA ARG
145	FLDA TH /CHECK SIGN
146	JGE DOX
147	FLDA ARG
148	FNEG
149	FSTA ARG
150	DOX, FLDA ARG
151	JA DO
152	A, F 0.0
153	B, F 0.0
154	C, F 0.0
155	D, F 0.0
156	LOGR, F 0.0
157	TH, F 0.0
158	ARG, F 0.0
159	SINE, F 0.0
160	CSINE, F 0.0
161	REST, F 0.0
162	FP1, F 1.0
163	F 0.0
164	T1, F 0.0
165	\f