File: DSQRT.RA of Tape: Sources/Fortran/os8-f4-3
(Source file text) 

/D=DSQRT(D) DOUBLE PREC. SQUARE ROOT
/
/
/ VERSION 40A 27-MAY-80 WVDM
/
/
	SECT	DSQRT
	JA	#DSQRT
	DPCHK
	EXTERN	#ARGER
DSQER,	TRAP4	#ARGER
	TEXT	+DSQRT +
DSQXR,	SETX	XRDSQ
	SETB	BPDSQ
	JA	.+3
BPDSQ,	F 0.0
XRDSQ,	F 0.0
SNGL,	F 0.0			/XR 3 IS EXPONENT
	F 0.0			/ALSO USED IN E MODE
DARSAV,	F 0.0
	F 0.0
DSQ2,	F 2.0
 	F 0.0
	ORG 10*3+BPDSQ
	FNOP
	JA	DSQXR
	0
DSQRTN,	JA	.
/
FSTEM,	F 0.0
FSQ1,	F 1.0
FSQHLF,	F 0.5
/
	BASE	0
#DSQRT,	STARTD			/PICK UP ARGUMENTS
	FLDA	10*3
	FSTA	DSQRTN
	FLDA	0
	SETX	XRDSQ
	SETB	BPDSQ
	BASE	BPDSQ
	LDX	1,1
	FSTA	BPDSQ
	FLDA%	BPDSQ,1		/ADDR OF X
	FSTA	BPDSQ
	STARTE
	FLDA%	BPDSQ		/DO GENERAL TESTS ON THE ARGUMENT
	JEQ	DSQRTN		/RETURN IF 0
	JLT	DSQER		/<0 ERROR
	FSTA	DARSAV		/SAVE DOUBLE
	STARTF			/F MODE + ROUND
	FSTA	SNGL		/SAVE
	XTA	3		/GET EXPONENT  ... ALL THIS FOR M&S
	FDIV	DSQ2		/ /2
	FSTA	FSTEM		/KEEP
	ALN	0
	FNORM			/INTEGER
	FSUB	FSTEM		/INT(EXP/2)-(EXP/2)
	JEQ	SQEVEN		/WAS IT EVEN ?
	FLDA	FSQ1		/NO, MAKE EXP = 1
SQEVEN,	ATX	3		/YES, MAKE EXP = 0
	FLDA	FSTEM
	JGT	.+3		/WAS HALF EXP NEG ?
	FSUB	FSQHLF		/YES, -.5
	ALN	0
	FNORM			/INTEGER
	FSTA	FSTEM		/FINAL EXPONENT DIDDLE ....
	EXTERN	SQRT		/GET INITIAL APPROXIMATION BY CALLING
	JSR	SQRT		/SINGLE PRECISION ROUTINE
	JA	.+4
	JA	SNGL
	FSTA	SNGL		/FIRST APPROX
	XTA	3		/GET EXP AGAIN  M&S ...
	FADD	FSTEM		/DIDDLE IT
	ATX	3		/STORE BACK ...
	STARTE			/BACK TO E
	LDX	-3,0		/TAKE 3 ITERATIONS OF
DSIT,	FLDA	DARSAV		/X(K+1)=1/2(X(K)+X/X(K))
	FDIV	SNGL		/X/X(K)
	FADD	SNGL		/X(K)+X/X(K)
	FDIV	DSQ2		/DIVIDE BY 2
	FSTA	SNGL		/X(K+1)
	JXN	DSIT,0+		/ITERATE
	FLDA	SNGL		/GET ANSWER
	JA	DSQRTN		/RETURN