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

diff --git a/sw/os8/v3d/sources/fortran/dectapes/dectape2/datan.ra b/sw/os8/v3d/sources/fortran/dectapes/dectape2/datan.ra
new file mode 100644
index 0000000..fcd488b
--- /dev/null
+++ b/sw/os8/v3d/sources/fortran/dectapes/dectape2/datan.ra
@@ -0,0 +1,203 @@
+/
+/
+/ SUBROUTINE DATAN(X)
+/
+/ VERSION 5A 4-26-77 (MH)
+/
+/X,THE ARGUMENT, IS REDUCED TO 
+/0<X<1/2
+/BY THE IDENTITIES:
+/ATAN(-X)=-ATAN(X)
+/IF X>1.0 THEN ATAN(X)=PI/2 - ATAN(1/X)
+/IF .5<X<1.0 THEN ATAN(X)=ATAN(1/2)+ATAN(2*X-(1/(X+2)))
+/ATAN(X)=X FOR X<2^(-15)
+/
+/
+/
+	SECT	DATAN
+	JA	#DATAN
+	DPCHK
+/
+	TEXT	+DATAN +
+DATNXR,	SETX 	XRDATN
+	SETB	BPDATN
+BPDATN,	F 0.0
+XRDATN,	F 0.0
+DATFP1,	F 1.0
+	F 0.0
+DATLOW,	-15
+	2000
+	0000
+	0000
+	0000
+	0000
+/
+	ORG	10*3+BPDATN
+	FNOP
+	JA	DATNXR
+	0
+DATRTN,	JA	.
+/
+LAMBDA,	0004
+	3057
+	7537
+	4017
+	0276
+	4536
+DATB0,	0005
+	3221
+	3522
+	3121
+	3352
+	5066
+DATA1,	0007
+	5372
+	4104
+	3437
+	1766
+	6167
+DATB1,	0003
+	3135
+	1757
+	0565
+	4141
+	4270
+DATA2,	0001
+	5473
+	7524
+	1112
+	4701
+	2723
+DATB2,	0002
+	2065
+	4070
+	1015
+	2710
+	3176
+DATA3,	7775
+	5374
+	4326
+	3317
+	1675
+	3124
+DATB3,	0001
+	2410
+	5255
+	0370
+	2076
+	6374
+PIS2,	0001
+	3110
+	3755
+	2421
+	0264
+	3013
+ATN1S2,	7777
+	3553
+	0634
+	0530
+	3443
+	6406
+DATP5,	7777
+	3777
+	7777
+	7777
+	7777
+	7776
+X,	F 0.0
+	F 0.0
+C0,	F 0.0
+	F 0.0
+DT1,	F 0.0
+	F 0.0
+DATFP2,	F 2.0
+	F 0.0
+Z,	F 0.0
+	F 0.0
+/
+/PICK UP RETURN AND ARGUMENT
+	BASE	0
+#DATAN,	STARTD
+	FLDA	10*3
+	FSTA	DATRTN
+	FLDA	0
+	SETX	XRDATN
+	SETB	BPDATN
+	BASE	BPDATN
+	LDX	1,1
+	FSTA	BPDATN
+	FLDA%	BPDATN,1
+	FSTA	BPDATN
+	STARTE
+	FLDA%	BPDATN	/GET X
+	LDX	-1,0	/SIGN
+	JGE	.+5
+	LDX	0,0	/SAVE SIGN
+	FNEG
+	FSTA	X	/SAVE ARG
+/
+/CHECK ARGAINST LOWER LIMIT
+	FLDA	X
+	FSUB	DATLOW	/TOO SMALL?
+	JLE	DATGO	/YES ATAN(X)=X
+	LDX	-1,1
+	FCLA
+	FSTA	C0
+/
+/REDUCE X TO RANGE 0<X<.5
+DATA,	FLDA	X
+	FSUB	DATFP1	
+	JLE	DATB	/>1?
+	FLDA	DATFP1	/YES
+	FDIV	X	/X=1/X
+	LDX	0,1	/SET FLAG
+	FSTA	X
+DATB,	FLDA	X
+	FSUB	DATP5	/>= .5
+	JLT	DATC
+	FLDA	X	/X=(2X-1)/(X+2)
+	FADD	DATFP2
+	FSTA	DT1	/TEMP
+	FLDA	X
+	FMUL	DATFP2
+	FSUB	DATFP1
+	FDIV	DT1
+	FSTA	X
+	FLDA	ATN1S2	/C0=ATAN(1/2)
+	FSTA	C0
+/COMPUTE ATAN USING ALGORITHM
+DATC,	FLDA	X
+	FMUL	X
+	FSTA	Z	/Z=X*X
+	FLDA	Z
+	FADD	DATB3	/Z+B3
+	FSTA	DT1
+	FLDA	DATA3
+	FDIV	DT1	/A3/(Z+B3)
+	FADD	DATB2
+	FADD	Z	/ADD Z+B2
+	FSTA	DT1	/TEMP
+	FLDA	DATA2	/A2/TEMP
+	FDIV	DT1
+	FADD	DATB1
+	FADD	Z	/ADD Z +B1
+	FSTA	DT1	/TEMP
+	FLDA	DATA1	/A1/TEMP
+	FDIV	DT1
+	FADD	DATB0	/ADD Z+B0
+	FADD	Z
+	FSTA	DT1
+	FLDA	LAMBDA	/LAMBDA*X
+	FMUL	X
+	FDIV	DT1	/DIV BY THE REST
+	FADD	C0
+	FSTA	X
+	JXN	DATD,1	/WAS X>1 ORIGINALLY?
+	FLDA	PIS2	/Y ATAN(X)=PI/2-ATAN(X)
+	FSUB	X
+DATD,	JXN	DATRTN,0	/WAS X<0?
+	FNEG		/Y
+	JA	DATRTN
+DATGO,	FLDA	X
+	JA	DATD
+