X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fdectapes%2Fdectape1%2Fexpci.ra;fp=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fdectapes%2Fdectape1%2Fexpci.ra;h=9b9b76bcc8ac0bc4df9bfdaf4c1296a39a52227f;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git

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
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
+