.TITLE	.CDPRT
/
/  23 APR 73 (PDH) CHANGE '.ADDR1' TO '.ADDR2' TO AVOID
/	CONFLICT WITH DSQRT.  ALSO CHECK SIGN OF REAL PART
/
/ DOUBLE PRECISION COMPLEX SQUARE ROOT
/
	.GLOBL	CDSQRT
	.GLOBL	.DSQRT,.DPRDV,.DPADD,.DPRST,.DPRLD
	.GLOBL	.SWPIT,.SWPUS,.SWPBI,.SWPIB,.SPBIA,.MVIMA
	.GLOBL	.CHKMD,.DPCAB,.MODCN,.ADDR2
	.GLOBL	.MODEA,.SIGNA,.EXPA,.MOSTA,.SGNIA,.MSTIA,.EXPB
	.GLOBL	.GRAB
/
CDSQRT	XX
	JMS*	.GRAB	/ FETCH THE ARGUMENT
	JMS*	.CHKMD	/SET MODE
	LAC*	.SIGNA		/MUST ALWAYS TAKE ROOT IF REAL PART
	SNA			/ IS NEGATIVE
	LAC*	.MSTIA
	SZA
	JMP	CSQINZ	/AI.NE.0, CALCULATE COMPLEX ROOT
	SAD*	.MOSTA
	JMP	CSQEXT	/EXIT IF A=AI=0
	LAC*	.MODEA
	JMS*	.DSQRT	/AI=0, TAKE REAL SQUARE ROOT
	JMP	CSQEXT
CSQINZ	LAC*	.SIGNA
	DAC	SIGN	/SAVE SIGNA
	DZM*	.SIGNA	/ABS(A)
	LAC	.ADDR2
	JMS*	.DPRST	/SAVE A
	JMS*	.DPCAB	/ABS(A,AI)
	LAC	.ADDR2
	JMS*	.DPRLD	/GET A
	JMS*	.DPADD
	LAW	-2	/-1 IN 2'S COMPLEMENT
	ADD*	.EXPA
	DAC*	.EXPA
	LAC*	.MODEA
	JMS*	.DSQRT	/((ABS(X)+ABS(Z))/2)**0.5
	JMS*	.SWPBI	/A TO BI
	JMS*	.SWPIB	/BI TO B
	JMS*	.SWPIT	/AI TO A
	ISZ*	.EXPB
	SKP
	JMP	.-2	/-0 TO +0, TRY AGAIN
	JMS*	.DPRDV
	LAC	SIGN
	SZA
	JMP	CXNEG
	JMS*	.SWPUS	/X>0, A TO AI
	JMS*	.SPBIA	/BI TO A
CSQEXT	JMS*	.MODCN	/RESTORE MODE
	JMP*	CDSQRT
CXNEG	JMS*	.MVIMA	/X<0, BI TO AI
	LAC*	.SIGNA	/SET UP SIGNS
	DAC*	.SGNIA
	DZM*	.SIGNA
	JMP	CSQEXT
/
SIGN
/
	.END