File: POWERS.SB of Tape: OS8/OS8-V3D/al-4693d-sa-os8-v3d-3

(Source file text) 

---

/POWERS SUBROUTINE                     OS8 FORTRAN II LIBRARY
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/
/	VERSION 5A
/	VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
	ENTRY	IFPOW	/     INTEGER TO FLOATING POWER
	ENTRY	FFPOW	/     FLOATING TO FLOATING POWER
	ENTRY	EXP	/     E TO A POWER
	ENTRY	ALOG	/     NATURAL LOGARITHM
/
/
	DUMMY	LXP
	OPDEF	JMSKP	4000
/
/	INTERNAL SUBROUTINE POL
/
/	COMPUTES N TERMS OF POLYNOMIAL (NO CONSTANT TERM)
/	N IN AC ... X IN FLOATING AC
/	COEFFICIENTS START IN LOCATION WHOSE ADDRESS FOLLOWS JMS TO POL
/
POL2,	BLOCK	1
POL,	BLOCK	1
	CIA
	DCA	POL2
	CALL	1,STO
	ARG	X
	TAD I	POL
	INC	POL
/	DCA	ARG1#	/THIS CODE PROBABLY EXTRANEOUS
/	SKP
ARG2,	DCA	ARG1#
	CALL	1,FAD
ARG1,	ARG	EXS	/     ADDRESS STORED HERE
	CALL	1,FMP
	ARG	X
	ISZ	POL2
	JMP	POL1
	JMP I	POL
POL1,	TAD	ARG1#
	TAD	(3
	JMP	ARG2

	CPAGE	17	/     CANT BREAK UP THIS TABLE
EXS,	1464		/7.9608942E-9	CONSTANTS FOR EXP
	2142
	1421
	1545		/6.3578287E-7
	2525
	2525
	1625		/4.0690103E-5
	2525
	2525
	1704		/1.9531250E-3
	0000
	0000
	1754		/6.25E-2
	0000
	0000
	CPAGE	3
ONE,	2014
	0000
	0000
	CPAGE	30
COF,	5716		/-6.4535442E-3	CONSTANTS FOR LOGS
	4674
	1006
	1744		/3.6088494E-2
	4750
	6073
	5756		/-9.5329390E-2
	0636
	0162
	1765		/1.6765407E-1
	2726
	6023
	5767		/-2.4073380E-1
	5501
	3543
	1775		/3.3179902E-1
	2360
	6176
	5777		/-4.9987412E-1
	7767
	6001
	2007		/9.9999643E-1
	7777
	7041
	CPAGE	3
ER16,	2014		/1.0644944
	2040
	5326
	CPAGE	3
LN2,	1755		/8.6643397E-2
	4271
	0300

X,	BLOCK	3
Y,	BLOCK	3

/
/	ALOG - NATURAL LOGARITHM
/
/	ALOG(X)=N*ALOG(2)+ALOG(M) WHERE 1/2 OR EQUAL TO M
/	ALOG(M)=ALTERNATING SERIES (K**I)/I WHERE K=2M-1 AND M AS ABOVE
/
	CPAGE	4
LGER,	0114		/     "ALOG" ERROR AT LOC XXXXX
	1707
ALOG,	BLOCK	1
	5		/     ENTRY POINT
	TAD	ALOG
	DCA	TEM
	TAD	ALOG#
	DCA	TEM#
	CALL	1,IFAD
TEM,	ARG	0
	INC	ALOG#
	INC	ALOG#
	TAD	ACH	/     GET EXPONENT
	SPA SNA
	JMP	LGERR	/LOG OF X<=0 - ERROR
	AND	(3770
	TAD	(5770	/     -2000
	DCA	TEM	/     N INTO TEM
	TAD	ACH	/	GET M WITHOUT SIGN
	AND	(7
	TAD	(2010	/     2M
	DCA	ACH
	CALL	1,FSB	/     2M-1
	ARG	ONE
	TAD	(D8	/     8 TERMS OF SERIES
	JMS	POL
	COF
	CALL	1,STO	/     ALOG(M) INTO Y
	ARG	Y
	TAD	TEM	/     GET N
	CALL	0,FLOT	/     FLOAT IT
	CALL	1,FMP	/     N *ALOG(2)
	ARG	LN2
	CALL	1,FAD	/     N *ALOG(2) ALOG(M)(ALOG(X)
	ARG	Y
	RETRN	ALOG	/     EXIT
LGERR,	CALL	1,ERROR
	ARG	LGER

/
/	EXP - E TO A POWER
/
/	E**X=SERIES (X**I)/(I!)
/	IF B=E**(1/16) AND X IS BETWEEN -1 AND 1 THEN
/	B**X=1 SUMA(I)*(X**I) FOR I FROM I=1 TO I=5
/	WHERE A(I)(1/((I!)*16**2))
/
	CPAGE	4
EXPER,	4530
	2040
EXP,	BLOCK	1
	5		/     ENTRY POINT
	TAD	EXP
	DCA	XT
	TAD	EXP#
	DCA	XT#
	INC	EXP#
	INC	EXP#
	CALL	1,IFAD
XT,	ARG	0
	CLA CLL CMA RAR
	AND	ACH
	TAD	(-2075
	SMA CLA
	TAD	ACM
	CLL
	TAD	(-4271		/TEST FOR FLTG. AC <88.2
	SZL CLA
	JMP	EXPERR
	TAD	ACH
	SZA
	TAD	(40	/     X*16
	DCA	ACH
	CALL	1,STO	/     Y=16X
	ARG	Y
	CALL	1,FAD	/     EXPRESS Y AS INTEGER N AND FRACTION F
	ARG	Y
	CALL	0,FIX	/     GET N
	SMA
	IAC
	DCA	ALOG	/     ALOG=N
	TAD	ALOG	/     GET F
	CIA
	CALL	0,FLOT
	CALL	1,FAD
	ARG	Y
	TAD	(5	/     5 TERMS OF SERIES
	JMS	POL
	EXS
	CALL	1,FAD	/     PLUS 1
	ARG	ONE
	CALL	1,STO	/     GIVES B**F
	ARG	Y
	CALL	1,FAD	/     GET B
	ARG	ER16
	CALL	1,FIPOW
	ARG	ALOG
	CALL	1,FMP	/     B**(N+F)=(B**16X)(E**X)
	ARG	Y
	RETRN	EXP	/     EXIT
EXPERR,	CALL	1,ERROR
	ARG	EXPER
	TAD	ACH
	SMA CLA
	CLL CMA RAR
	DCA	ACH
	DCA	ACM
	DCA	ACL
	RETRN	EXP

/
/	IFPOW - INTEGER TO FLOATING POWER
/
/	JUST FLOAT BASE AND GO TO FFPOW
/
IFPOW,	BLOCK	1
	5		/     ENTRY POINT
	CALL	0,FLOT
	TAD	IFPOW	/     FROM BANK
	DCA	FFPOW	/     TO PROPER LOCATION
	TAD	IFPOW#	//     FROM ADDRESS
	DCA	FFPOW#	     /TO PROPER LOC
	JMP	ML	/     SNEAK INTO ROUTINE

/
/	FFPOW- FLOATING TO FLOATING POWER
/
/	IDENTITY USED ... X**Y=EXP(Y*ALOG(X))
/
	CPAGE	4
FFPER,	4614
	2027
FFPOW,	BLOCK	1
	5		/     ENTRY POINT
ML,	TAD I	FFPOW	/     GET CDF TO EXPONENT
	DCA	LXP
	INC	FFPOW#	/     INCREMENT TO EXPONENT ADDRESS
	TAD I	FFPOW	/     GET EXPONENT ADDRESS
	DCA	LXP#
	INC	FFPOW#	/     INCREMENT FOR EXIT
	TAD I	LXP	/     HIGH ORDER WORD OF EXPONENT
	SNA CLA 	/     IS IT ZERO
	JMP	FFP5	/     YES ... RESULT=1
	TAD	ACH	/     BASE IS IN FLOATING POINT AC
	SPA
	JMP	FFPERR
	SZA CLA 	/     IF BASE EQUALS ZERO ... RESULT EQUALS ZERO
	JMP	FFP1
	RETRN	FFPOW	/     ZERO RESULT EXIT
FFP1,	CALL	1,STO	/     SAVE BASE
FFP2,	ARG	X
	CALL	1,ALOG
	ARG	X
	CALL	1,FMP	/     Y*LOG(X)
LXP,	ARG	0	/     ADDRESS STORED HERE
	CALL	1,STO
	ARG	X
	CALL	1,EXP
	ARG	X
FFP6,	RETRN	FFPOW
FFP5,	CALL	0,CLEAR	/     ANYTHING TO ZERO POWER IS 1
	TAD	(2014
	DCA	ACH
	JMP	FFP6
FFPERR,	TAD	(4000
	DCA	ACH
	CALL	1,ERROR
	ARG	FFPER
	JMP	FFP1
	END

---