[pdp8.git] / sw / f4 / FRTSRC / expci.ra

/
/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
Commit	Line	Data
7af5ad59 PH	1	/
	2	/EXPCI
	3	/COMPLEX RAISED TO INTEGER OR REAL
	4	/
	5	/ VERSION 5A 4-26-77 MH
	6	/
	7	/
	8	/C=A+I*B
	9	/C^D=R^DEXP(DI*THETA)
	10	/
	11	/C IS IN #BASE
	12	/D IS IN AC
	13	/
	14	/ENTER IN STARTF,EXIT IN STARTE
	15	/
	16	SECT #EXPCI
	17	ENTRY #EXPCR
	18	DPCHK
	19	EXTERN SQRT
	20	EXTERN ATAN2
	21	EXTERN SIN
	22	EXTERN COS
	23	EXTERN EXP3
	24	EXTERN #CAC
	25	BASE 0
	26	#EXPCR, JA .
	27	FSTA EXPON,0
	28	FLDA 0 /REAL
	29	FSTA A,0
	30	FLDA 3 /IMAG
	31	FSTA B,0
	32	/SET DUMMY BASE PAGE
	33	BASE .+2000
	34	/
	35	/R=SQRT(AA+BB)
	36	FLDA A
	37	FMUL A
	38	FSTA R
	39	FLDA B
	40	FMUL B
	41	FADDM R
	42	JSR SQRT
	43	JA .+4
	44	JA R
	45	FSTA R
	46	/R^EXPON
	47	JSR EXP3
	48	JA .+6
	49	JA R
	50	JA EXPON
	51	FSTA R
	52	/THETA=ATAN(B/A)
	53	JSR ATAN2
	54	JA .+6
	55	JA B
	56	JA A
	57	/THETA*EXPON
	58	FMUL EXPON
	59	FSTA A /PHASE ANGLE
	60	/IMAG=R*SIN(PHASE)
	61	JSR SIN
	62	JA .+4
	63	JA A
	64	FMUL R
65	FSTA B
66	/REAL=R*COS(PHASE)
67	JSR COS
68	JA .+4
69	JA A
70	FMUL R
71	FSTA A
72	JGE .+3 /SKIP IF RESULT IS POS
73	FNEG /IF NOT,MAKE IT POS
74	FSUB LOWLIM /TEST FOR ZERO
75	JGE .+5 /JUMP IF NOT 0
76	FCLA /ASSUME RESULT SHOULD BE 0
77	FSTA A /AND STORE A 0
78	/RETURN RESULT IN #CAC AND STARTE
79	STARTE
80	FLDA A
81	FSTA #CAC
82	JA #EXPCR
83	A, F 0.0
84	B, F 0.0
85	EXPON, F 0.0
86	R, F 0.0
87	LOWLIM, F 0.000009 /NUMBERS >= 1.E-5 OK
88	\f