.TITLE	.CSPRT
/
/  23 APR 73 (PDH) CHECK SIGN OF REAL PART
/  28 FEB 73 (MKH) ' JMS .GRAB' TO FETCH ARGUMENT
/
/ SINGLE PRECISION COMPLEX SQUARE ROOT
/
	.GLOBL	CSQRT
	.GLOBL	.SQRT,.SPRDV,.SPADD,.SPRST,.SPRLD
	.GLOBL	.SWPIT,.SWPUS,.SWPBI,.SWPIB,.SPBIA,.MVIMA
	.GLOBL	.CHKMS,.SPCAB,.MODCN,.ADDR1
	.GLOBL	.MODEA,.SIGNA,.EXPA,.MOSTA,.SGNIA,.MSTIA,.EXPB
	.GLOBL	.GRAB
/
CSQRT	XX
	JMS*	.GRAB
	JMS*	.CHKMS	/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*	.SQRT	/AI=0, TAKE REAL SQUARE ROOT
	JMP	CSQEXT
CSQINZ	LAC*	.SIGNA
	DAC	SIGN	/SAVE SIGNA
	DZM*	.SIGNA	/ABS(A)
	LAC	.ADDR1
	JMS*	.SPRST	/SAVE A
	JMS*	.SPCAB	/ABS(A,AI)
	LAC	.ADDR1
	JMS*	.SPRLD	/GET A
	JMS*	.SPADD
	LAW	-2	/-1 IN 2'S COMPLEMENT
	ADD*	.EXPA
	DAC*	.EXPA
	LAC*	.MODEA
	JMS*	.SQRT	/((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*	.SPRDV
	LAC	SIGN
	SZA
	JMP	CXNEG
	JMS*	.SWPUS	/X>0, A TO AI
	JMS*	.SPBIA	/BI TO A
CSQEXT	JMS*	.MODCN	/RESTORE MODE
	JMP*	CSQRT
CXNEG	JMS*	.MVIMA	/X<0, BI TO AI
	LAC*	.SIGNA	/SET UP SIGNS
	DAC*	.SGNIA
	DZM*	.SIGNA
	JMP	CSQEXT
/
SIGN
/
	.END