.TITLE	.DPATN
/
/  DOUBLE PRECISION ARCTANGENT ROUTINES
/
	.GLOBL	DATAN,DATAN2,.DATAN
	.GLOBL	.DPRML,.DPRDV,.DPADD,.LODBD,.LDDBL,.DPRST,.DPRLD,.DPSER
	.GLOBL	.CMPLA,.CMPLB,.LOAD1,.FETCH,.PSHBA,.DBLE,.ERROR
	.GLOBL	.MODEA,.SIGNA,.EXPA,.MOSTA,.SIGNB,.EXPB,.MOSTB,.B3,.B4
	.GLOBL	.ADDR1,.ADDR2,.CNTR,.ILMDE,.PICK1,.PICK2,.FLOTB
	.GLOBL	.GRAB
/
DATAN	XX
	JMS*	.GRAB
	JMS	.DATAN
	JMP*	DATAN
/
.DATAN	XX
	JMS*	.DBLE	/CHECK MODE
	LAC*	.SIGNA	/SAVE SIGN
	DAC	SIGN
	DZM*	.SIGNA
	LAC*	.EXPA
	SPA!SNA!CLA
	CMA
	DAC	LARGE	/LARGE=0 IF X.GE.1
	SZA
	JMP	NODIV	/T=X IF X.LT.1.0
	JMS*	.LODBD	/T=1./X IF X.GE.1.0
	JMS*	.LOAD1
	JMS*	.DPRDV
NODIV	LAC	.ADDR1
	JMS*	.DPRST	/STORE T
	LAC	(RT2M1
	JMS*	.DPRLD
	JMS*	.DPRML	/T*(2**0.5-1)
	LAC	(C1
	JMS*	.DPRLD
	JMS*	.DPADD	/ADD 1.0
	LAC	.ADDR1
	JMS*	.DPRLD	/T TO ACC B
	LAC	.ADDR1
	JMS*	.DPRST	/1.0+T*(2.0**0.5-1)=DEN TO ADDR1
	JMS*	.LDDBL	/T TO ACC A
	LAC	(RT2M1
	JMS*	.DPRLD
	JMS*	.CMPLB
	JMS*	.DPADD	/NUM=T-(2**0.5-1)
	LAC	.ADDR1
	JMS*	.DPRLD	/DEN TO ACC B
	JMS*	.DPRDV	/Y=NUM/DEN
	LAC	.ADDR1
	JMS*	.DPRST	/SAVE Y
	JMS*	.LODBD	/ACC A TO ACC B
	JMS*	.DPRML
	LAC	.ADDR2
	JMS*	.DPRST	/SAVE Y**2
	LAW	-20
	DAC*	.CNTR
	LAC	(C33	/SERIES SET UP
	JMS*	.DPSER
	LAC	.ADDR1
	JMS*	.DPRLD
	JMS*	.DPRML	/FINISH SERIES CALCULATION
	LAC	(PI
	JMS*	.DPRLD
	LAW	-2
	DAC*	.EXPB	/ACC B = PI/8
	JMS*	.DPADD
	LAC	LARGE
	SZA
	JMP	SIGNIT
	LAC	(PI
	JMS*	.DPRLD
	LAC	C1
	DAC*	.EXPB	/LOAD PI/2
	JMS*	.CMPLA
	JMS*	.DPADD
SIGNIT	LAC	SIGN	/RESTORE SIGN
	DAC*	.SIGNA
	JMP*	.DATAN
/
DATAN2	XX
	JMS*	.FETCH
	JMS*	.PSHBA	/FIRST ARGUMENT TO ACC A
	LAC*	.MODEA
	JMS*	.DBLE	/CHECK FIRST ARGUMENT MODE
	JMS*	.FETCH	/SECOND ARGUMENT TO ACC B
	TAD	(-2
	SPA
	JMP	BINT	/SECOND ARGUMENT IS AN INTEGER
	SNA
	JMP	BSP	/SECOND ARGUMENT SINGLE PRECISION
	TAD	(-2
	SMA
	JMP*	.ILMDE	/SECOND ARGUMENT COMPLEX,LOGICAL OR CHARACTER
BDP	LAC*	.SIGNA
	DAC	SINA
	LAC*	.SIGNB
	DAC	SINB
	LAC*	.MOSTB
	SZA
	JMP	BNOTZ
	SAD*	.MOSTA
	JMP	ATANER	/ERROR: BOTH ARGUMENTS ZERO
	LAC	(PI	/ONLY SECOND ARGUMENT ZERO
	JMS*	.DPRLD	/EXIT WITH + OR - PI
	JMS*	.LDDBL
	LAC	SINA
	DAC*	.SIGNA
	JMP*	DATAN2
BNOTZ	JMS*	.DPRDV
	LAC*	.MODEA
	JMS	.DATAN	/CALCULATE ARCTAN
	LAC	SINB
	SNA
	JMP*	DATAN2	/EXIT IF QUAD. 1 OR 4
	LAC	(PI
	JMS*	.DPRLD	/LOAD PI
	LAC	SINA
	DAC*	.SIGNB	/SET UP SIGN
	JMS*	.DPADD	/ADD OR SUBTRACT PI
	JMP*	DATAN2
/
BINT	SAD	(-1
	JMP	BDINT	/DOUBLE INTEGER
	JMS*	.PICK1	/PICK UP SINGLE INTEGER
FLTB	JMS*	.FLOTB	/AND FLOAT IT
	SAD	(300000
	JMP	BDP
BSP	DZM*	.B3	/SINGLE PRECISION, ZERO EXTENSION
	DZM*	.B4
	JMP	BDP
BDINT	JMS*	.PICK2	/PICK UP DOUBLE INTEGER
	JMP	FLTB	/AND GO FLOAT IT
/
ATANER	LAW	-31
	JMS*	.ERROR
	JMP*	DATAN2
/
PI	2; 444176; 325042; 055060; 432305
RT2M1	777776; 520236; 146376; 357144; 410546
C33	777771; 014044; 754514; 436750; 212654
	777772; 241235; 211416; 140007; 701447
	777772; 737130; 243533; 565206; 454627
	777773; 114705; 035625; 665743; 566260
	777773; 213746; 611163; 120757; 526535
	777773; 307671; 710460; 471374; 247621
	777773; 414106; 315150; 417706; 314752
	777773; 536237; 600764; 214451; 442170
	777773; 703606; 545107; 110475; 771045
	777774; 042105; 103363; 321371; 011044
	777774; 166116; 304712; 747506; 224233
	777774; 350565; 135056; 157245; 202560
	777774; 616160; 707070; 704272; 007476
	777775; 111111; 444444; 444435; 170223
	777775; 463146; 146314; 631463; 117770
	777776; 252525; 525252; 525252; 525233
C1	1; 0; 0; 0; 0
SINA;SINB;LARGE;SIGN
/
	.END