Google
 

Trailing-Edge - PDP-10 Archives - BB-4157E-BM - fortran-ots-debugger/forsng.mac
There is 1 other file named forsng.mac in the archive. Click here to see a list.
	SEARCH	FORPRM
	TV	FORSNG	SINGLE PRECISION ROUTINES,6(2031)

;COPYRIGHT (C) 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

	SUBTTL	REVISION HISTORY

COMMENT \

***** Begin Revision History *****

1345	EDS	16-Mar-1981	Q10-04806
	Fix ASIN and ACOS library error message.

1350	EDS	16-Mar-81	Q10-04761
	Fix TWOSEG and RELOC problems.

1405	DAW	6-Apr-81
	Support extended addressing.

1464	DAW	12-May-81
	Error messages.

1524	DAW	6-Jul-81
	Shorten error message in EXP3. so it doesn't get truncated.

1673	CDM	9-Sept-81
	Add single precision routines.
	(ANINT, NINT)

1677	JLC	10-Sep-81	Q10-6510
	Use seed and multiplier from version 5A for RAN.

1724	BL	17-Sep-81
	Clean up error messages.

***** End Revision History *****

\
	PRGEND
TITLE	ALOG10	LOG BASE 10 FUNCTION  
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.      JUNE 1, 1979

;COPYRIGHT (C) 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

SEARCH	FORPRM
NOSYM
ENTRY	ALOG10
EXTERN	ALG10.
ALOG10=ALG10.
PRGEND
TITLE	ALOG	NATURAL LOG FUNCTION
;		(SINGLE PRECISION FLOATING PRECISION)
SUBTTL	IMSL, INC.	JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

SEARCH	FORPRM
NOSYM
ENTRY	ALOG
EXTERN	ALOG.
ALOG=ALOG.
PRGEND
TITLE	ALOG.	NATURAL LOG FUNCTION
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.	JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.


;ALOG10(X) AND ALOG(X) ARE CALCULATED AS FOLLOWS

;       FOR REFERENCE SEE 'COMPUTER APPROXIMATIONS', BY HART ET. AL.
;       WILEY, 1968;  ALGORITHM # 2662.
;       SEE PAGE 227 FOR THE COEFFICIENTS AND PAGE 111 FOR THE 
;       RANGE OF VALIDITY.
;
;       FOR X CLOSE TO ONE -
;       ALOG(X) = L3*Z**7+L4*Z**5+L5*Z**3+L6*Z
;       WHERE Z = (X-1)/(X+1)
;       ALOG10(X) = ALOG(X)*ALOG10(E)

;       FOR X NOT NEAR ONE - 
;       ALOG(X) = (K-1/2)*ALOG(2)+ALOG(F*SQRT(2)) WHERE X = 2**K*F
;       ALOG(F*SQRT(2)) = L3*Z**7+L4*Z**5+L5*Z**3+L6*Z
;       WHERE L3, L4, L5, AND L6 ARE CONSTANTS AND
;       Z = (F-(SQRT(2)/2))/(F+(SQRT(2)/2))

;THE RANGE OF DEFINITION FOR ALOG/ALOG10 IS GIVEN ABOVE, AND ERROR MESSAGES
;  WILL RESULT FOR ARGUMENTS OUT OF THAT RANGE

;REQUIRED (CALLED) ROUTINES:  NONE

;REGISTERS T2, T3, AND T4 WERE SAVED, USED, AND RESTORED

;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:

;  XMOVEI	L,ARG
;  PUSHJ	P,ALOG  
;	OR
;  PUSHJ	P,ALOG10

;THE ANSWER IS RETURNED IN ACCUMULATOR T0

	SEARCH	FORPRM
	TWOSEG	400000
	SALL

	HELLO	(ALG10.,ALOG10)	;ENTRY TO LOG TO THE BASE 10 ROUTINE.
	MOVE	T0,@(L)		;GET X IN T0.
	JUMPE	T0,LZERO	;CHECK FOR ZERO ARG.
	MOVEM	T0,TEMP		;SAVE ARGUMENT.
	FUNCT	ALOG.,<TEMP>	;CALC THE BASE E LOG TO THE
	FMPR	T0,LOG10A	;MULTIPLY IT BY LOG10(E).
	GOODBY	(1)		;RETURN

	HELLO	(ALOG,.)	;ENTRY TO LOG TO THE BASE E ROUTINE.
	MOVE	T0,@(L)		;GET X
	JUMPG	T0,ALOGOK	;ARG IS GREATER THAN 0
	JUMPE	T0,LZERO	;CHECK FOR ZERO ARGUMENT
	LERR	(LIB,%,<ALOG or ALOG10: negative arg; result=log(ABS(arg))>)
	MOVN	T0,T0		;GET |X|
ALOGOK:	CAMN	T0,ONE		;CHECK FOR 1.0 ARGUMENT
	  JRST	ZERANS		;IT IS 1.0 RETURN ZERO ANS.
	CAML	T0,HI		;IS ARG >/= SQRT(2)?
	  JRST	GEN		;YES GO TO GENERAL CASE
	CAMG	T0,LO		;IS ARG </= 1/SQRT(2)?
	  JRST	GEN		;YES GO TO GENERAL CASE
	SETZM	LS		;IGNORE EXP FOR ARG NEAR 1
	MOVE	T1,T0		;SERIES VARIABLE IS
	FADR	T0,ONE		;(ARG-1)/(ARG+1) IF ARG NEAR 1
	FSBR	T1,ONE		
	JRST	MERGE		;SKIP HANDLING OF EXP IN GENL CASE
GEN:	ASHC	T0,-33		;SEPARATE FRACTION FROM EXPONENT
	ADDI	T0,211000	;FLOAT THE EXPONENT 
	MOVS	T0,T0		;NUMBER NOW IN CORRECT FL. FORMAT
	FADR	T0,BIAS		;REMOVE BIAS + COMPENSATE FOR
				;SQRT(2) FACTOR; T0 HAS EXP - 1/2
	FMPR	T0,LN2		;MULT BY LN2
	MOVEM	T0,LS		;STORE FOR FUTURE - LS=(K-1/2)*LN2
	ASH	T1,-10		;SHIFT FRACTION FOR FLOATING
	TLC	T1,200000	;FLOAT THE FRACTION PART
	MOVE	T0,T1		;COPY FRACTION
	FADR	T1,L1		;SUBTRACT (SQRT(2))/2 FROM T1
	FSBR	T0,L1		; AND ADD IT TO T0
MERGE:	FDVR	T1,T0		;T1 = T1/T0
	MOVEM	T1,LZ		;STORE NEW VARIABLE IN LZ
	FMPR	T1,T1		;CALCULATE Z**2
	MOVE	T0,L3		;PICK UP FIRST CONSTANT
	FMPR	T0,T1		;MULTIPLY BY Z**2
	FADR	T0,L4		;ADD IN NEXT CONSTANT
	FMPR	T0,T1		;MULTIPLY BY Z**2
	FADR	T0,L5		;ADD IN NEXT CONSTANT
	FMPR	T0,T1		;MULTIPLY BY Z**2
	MOVE	T1,LZ		;GET Z INTO T1
	FMPR	T0,T1		;T0 NOW HAS ALL BUT FIRST
				; TERM OF SERIES APPROX.
	FSC	T1,1		;MUL Z BY 2
	FADR	T0,T1		;DO LAST ADD FOR SERIES WITH
				; ROUNDING AND OVERHANG OF
				; AT LEAST 2 BITS
	FADR	T0,LS		;ADD IN EXPONENT PART
	GOODBY	(1)
LZERO:	LERR	(LIB,%,ALOG or ALOG10: zero arg; result overflow)
	MOVE	T0,MIFI		;PICK UP MINUS INFINITY
	GOODBY	(1)		;RETURN
ZERANS:	MOVEI	T0,0		;MAKE ANSWER ZERO
	GOODBY	(1)		;RETURN

LOG10A:	177674557305
ONE:	201400000000
L1:	577225754146		;-0.707106781187 = -(SQRT(2)/2)
L3:	177464164321		;.301003281
L4:	177631177674		;.39965794919
L5:	200525253320		;.666669484507
LN2:	200542710300		;0.69314718056
MIFI:	400000000001		;LARGEST NEGATIVE FLOATING NUMBER
HI:	201552023632		;IF ARG IS BETWEEN HI AND LO
LO:	200552023632		;NO SCALING BY SQRT(2) NEEDED.
BIAS:	567377000000		;-(401)/2

	RELOC			;DATA
TEMP:	0
LS:	0
LZ:	0
	RELOC
	PRGEND
TITLE	AMOD	SINGLE PRECISION REMAINDER FUNCTION
SUBTTL	MARY PAYNE /MHP/CKS	25-Jan-80

;COPYRIGHT (C) 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

SEARCH	FORPRM
NOSYM
ENTRY	AMOD
AMOD=AMOD.##
PRGEND
TITLE	AMOD.	SINGLE PRECISION REMAINDER FUNCTION
SUBTTL	MARY PAYNE /MHP/CKS	25-Jan-80

;COPYRIGHT (C) 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


	SEARCH	FORPRM
	TWOSEG	400000
	SALL

	HELLO	(AMOD,.)
	DMOVEM	T2,SAVE2	;SAVE TEMP REGISTERS

	MOVM	T0,@0(L)	;GET DABS(A) IN T0-T1
	MOVM	T2,@1(L)	;AND DABS(B) IN T2-T3
	CAMG	T0,T2		;CHECK IF A .LE. B
	  JRST	FAST		;YES, GO BE FAST
	SETZB	T1,T3		;CLEAR LOW WORDS
	MOVEM	T2,B		;SAVE ABS(B) FOR LATER

REPEAT:	FDVM	T0,T2		;GET A/B
	  JFCL	OVFL		;CATCH OVERFLOW
	CAML	T2,[233400000000] ;IF QUOTIENT IS ALL INTEGER PART,
	  JRST	BIG		  ; SKIP UNNECESSARY TRUNC
	FAD	T2,[233400000000] ;ELSE TRUNCATE QUOTIENT TO INTEGER
	FSB	T2,[233400000000]

BIG:	DFMP	T2,B		;GET A-B*[A/B] IN T0-T1
	DFSB	T0,T2

OVCONT:	CAML	T0,B		;IF RESULT .LT. B, OK
	  JRST	[DMOVE T2,B	;ELSE [A/B] HAD LOW-ORDER BITS TRUNCATED
		 JRST REPEAT]	; AND MUST SUBTRACT SOME MORE MULTIPLES OF B

MRET:	SKIPGE	@0(L)		;GIVE RESULT SIGN OF A
	  MOVN	T0,T0

MRET1:	DMOVE	T2,SAVE2	;RESTORE REGISTERS
	POPJ	P,		;DONE
FAST:	CAME	T0,T2		;IF A .LT. B, GO RETURN AMOD = A
	  JRST	MRET
RTZ:	SETZ	T0,		;ELSE A .EQ. B, GO RETURN AMOD = 0
	JRST	MRET1

OVFL:	SKIPN	T2,B		;RESTORE B
	  JRST	RTZ		;IF B IS ZERO, AMOD IS ZERO
	FSC	T0,-177		;SCALE A TO AVOID OVERFLOW IN DIVIDE
	FDVM	T0,T2		;GET A/B
	DFMP	T2,B		;GET A-B*[A/B]
	DFSB	T0,T2
	FSC	T0,177		;UNDO SCALING
	JRST	OVCONT		;CONTINUE NORMALLY

	RELOC			;DATA
B:	BLOCK	1		;DABS(B)
	EXP	0
SAVE2:	BLOCK	2		;TEMP REGISTERS
	RELOC

	PRGEND
TITLE	ACOS	ARC SINE AND ARC COSINE FUNCTIONS  
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.      JANUARY 18, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

SEARCH	FORPRM
NOSYM
ENTRY	ACOS
EXTERN	ACOS.
ACOS=ACOS.
PRGEND
TITLE	ASIN	ARC SINE AND ARC COSINE FUNCTIONS  
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.      JANUARY 18, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

SEARCH	FORPRM
NOSYM
ENTRY	ASIN
EXTERN	ASIN.
ASIN=ASIN.
PRGEND
TITLE	ASIN.	ARC SINE AND ARC COSINE FUNCTIONS
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.    	JANUARY 18, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;ASIN(X) AND ACOS(X) ARE CALCULATED AS FOLLOWS

;  LET R(Z) = Z*(P0 + Z*(P1 + Z*P2))/(Q0 + Z*(Q1 + Z))
;	(P(I) AND Q(I) ARE GIVEN BELOW)

;  LET S = Y + Y*R(Z)

;  FOR SITUATIONS 1. AND 3. BELOW,
;	Z = Y**2, WHERE Y = ABS(X)

;  FOR SITUATIONS 2. AND 4., Z = (1.0 - ABS(X))/2.0
;	AND Y = -2.0*SQRT(Z)

;  LET W = ABS(X) AND TERM THE RESULT T.
;  THEN, CONSIDER THE FOUR SITUATIONS:

;	1.  ASIN, FOR W <= 0.5.  T = S, AND T IS NEGATED 
;		FOR NEGATIVE X
;	2.  ASIN, FOR W > 0.5.  T = PI/2 + S, AND T IS NEGATED
;		FOR NEGATIVE X
;	3.  ACOS, FOR W <= 0.5.  T = PI/2 - S IF X < 0
;				   = PI + S IF X > 0
;	4.  ACOS FOR W > 0.5.  T = -S IF X < 0
;				 = PI + S IF X > 0.

;THE RANGE OF DEFINITION FOR ASIN/ACOS IS ABS(X) <= 1.0. AND ERROR MESSAGES
;  WILL RESULT FOR ARGUMENTS OUT OF THAT RANGE.  ASIN/ACOS WILL BE SET
;  TO + MACHINE INFINITY.

;REQUIRED (CALLED) ROUTINES:  SQRT

;REGISTERS T2, T3, T4, AND T5 WERE SAVED, USED, AND RESTORED

;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:

;  XMOVEI	L,ARG
;  PUSHJ	P,ASIN
;	OR
;  PUSHJ	P,ACOS

;THE ANSWER IS RETURNED IN ACCUMULATOR T0

	SEARCH	FORPRM
	TWOSEG	400000
	SALL

	HELLO	(ACOS,.)	;ENTRY TO ACOS ROUTINE
	PUSH	P,T5		;SAVE REGISTER T5
	MOVEI	T5,1		;SET ACOS FLAG
	JRST	ALG		;GO TO MAIN CODE
	
	HELLO	(ASIN,.)	;ENTRY TO ASIN ROUTINE
	PUSH	P,T5		;SAVE REGISTER T5
	MOVEI	T5,0		;SET ASIN FLAG

ALG:	MOVE 	T1,@(L)		;OBTAIN X
	MOVM	T0,T1		;OBTAIN ABS(X) = Y
	CAMG	T0,CHALF	;IF Y < .5
	  JRST	LEHF		;JUMP TO LABEL LEHF
	CAMLE	T0,CONE		;OTHERWISE, IF Y > 1,
	  JRST 	ERR0		;GO TO WRITE ERROR MESSAGE

	PUSH	P,T2		;SAVE REGISTER T2
	MOVN	T0,T0		;OBTAIN NEW Y AND Z; (-Y
	FADRI	T0,201400	;+1)
	FSC	T0,-1		;/2 = Z
	MOVE 	T2,T0		;T2 CONTAINS Z
	PUSH	P,T1		;SAVE REGISTER T1 BEFORE CALL
	MOVEM	T0,TEMP
	FUNCT	SQRT.,<TEMP>	;OBTAIN SQUARE ROOT OF Z
	POP	P,T1		;RESTORE REGISTER T1
	MOVN	T0,T0		;SQRT(Z)=-SQRT(Z)
	FSC	T0,1		;-2*SQRT(Z)=Y
	JRST	SRES		;GO TO OBTAIN RESULT

LEHF:	PUSH	P,T2		;SAVE REGISTER T2
	CAMGE	T0,CEPS		;IF Y < EPS,
	  JRST	MSIGN		;JUMP TO LABEL MSIGN
	MOVE	T2,T0		;MOVE Y TO T2
	FMPR	T2,T0		;Y*Y=Z

SRES:	PUSH	P,T3		;SAVE REGISTER T3
	PUSH	P,T4		;SAVE REGISTER T4
	MOVE	T3,T0		;MOVE Y
	MOVE 	T4,T2		;MOVE Z
	FMPR	T2,PP2		;((P2*Z
	FADR	T2,PP1		;+P1)
	FMPR	T2,T4		;*Z
	FADR	T2,PP0		;+P0)
	FMPR	T2,T4		;*Z = R(Z) NUMERATOR
	FMPR	T0,T2		;*Y
	MOVE 	T2,T4		;(Z
	FADR	T2,Q1		;+Q1)
	FMPR	T2,T4		;*Z
	FADR	T2,Q0		;+Q0 = R(Z) DENOMINATOR
	FDVR	T0,T2		;R(Z)
	FADR	T0,T3		;+Y = RESULT
	POP	P,T4		;RESTORE REGISTER T4
        POP     P,T3		;RESTORE REGISTER T3

MSIGN:  MOVM	T2,T1		;T2 CONTAINS ABS(X)
	JUMPG	T5,COS		;IF FLAG NOT ZERO, GO TO ACOS
	CAMLE	T2,CHALF	;IF ABS(X) GREATER THAN .5
	  FADR	T0,CPI2		;ADD PI/2 TO RESULT
	JUMPGE	T1,RET		;IF X IS POSITIVE, RETURN
	MOVN	T0,T0		;OTHERWISE, RESULT=-RESULT
	JRST	RET		;RETURN

COS:	JUMPL	T1,BCOEF	;IF X IS NEGATIVE, JUMP TO BCOEF
	MOVN	T0,T0		;RESULT=-RESULT
	CAMG	T2,CHALF	;IF ABS(X) <= .5
	  FADR	T0,CPI2		;ADD PI/2 TO RESULT
	JRST	RET		;RETURN

BCOEF:  MOVE	T1,CPI2		;T1 CONTAINS PI/2
	CAMLE	T2,CHALF	;IF ABS(X) > .5
	  FSC	T1,1		;CONSTANT BECOMES PI
	FADR	T0,T1		;ADD CONSTANT TO RESULT

RET:	POP	P,T2		;RESTORE REGISTER T2
	POP	P,T5		;RESTORE REGISTER T5
	GOODBY	(1)		;RETURN TO CALLING PROGRAM

ERR0:	LERR	(LIB,%,ASIN or ACOS: ABS(arg) > 1.0; result = +infinity)
	HRLOI	T0,377777	;RESULT=POSITIVE MACHINE INFINITY
	POP	P,T5		;RESTORE REGISTER T5
	GOODBY	(1)		;RETURN TO CALLING PROGRAM

CONE:	201400000000		;1.0
CHALF:	200400000000		;.5
CEPS:	1.0E-8
PP0:	200441171213		;0.564915737
PP1:    600134535161		;-0.409490163
PP2:	173475014642		;1.93496723E-2
CPI:	202622077325		;3.14159265
CPI2:	201622077325		;1.57079633
Q0:	202661665706		;3.38949412
Q1:	575002216372		;-3.98220081

	RELOC			;DATA
TEMP:	0			;TEMPORARY STORAGE USED FOR SQRT ARG
	RELOC
	PRGEND
TITLE	ATAN2	TWO ARGUMENT ARC TAN FUNCTION  
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.      JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

SEARCH	FORPRM
NOSYM
ENTRY	ATAN2
EXTERN	ATAN2.
ATAN2=ATAN2.
PRGEND
TITLE	ATAN	ARC TAN FUNCTION  
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL  IMSL, INC.	JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

SEARCH	FORPRM
NOSYM
ENTRY	ATAN
EXTERN	ATAN.
ATAN=ATAN.
PRGEND
TITLE	ATAN.	ARC TAN FUNCTION  
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL  IMSL, INC.	JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


;ATAN(X) is computed as follows:
;
;If X < 0, compute ATAN(|X|) below, then ATAN(X) = -ATAN(-X).
;
;If X > 0, use the identity
;
;	ATAN(X) = ATAN(XHI) + ATAN(Z)
;	Z = (X - XHI) / (1 + X*XHI)
;
;where XHI is chosen so that  |Z| <= tan(pi/32).
;
;XHI is chosen to be exactly representable as a single precision number,
;and so Z can be calculated without loss of significance.
;
;ATAN(XHI) is found by table lookup.  It is stored as ATANHI + ATANLO to
;provide guard bits for the final addition to ATAN(Z).
;
;ATAN(Z) is evaluated by means of a polynomial approximation from Hart et al.
;(formula 4901).
;
;If X < tan(pi/32), ATAN(X) = ATAN(Z).
;If X > 1/tan(pi/32), ATAN(X) = pi/2 - ATAN(1/X).
;
;If tan(pi/32) < X < 1/tan(pi/32), an appropriate XHI is obtained by indexing
;into a table.  The table tells which XHI to use for various ranges of X.
;The index into the table is formed from the low 3 exponent bits and the high
;3 fraction bits of X.

	SEARCH	FORPRM
	TWOSEG	400000
	SALL


	HELLO (ATAN,.)		;ATAN ENTRY

	PUSH	P,T2		;SAVE REGISTERS
	PUSH	P,T3

	MOVE	T0,@(L)		;GET ARGUMENT X
	MOVEM	T0,SGNFLG	;SAVE ARGUMENT SIGN FOR RESULT
	MOVM	T0,T0		;GET |X| 

	CAML	T0,MAXX		;IS X LARGE?
	  JRST	LARGEX		;YES, GO USE ATAN(X) = PI/2 - ATAN(1/X)
	SETZ	T2,		;T2 WILL GET OFFSET INTO XHI TABLES
	CAMG	T0,MINX		;IS X SMALL ENOUGH THAT NO ARG REDUCTION IS REQUIRED?
	  JRST	CALC		;YES, JOIN CALCULATION BELOW

	MOVE	T3,T0		;GET A COPY OF X
	LSHC	T2,9		;GET EXPONENT, SHIFT HIGH FRACTION BIT
				;(ALWAYS 1) INTO SIGN BIT OF T3
	ASHC	T2,3		;GET THREE FRACTION BITS, LEAVING
				;THE 1 BEHIND
	HRRZ	T2,OFFSET-2000+24(T2) ;GET OFFSET INTO XHI TABLES

	MOVE	T1,T0		;GET A COPY OF X
	FSBR	T0,XHI(T2)	;GET X-XHI
	FMPR	T1,XHI(T2)	;    X*XHI
	FADRI	T1,(1.0)	;    1 + X*XHI
	FDVR	T0,T1		;    (X-XHI) / (1 + X*XHI)

;Here T0 has the reduced argument Z with |Z| <= tan(pi/32).  T2 has the
;index into the ATAN(XHI) tables ATANHI and ATANLO.  SGNFLG is set negative
;if the result should be negated.

CALC:	MOVM	T1,T0		;GET |Z|
	CAMG	T1,EPS		;IS IT SMALL ENOUGH THAT ATAN(Z) = Z?
	  JRST	SMALLX		;YES, BE FAST, AVOID UNDERFLOW
	FMPR	T1,T1		;GET Z**2
	MOVE	T3,P03		;GET P(Z**2)
	FMPR	T3,T1
	FADR	T3,P02
	FMPR	T3,T1
	FADR	T3,P01
	FMPR	T1,T3
	FMPR	T1,T0		; * Z
	FADR	T0,T1		; + Z = ATAN(Z)

SMALLX:	FAD	T0,ATANLO(T2)	;  + ATAN(XHI) LOW
	FADR	T0,ATANHI(T2)	;  + ATAN(XHI) HI   = ATAN(X)
	SKIPG	SGNFLG		;ATTACH SIGN TO RESULT
	  MOVN	T0,T0
RET:	POP	P,T3		;RETURN
	POP	P,T2
	POPJ	P,

LARGEX:	MOVSI	T1,(-1.0)	;GET -1/X
	FDVRM	T1,T0
	MOVEI	T2,PI2OFFS	;GET OFFSET OF PI/2
	JRST	CALC		;GO COMPUTE PI/2 + ATAN(-1/X)
SUBTTL ATAN2 (Y,X)


;To compute ATAN2(Y,X), let U = |Y| and V = |X|, and compute ATAN(U/V).
;Then find ATAN2(Y,X) based on the signs of Y and X as follows:
;
;	 X	 Y	 ATAN2(Y/X)
;	
;	pos	pos	  ATAN(U/V)
;	pos	neg	 -ATAN(U/V)
;	neg	pos	-(ATAN(U/V) - pi)
;	neg	neg	  ATAN(U/V) - pi
;
;The add of -pi is combined with the add of ATAN(XHI) which is the last step
;of the ATAN algorithm.
;
;The reduced argument for ATAN is Z = (U/V - XHI) / (1 + U/V * XHI).
;This is rewritten as (U - V*XHI) / (V + U*XHI).  To accurately calculate the
;numerator, find VHI and VLO with 
;
;	V = VHI + VLO 
;	VHI has at most 14 significant bits
;	VLO has at most 13 significant bits
;
;and choose XHI with at most 13 significant bits.  Then VHI*XHI and VLO*XHI can
;be exactly represented as single precision numbers, and the numerator is
;
;	U - V*XHI = (U - VHI*XHI) - VLO*XHI



HELLO (ATAN2,.)			;ATAN2 ENTRY

	PUSH	P,T2		;SAVE REGISTERS
	PUSH	P,T3

	MOVE	T0,@0(L)	;GET Y
	FDVR	T0,@1(L)	;GET Y/X
	  JFCL	EXCEP		;OVERFLOW AND UNDERFLOW CAN OCCUR
	MOVEM	T0,SGNFLG	;RESULT SHOULD BE MULTIPLIED BY SGN(Y/X)

	MOVM	T3,T0		;GET |Y/X|, ATAN ARG
	CAML	T3,MAXX		;IS |Y/X| LARGE?
	  JRST	LARGE2		;YES, GO USE ATAN(Y/X) = PI/2 - ATAN(X/Y)
	SETZ	T2,		;GET OFFSET INTO ATAN TABLES
	CAMG	T3,MINX		;IS |Y/X| SMALL ENOUGH TO USE POLYNOMIAL DIRECTLY?
	  JRST	[MOVE T0,T3	;YES, DO SO
		 JRST SMALL2]
	LSHC	T2,9		;GET INDEX INTO OFFSET TABLES
	ASHC	T2,3
	HRRZ	T2,OFFSET-2000+24(T2) ;GET INDEX INTO XHI TABLES

	PUSH	P,T4		;SAVE ANOTHER REGISTER

	MOVM	T0,@0(L)	;GET |Y| = U
	MOVM	T1,@1(L)	;GET |X| = V
	MOVE	T3,T1		;GET A COPY OF V
	MOVE	T4,T1		;GET ANOTHER
	AND	T3,[777777760000] ;GET HIGH 14 BITS OF V = VHI
	FSBR	T4,T3		;GET LOW 13 BITS OF V = VLO
	FMPR	T3,XHI(T2)	;GET V*XHI = VHI * XHI
	FMPR	T4,XHI(T2)	;	    + VLO * XHI
	FSBR	T0,T3		;GET (U - VHI*XHI)
	FSBR	T0,T4		;		   - VLO*XHI
	MOVM	T3,@0(L)	;GET U
	FMPR	T3,XHI(T2)	;GET U * XHI
	FADR	T1,T3		;GET V + U*XHI
	FDVR	T0,T1		;GET (U - V*XHI) / (V + U*XHI)

	POP	P,T4		;RESTORE T4

SMALL2:	SKIPGE	@1(L)		;IF SECOND ARG (X) IS NEGATIVE
	  ADDI	T2,MPIOFFS	;  ADD -PI TO RESULT
	JRST	CALC		;GO GET ATAN AND RETURN

LARGE2:	MOVN	T0,@1(L)	;GET -X/Y
	FDVR	T0,@0(L)
	MOVMM	T0,SGNFLG	;SET SGNFLG POSITIVE
	MOVEI	T2,PI2OFFS	;ADD PI/2 TO RESULT IF FIRST ARG (Y) IS POSITIVE
	SKIPGE	@0(L)
	  MOVEI	T2,MPI2OFFS	;ADD -PI/2 TO RESULT IF FIRST ARG (Y) IS NEGATIVE
	JRST	CALC		;GO COMPUTE +/- PI/2 + ATAN(-X/Y)

EXCEP:	SKIPN	@1(L)		;CHECK FOR DIVIDE BY 0
	  JRST	DIVCHK		;IF DIVIDE CHECK, GO CHECK FOR ATAN2(0,0)
	JUMPN	T0,OVER		;IF OVERFLOW, RESULT IS +/- PI/2
	SKIPL	@1(L)		;IF UNDERFLOW, CHECK SECOND ARGUMENT
	  LERR	(LIB,%,<ATAN2: result underflow>,,RET)
				;IF SECOND ARG (X) POSITIVE, RESULT UNDERFLOWS
	MOVN	T0,MPI		;ELSE RESULT IS PI WITH SIGN OF FIRST ARG
	JRST	YSIGN		;GO ATTACH SIGN AND RETURN

DIVCHK:	SKIPE	@0(L)		;CHECK FOR BOTH ARGS 0
	  JRST	OVER		;ATAN2(NONZERO,0) IS SAME AS OVERFLOW
	LERR	(LIB,%,<ATAN2: both arguments are zero, result=0.0>)
	SETZ	T0,		;RETURN 0
	JRST	RET

OVER:	MOVE	T0,PI2		;OVERFLOW, RESULT IS PI/2 WITH SIGN OF FIRST ARG
YSIGN:	SKIPGE	@0(L)		;ATTACH SIGN OF FIRST ARGUMENT (Y)
	  MOVN	T0,T0
	JRST	RET		;RETURN
SUBTTL TABLES

;This table is indexed by the low 3 exponent bits and the high 3 fraction bits
;of X, where MINX < X < MAXX.  It gives the offset into XHI, ATANHI, and ATANLO
;of a suitable XHI.

OFFSET:	DEC	1,1,1,2,2,3,3,4,4,4,5,5,5,6,6,7,7,7,8,8,8,9,9,9
	DEC	10,10,10,10,11,11,11,12,12,12,12,12,13,13,13,13
	DEC	13,13,14,14,14,14,14,14,14,14,14,14,14,14,14

PI2OFFS=^D15			;OFFSET INTO ATANHI AND ATANLO OF PI/2
MPIOFFS=^D16			;OFFSET OF -PI
MPI2OFFS=^D31			;OFFSET OF -PI/2

XHI:	EXP    000000000000		; .000000000     not used
 	EXP    175657740000		; .105453491     X1
 	EXP    176407740000		; .128875732     X2
 	EXP    176477740000		; .156219482    
 	EXP    176617640000		; .195220947    
 	EXP    176777400000		; .249755859    
 	EXP    177477540000		; .312194824    
 	EXP    177617200000		; .389892578    
 	EXP    177776300000		; .498413086    
 	EXP    200515740000		; .652221680    
 	EXP    200674040000		; .867309570    
 	EXP    201453440000		; 1.17016602    
 	EXP    201645100000		; 1.64501953    
 	EXP    202511040000		; 2.57080078    
 	EXP    203527000000		; 5.35937500     X14

ATANHI:	EXP    000000000000		; .000000000     ATAN(0)
 	EXP    175656261521		; .105065183     ATAN(X1)
 	EXP    176406373155		; .128169263     ATAN(X2)
 	EXP    176475276501		; .154966952    
 	EXP    176612661306		; .192796122    
 	EXP    176765175625		; .244748870    
 	EXP    177465675100		; .302606821    
 	EXP    177574536625		; .371762831    
 	EXP    177731362666		; .462377273    
 	EXP    200447716237		; .577935450    
 	EXP    200555632634		; .714457721    
 	EXP    200672140433		; .863649569    
 	EXP    201406227205		; 1.02459152    
 	EXP    201463117110		; 1.19982255    
 	EXP    201542714675		; 1.38632865     ATAN(X14)
PI2:	EXP    201622077325		; 1.57079633     PI/2
MPI:	EXP    575155700452		;-3.14159268     -PI
 	EXP    575173246104		;-3.03652751     -PI + ATAN(X1)
 	EXP    575176220221		;-3.01342341     -PI + ATAN(X2)
 	EXP    575201554376		;-2.98662573    
 	EXP    575206433526		;-2.94879657    
 	EXP    575215150343		;-2.89684382    
 	EXP    575224470162		;-2.83898586    
 	EXP    575235354335		;-2.76982984    
 	EXP    575251036741		;-2.67921540    
 	EXP    575267664122		;-2.56365722    
 	EXP    575311247221		;-2.42713496    
 	EXP    575334330561		;-2.27794310    
 	EXP    575361014154		;-2.11700118    
 	EXP    576016720235		;-1.94177012    
 	EXP    576076516022		;-1.75526401     -PI + ATAN(X14)
 	EXP    576155700453		;-1.57079633     -PI/2

ATANLO:	EXP    000000000000		; .000000000    
 	EXP    636247477474		;-.313207918E-09
 	EXP    636051035473		;-.428319397E-09
 	EXP    635130365140		;-.770380426E-09
 	EXP    637267032057		;-.149588704E-09
 	EXP    142516146051		; .607905122E-09
 	EXP    634037666255		;-.174675323E-08
 	EXP    636153733615		;-.367500207E-09
 	EXP    635370616245		;-.478798078E-09
 	EXP    635035566432		;-.877241210E-09
 	EXP    143723624120		; .170180781E-08
 	EXP    144654652224		; .312016779E-08
 	EXP    632252164020		;-.497345720E-08
 	EXP    145452272305		; .434176811E-08
 	EXP    145613704216		; .576086101E-08
 	EXP    143420550604		; .992093574E-09
 	EXP    147735722717		; .278181351E-07
 	EXP    150564207746		; .433374110E-07
 	EXP    147566433274		; .218018803E-07
 	EXP    147760532442		; .289103999E-07
 	EXP    150515527434		; .388444175E-07
 	EXP    150504133030		; .377392659E-07
 	EXP    147677716232		; .260713819E-07
 	EXP    147427462256		; .162747642E-07
 	EXP    147525537265		; .198887566E-07
 	EXP    147516656470		; .194903134E-07
 	EXP    147773114124		; .295199429E-07
 	EXP    147623410142		; .234877224E-07
 	EXP    150504167752		; .377458393E-07
 	EXP    147450401401		; .172587422E-07
 	EXP    147500703763		; .186778351E-07
 	EXP    634357227174		;-.992093574E-09

;COEFFICIENTS OF APPROXIMATION POLYNOMIAL ATAN(X) = X*P(X**2)

P01:	EXP    600252525261	;-.333333308    
P02:	EXP    176631445546	; .199987124    
P03:	EXP    601337626575	;-.140725380    

EPS:	EXP 163721135503	;LARGEST X WITH ATAN(X)=X
MINX:	EXP 175623327343	;TAN(PI/32)
MAXX:	EXP 204504715427	;1/TAN(PI/32)

	RELOC
SGNFLG:	BLOCK	1		;SIGN TO BE ATTACHED TO RESULT
	RELOC

	PRGEND
TITLE	COSH	HYPERBOLIC COSINE FUNCTION  
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.	JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

SEARCH	FORPRM
NOSYM
ENTRY	COSH
EXTERN	COSH.
COSH=COSH.
PRGEND
TITLE	COSH.	HYPERBOLIC COSINE FUNCTION
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.	JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

;COSH(X) IS CALCULATED AS FOLLOWS

;  LET V BE APPROXIMATELY 2 SO THAT LN V AND ABS(X) + LN V CAN
;  BE EXACTLY REPRESENTED WHEN X IS EXACTLY REPRESENTABLE.
;  THEN, THE CALCULATION IS (LETTING X = ABS(X)),

;	IF X <= 88.029678, RESULT 1 IS CALCULATED, AS
;		COSH(X) = (EXP(X) + 1/EXP(X))/2.0
;	IF 88.028678 < W < 128 * LN(2)
;	RESULT 2 IS OBTAINED, AS
;		COSH(X) = (V/2)*EXP(X - LN(V))
;	IF X >= 128 * LN(2)
;		COSH(X) = +MACHINE INFINITY
;		AND AN ERROR MESSAGE IS RETURNED

;THE RANGE OF DEFINITION FOR COSH IS ABS(X)<=88.722,
;  AND ARGUMENTS OUT OF THIS RANGE WILL CAUSE AN ERROR
;  MESSAGE TO BE TYPED.  A RESULT OF + MACHINE INFINITY
;  WILL BE RETURNED

;REQUIRED (CALLED) ROUTINES:  EXP

;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:

;  XMOVEI	L,ARG
;  PUSHJ	P,COSH

;THE ANSWER IS RETURNED IN ACCUMULATOR T0

	SEARCH	FORPRM
	TWOSEG	400000
	SALL

	HELLO	(COSH,.)	;ENTRY TO HYPERBOLIC COSINE ROUTINE.
	MOVE	T0,@(L)		;OBTAIN THE ARGUMENT
	MOVM	T1,T0		;X=ABS(ARG)		
	CAMG	T1,EPS		;IF ABS(X) <= EPS
	  JRST	SMALL		;ANSWER IS ONE
	CAMLE	T1,XMAX  	;IF X > 88.029,
	  JRST	OV88		;GO TO OV88
;				;OTHERWISE, OBTAIN RESULT 1
	MOVEM	T1,TEMP
	FUNCT	EXP.,<TEMP>     ;EXP(X)
	CAML	T1,TWO14	;IF EXP(X) .GT. 2**14
	  JRST	HALVE		;NEGLECT EXP(-X)
	MOVSI	T1,201400	;1.0
	FDVR	T1,T0		;/EXP(X).
	FADR	T0,T1		;+ EXP(-X).
HALVE:  FSC     T0,-1           ;/2.0
	GOODBY	(1)		;RETURN

OV88:	CAMGE	T1,XXMAX	;TOO LARGE?
	  JRST	EXPP		;NO.  GO TO EXPP
	LERR	(LIB,%,COSH: result overflow)
	HRLOI	T0,377777	;ANSWER = +INFINITY.
	GOODBY	(1)		;RETURN

EXPP:	FSBR	T1,LN2VE	;X-LN(V)
	MOVEM	T1,TEMP
	FUNCT	EXP.,<TEMP>     ;OBTAIN RESULT 2
	MOVE	T1,T0		;SAVE A COPY OF EXP (2 - LN2VE)
	FMPR	T0,CON1		;MULTIPLY BY (LN2VE - LN2)
	FADR	T0,T1		;SUM = (1/2)*EXP(W)
	GOODBY	(1)		;COSH RETURN

SMALL:	MOVSI	T0,201400	;RESULT IS ONE
	GOODBY	(1)		;RETURN

LN2VE:	200542714000		;LN(V)=.693161011
XMAX:	207540074620		;88.029678
XXMAX:	207542710300		;128 * LN(2)
CON1:	160720040562		;LN2VE - LN(2)

	RELOC			;DATA
TEMP:	0			;TEMPORARY STORAGE FOR EXP CALL
TWO14:	217400000000		;2**14
EPS:	163400000000		;2**(-14)
	RELOC
	PRGEND
TITLE	EXP	EXPONENTIAL FUNCTION
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.	JUNE 1, 1979


;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

SEARCH	FORPRM
NOSYM
ENTRY	EXP
EXTERN	EXP.
EXP=EXP.
PRGEND
TITLE	EXP.	EXPONENTIAL FUNCTION
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.	JUNE 1, 1979


;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

;EXP(X) IS CALCULATED AS FOLLOWS

;  IF X < -89.4159863, EXP = 0
;  IF X >  88.0296919, EXP = +MACHINE INFINITY
;  OTHERWISE,
;	THE ARGUMENT REDUCTION IS:
;		LET N  = THE NEAREST INTEGER TO X/LN(2)
;		THE REDUCED ARGUMENT IS  G = X-N*LN(2)
;		THE CALCULATION IS:
;		EXP = R(G)*2**(N+1)
;	            WHERE R(G) = 0.5 + G*P/(Q - G*P)
;	            P = P1*G**2 + 0.25
;	            Q = Q1*G**2 + 0.5
;	        P1 AND Q1 ARE GIVEN BELOW AS XP1 AND XQ1

;THE RANGE OF DEFINITION FOR EXP IS GIVEN ABOVE, AND ERROR MESSAGES
;  WILL RESULT FOR ARGUMENTS OUT OF THAT RANGE

;REQUIRED (CALLED) ROUTINES:  NONE

;REGISTERS T2 AND T3 WERE SAVED, USED, AND RESTORED

;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:

;  XMOVEI	L,ARG
;  PUSHJ	P,EXP

;THE ANSWER IS RETURNED IN ACCUMULATOR T0


	SEARCH	FORPRM
	TWOSEG	400000
	SALL

	HELLO	(EXP,.)		;ENTRY TO EXPONENTIAL ROUTINE
	MOVE	T0,@(L)		;OBTAIN THE ARGUMENT X
	CAMGE	T0,E77		;IF X<  -89.415...
	  JRST	OUT2		;GO TO EXIT.
	CAMG	T0,E7		;IF X LE 88.029...
	  JRST	EXP1		;GO TO ALGORITHM.  OTHERWISE.
	LERR	(LIB,%,EXP: result overflow)
	HRLOI	T0, 377777	;EXP = +MACHINE INFINITY
	GOODBY	(1)		;RETURN

OUT2:	LERR	(LIB,%,EXP: result underflow)
	MOVEI	T0,0		;EXP = 0
	GOODBY	(1)		;RETURN

EXP1:	PUSH	P,T2		;SAVE ACCUMULATORS		
	PUSH	P,T3
	SETZ	T1,0		;T0,T1=X=N*LN(2)+G
	MOVE	T2,T0	
	SETZ	T3,0		;T2,T3=X
	DFMP	T2,RLN2		;T2,T3=N+G/LN(2)
	FIXR	T2,T2		;T4=N
	MOVEM	T2,TEMP		;SAVE N
	FLTR	T2,T2		;FLOAT N
	SETZ	T3,0		;T2,T3=FLOAT(N)
	DFMP	T2,LN2		;T2,T3=N*LN(2)
	DFSB	T0,T2		;T0,T1=G
	MOVE	T2,T0		;GET ABS(G)
	JUMPGE	T2,GPOS		;IF G IS NEGATIVE NEGATE G
	DMOVN	T0,T0	
GPOS:	TLNE	T1,(1B1)	;IF 2ND BIT OF 2ND WORD IS ON
	ADDI	T0,1		;ROUND G
	TLO	T0,(1B9)	;GUARD AGAINST SPILL INTO EXPONENT
	JUMPGE	T2,GOTG		;REGAIN SIGN OF G
	MOVN	T0,T0
GOTG:	MOVE	T1,T0
	FMPR	T1,T1		;G**2
	JFCL
	MOVE	T2,T1
	FMPR	T2,XP1		;P1*G**2
	JFCL
	FADRI	T2,177400	;+0.25 = P
	FMPR	T0,T2		;*G
	JFCL
	FMPR	T1,XQ1		;Q1*G**2
	JFCL
	FADRI	T1,200400	;+0.5 = Q
	FSBR	T1,T0		;Q - G*P
	FDVR	T0,T1		;G*P/(Q - G*P)
	FADRI	T0,200400	;+ 0.5 = R(G)
	MOVE	T3,TEMP		;RETRIEVE N
	FSC	T0,1(T3)	;R(G)*2**(N+1)
	POP	P,T3		;RESTORE ACCUMULATORS
	POP	P,T2

RET:	GOODBY	(1)		;RETURN

E7:	207540074636		;88.0296919
E77:	570232254037		;-89.4159863
RLN2:	DOUBLE 201561250731,112701375747	;1./LN(2)=1.44269504
LN2:	DOUBLE 200542710277,276434757260	;LN(2)
XP1:	171420514076		;.00416028863
XQ1:	174631375331		;.0499871789

	RELOC			;DATA
TEMP:	0
	RELOC
 	PRGEND
TITLE	EXP1.	INTEGER ** INTEGER EXPONENENTIATION
SUBTTL	CHRIS SMITH/CKS		28-Jan-80

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

	SEARCH	FORPRM
	TWOSEG	400000

	HELLO	(EXP1,.)
	MOVEI	T0,1		;SET RESULT TO 1
	SKIPN	T1,@1(L)	;GET EXPONENT
	  POPJ	P,		;EXPONENT ZERO, RETURN 1

	PUSH	P,T2		;SAVE TEMP REGISTERS

	SKIPN	T2,@0(L)	;GET BASE
	  JRST	E1ZERO		;BASE IS ZERO, GO HANDLE
	JUMPG	T1,E1POS	;EXPONENT POSITIVE, GO HANDLE

	TRNE	T1,1		;EXPONENT NEGATIVE, IS IT ODD?
	  MOVE	T0,T2		;YES, RESULT IS -1 IF BASE IS -1
	CAME	T2,[-1]		;IS BASE -1?
	CAIN	T2,1		;OR +1?
	  JRST	E1RET		;YES, RESULT IS 1 OR -1
E1RTZ:	SETZ	T0,		;ELSE RESULT IS 0
	JRST	E1RET		;RETURN

E1LP:	IMUL	T2,T2		;SQUARE BASE
	  JFCL	E1OVFL		;CATCH OVERFLOW
E1POS:	TRNE	T1,1		;CHECK LOW BIT OF EXPONENT
	  IMUL	T0,T2		;MULTIPLY ANSWER BY BASE
	   JFCL	E1OVFL		;CATCH OVERFLOW
	LSH	T1,-1		;DIVIDE EXPONENT BY 2
	JUMPN	T1,E1LP		;HANDLE ALL BITS OF EXPONENT

E1RET:	POP	P,T2		;RESTORE TEMP REGISTERS
	POPJ	P,		;DONE

E1ZERO:	JUMPGE	T1,E1RTZ	;BASE 0, RESULT IS 0 IF EXPONENT POSITIVE
				;ELSE FALL INTO OVERFLOW

E1OVFL:	LERR	(LIB,%,EXP1: result overflow)
	HRLOI	T0,377777	;GUESS POSITIVE RESULT
	SKIPL	@0(L)		;CHECK SIGN OF BASE
	  JRST	E1RET		;BASE NONNEGATIVE, GO RETURN +INFINITY
	MOVE	T1,@1(L)	;BASE NEGATIVE, CHECK FOR ODD EXPONENT
	TRNE	T1,1		;ODD EXPONENT?
	  MOVSI	T0,400000	;NEGATIVE**ODD, RETURN -INFINITY
	JRST	E1RET

	PRGEND
TITLE	EXP2.	REAL ** INTEGER EXPONENENTIATION
SUBTTL	CHRIS SMITH/CKS		28-Jan-80

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

	SEARCH	FORPRM
	TWOSEG	400000
	SALL

	HELLO	(EXP2,.)
	MOVSI	T0,(1.0)	;SET RESULT TO 1
	MOVM	T1,@1(L)	;GET ABS(EXPONENT)
	JUMPE	T1,E2POPJ	;EXPONENT ZERO, GO RETURN 1

	PUSH	P,T2		;SAVE TEMP REGISTERS

	SKIPE	T2,@0(L)	;GET BASE
	  JRST	E2POS		;BASE NOT ZERO, GO GET BASE**ABS(EXP)
	JRST	E2ZERO		;BASE ZERO, GO HANDLE

E2LP:	FMPR	T2,T2		;SQUARE BASE
	  JFCL	E2OVUN		;CATCH OVERFLOW
E2POS:	TRNE	T1,1		;CHECK LOW BIT OF EXPONENT
	  FMPR	T0,T2		;MULTIPLY ANSWER BY BASE
	   JFCL	E2OVUN		;CATCH OVERFLOW
	LSH	T1,-1		;DIVIDE EXPONENT BY 2
	JUMPN	T1,E2LP		;HANDLE ALL BITS OF EXPONENT

	SKIPL	@1(L)		;NEGATIVE EXPONENT?
	  JRST	E2RET		;NO, WE HAVE RESULT
	MOVSI	T1,(1.0)	;YES, GET RECIPROCAL
	FDVRM	T1,T0

E2RET:	POP	P,T2		;RESTORE TEMP REGISTERS
E2POPJ:	POPJ	P,		;DONE

E2ZERO:	SKIPL	T1,@1(L)	;BASE 0, RESULT IS 0 IF EXPONENT POSITIVE
	  JRST	E2RTZ		;POSITIVE EXPONENT, GO RETURN 0
	JRST	E2OVFL		;ELSE RESULT OVERFLOWS

E2OVUN:	MOVM	T2,@0(L)	;GET ABS(BASE)
	MOVE	T1,@1(L)	;AND EXPONENT
	CAMGE	T2,[1.0]	;ABS(BASE) .LT. 1?
	  MOVN	T1,T1		;YES, COMPLEMENT EXPONENT
	JUMPL	T1,E2UNFL	;NEGATIVE, RESULT UNDERFLOWS

E2OVFL:	LERR	(LIB,%,EXP2: result overflow)
	HRLOI	T0,377777	;OVERFLOW, GUESS POSITIVE RESULT
	SKIPL	@0(L)		;CHECK SIGN OF BASE
	  JRST	E2RET		;BASE NONNEGATIVE, GO RETURN +INFINITY
	TRNE	T1,1		;ODD EXPONENT?
	  MOVN	T0,T0		;NEGATIVE**ODD, RETURN -INFINITY
	JRST	E2RET

E2UNFL:	LERR	(LIB,%,EXP2: result underflow)
E2RTZ:	SETZ	T0,		;RETURN 0
	JRST	E2RET

	PRGEND
TITLE	EXP3.	 POWER FUNCTION  
;		(SINGLE PRECISION)
SUBTTL	IMSL, INC.	JUNE 4, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


;EXP3 CALCULATES X**Y WHERE X AND Y ARE FLOATING POINT VALUES IN THE
;FOLLOWING RANGES
;  0.0 < X < + MACHINE INFINITY  (X MAY EQUAL 0.0 IF Y > 0.0 AND
; X MAY BE LESS THAN 0.0 IF Y IS AN INTEGER. IF X IS < 0.0
; AND Y IS NOT AN INTEGER, A WARNING ERROR IS ISSUED AND 
; ABS(X)**Y IS CALCULATED.)
;  -129.0 < FLOAT(INT((Y*LOG2(X))*16))/16 < 127.0
;  X**Y IS CALCULATED AS 2**W WHERE W = Y*LOG2(X). LOG2(X) IS 
;  CALCULATED AS FOLLOWS;
;      X = F*(2**M), 1/2 <= F < 1. PICK P SUCH THAT P IS AN ODD
;      INTEGER < 16 AND LET A = 2**(-P/16). NOW X = ((2**M)*A)*(F/A)
;      LOG2(X) = M+LOG2(A) + LOG2(F/A) OR
;      LOG2(X) = M-(P/16) + LOG2(F/A) .
;       LET U1 = M-(P/16) AND
;          U2 = LOG2(F/A) = LOG2((1+S)/(1-S)).
;       THEN LOG2(X) = U1 + U2.
;      AND S = (F-A)/(F+A). A RATIONAL
;      APPROXIMATION IS USED TO EVALUATE U2. U1 AND U2 ARE THEN
;      USED TO DETERMINE W1 AND W2 WHERE W=W1+W2
;      AND W1 = FLOAT(INT(W*16.0))/16.0. FINALLY Z=X**Y=2**W
;      IS RECONSTRUCTED AS Z = (2**W1) * (2**W2) WHERE
;      W1 = M1-P1/16 AND 2**W2 IS EVALUATED FROM ANOTHER RATIONAL
;      FUNCTION.


;THE RANGE OF DEFINITION FOR EXP3 IS GIVEN ABOVE, AND ERROR MESSAGES
;  WILL RESULT FOR ARGUMENTS OUT OF THAT RANGE

;REQUIRED (CALLED) ROUTINES:  NONE

;REGISTERS T2, T3, T4, AND T5 WERE SAVED, USED, AND RESTORED

;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:

;  XMOVEI	L,ARG
;  PUSHJ	P,EXP3

;THE ANSWER IS RETURNED IN ACCUMULATOR T0

	SEARCH	FORPRM
	TWOSEG	400000
	SALL

	HELLO	(EXP3,.)		;ENTRY TO EXP3. ROUTINE
      	MOVE	T0,@(L)			;GET THE BASE
	MOVE	T1,@1(L)		;GET THE EXPONENT
STRT:	SETZM	IFLAG			;SET INTEGER EXP FLAG TO 0
	JUMPG	T0,XOK			;IF X IS NOT GT 0
	JUMPE	T0,X0			;AND IF X IS NOT = 0
	PUSH	P,T2			;SAVE ACCUMULATORS
	PUSH	P,T3
	PUSH	P,T4
	MOVM	T2,T1			;GET A COPY OF ABS(Y)
	MOVE	T4,T2			;PUT ABS(Y) IN T4
	SETZ	T3,			;SET T3 TO ZERO
	LSHC	T3,11			;GET EXPONENT OF ABS(Y)
	SUBI	T3,170			;GET SHIFTING FACTOR
	LSH	T2,(T3)			;SHIFT OFF EXP AND PART OF INTEGER
	TLNE	T2,400000		;IF Y IS ODD
	  SETOM	IFLAG			;SET IFLAG TO ONES
	LSH	T2,1			;SHIFT OFF REST OF INTEGER PART
	MOVM	T0,T0			;GET ABS(X) IN T0
	JUMPN	T2,ERR0			;ERROR IF Y NOT AN INTEGER.
	CAME	T0,A1			;IF X NOT -1
	  JRST	YINT			;  REJOIN MAIN FLOW.
	JRST	RET2			;ELSE RESULT = + OR - 1
	
ERR0:	LERR	(LIB,%,<EXP3: negative ** non-integer; ABS(base) used instead of base>)
	JRST	CONT			;GO TO CONT
X0:	JUMPG	T1,RET1			;0 ** POSITIVE IS +1
	JUMPE	T1,ZERZER		;0 ** 0 IS AN ERROR
	LERR	(LIB,%,<EXP3: 0.0 ** negative; result = infinity>)
	HRLOI	T0,377777		;RESULT = INFINITY
	GOODBY				;RETURN
ZERZER:	LERR	(LIB,%,<EXP3: 0.0 ** 0.0 is undefined; result = 0.0>)
	SETZ	T0,			;RETURN 0
	GOODBY

XOK:	CAMN	T0,A1			;IF X = 1, RESULT IS 1
	  JRST	RET1			;RETURN
	PUSH	P,T2			;SAVE ACCUMULATORS
	PUSH	P,T3
	PUSH	P,T4
YINT:	CAMN	T1,A1			;IF Y = 1.0
	  JRST	RET2			;GO TO RET2
	JUMPN	T1,CONT			;IF Y IS NOT 0, GO TO CONT
	MOVE	T0,A1			;SET RESULT TO 1.0
	JRST	RET2			;GO TO RET2
CONT:	PUSH	P,T5
	MOVE	T2,T0			;OBTAIN THE EXPONENT
	ASH	T2,-33			;SHIFT MANTISSA OFF
	SUBI	T2,200			;SUBTRACT 128 FROM EXPONENT
	MOVEM	T2,M
	MOVE	T2,T0			;OBTAIN FRACTIONAL PART
	AND	T2,MASK1		;EXTRACT MANTISSA
	IOR	T2,MASK2		;SET EXPONENT TO 0
	MOVEI	T5,1			;NP = 1
	CAMLE	T2,A1+10		;IF F GT A1(9)
	  JRST	NXT1			;THEN GO TO NXT1
	ADDI	T5,10			;OTHERWISE NP=9
NXT1:	CAMLE	T2,A1+3(T5)		;IF F GT A1(P+4)
	  JRST	NXT2			;THEN GO TO NXT2
	ADDI	T5,4			;OTHERWISE NP = NP+4
NXT2:	CAMLE	T2,A1+1(T5)		;IF F GT A1(P+2)
	  JRST	NXT3			;THEN GO TO NXT3
	ADDI	T5,2			;OTHERWISE NP=NP+2
NXT3:	MOVE	T3,T5			;NA = NP
	ADDI	T3,1			; + 1
	ASH	T3,-1			; / 2
	MOVE	T0,T2			;Z1 =
	FADR	T0,A1(T5)		;F + A1(P+1)
	MOVE	T4,T2			;Z =
	FSBR	T4,A1(T5)		;[F-A1(P+1)
	FSBR	T4,A2-1(T3)		; -A2(NA)]
	FDVR	T4,T0			;/Z1
	FSC	T4,1			;Z = Z+Z
	MOVE	T0,T4			;RZ =
	FMPR	T0,T0			;Z**2
	MOVE	T2,T0			;SAVE A COPY OF Z**2
	FMPR	T0,RP2			;*RP2
	FADR	T0,RP1			;+RP1
	FMPR	T0,T2			; * Z**2
	FMPR	T0,T4			; * Z
	FADR	T0,T4			; + Z
	MOVE	T4,T0			; U2 =
	FMPR	T0,XK			;RZ*XK
	FADR	T4,T0			;+ RZ
	MOVE	T2,M			;GET U1
	ASH	T2,4			;M*16
	SUB	T2,T5			;-NP
	FLTR	T2,T2			;FLOAT
	FSC	T2,-4			; /16 = U1
	SETZB	T3,T5			;
	DFAD	T4,T2			;U = U1+U2
	SETZ	T2,			;
	DFMP	T4,T1			;W = Y*U
	  JFCL	EXCEP			;CAN OVERFLOW OR UNDERFLOW
	CAMGE	T4,BIGW			;IF W IS NOT TOO BIG
	  JRST	WOK			;THEN PROCEED
OVFL:	LERR	(LIB,%,EXP3: result overflow)
	HRLOI	T0,377777		; RESULT = INFINITY
	JRST	RET			; RETURN

EXCEP:	JUMPN	T4,OVER			;JUMP IF W = Y*U OVERFLOWS
	MOVE	T0,A1			;IF W UNDERFLOWS, RESULT IS 1
	JRST	RET3			;RETURN
OVER:	JUMPL	T4,UNDFL		;W NEGATIVE, RESULT UNDERFLOWS
	JRST	OVFL			;W POSITIVE, RESULT OVERFLOWS

WOK:	CAML	T4,SMALLW		;IF W IS NOT TOO SMALL
	  JRST	WOK2			;THEN PROCEED
UNDFL:	LERR	(LIB,%,EXP3: result underflow)
	SETZ	T0,			; RESULT = 0
	JRST	RET			; RETURN

WOK2:	DMOVE	T0,T4			;SAVE A COPY OF DABS(W)
	JUMPGE	T4,WPOS
	  DMOVN	T0,T4
WPOS:	LDB	T1,[POINT 8,T0,8]	;GET BIASED EXPONENT OF ABS(W)
	SUBI	T1,175			;GET SHIFTING FACTOR
	JUMPGE	T1,GETW1		;IF T1 IS .GE. 0
	       				;THEN GO TO GETW1
	SETZB	T1,T3			;M1 = 0;  NP1+1 = 0
	PUSHJ	P,SNG.4##		;W2 = W ROUNDED TO SINGLE PRECISION
	JRST	REST
GETW1:	AND	T0,MASK(T1)		;GET W1
	JUMPG	T4,GETW2		;IF W IS NEGATIVE
	DMOVN	T4,T4			;GET |W|.
	SETZ	T1,			;ZERO EXTEND |W1|
	DFSB	T4,T0			; AND SUBTRACT FROM |W|.
	PUSHJ	P,SNG.4##		;ROUND |W2| TO SINGLE
	MOVN	T4,T4			;AND NEGATE TO GET W2
	FSC	T0,4			;GET 16*|W1|
	FIX	T3,T0			;  AND CONVERT TO INTEGER
	MOVN	T3,T3			;AND MAKE NEGATIVE
	JRST	GETSCL			;GO GET M1 AND NP1+1
GETW2:	SETZ	T1,
	DFSB	T4,T0			;W2 = W-W1
	PUSHJ	P,SNG.4##		;ROUND W2 TO SINGLE PRECISION
	FSC	T0,4			;W1*16
	FIX	T3,T0			; INT(W1*16)
GETSCL:	MOVE	T5,T3
	JUMPGE	T3,NPOS
	  ADDI	T3,17
NPOS:	ASH	T3,-4			; /16
	CAIL	T5,0			;IF N1 IS GE 0
	  ADDI	T3,1			;M1 = M1+1
	MOVE	T1,T3
	ASH	T3,4			; M1 * 16
	SUB	T3,T5			; - N1 = NP1
REST:	MOVE	T0,T4			;GET(2**W2)-1
	FMPR	T0,Q5			;Z = Q5*W2
	FADR	T0,Q4			; +Q4
	FMPR	T0,T4			;*W2
	FADR	T0,Q3			;+Q3
	FMPR	T0,T4			;*W2
	FADR	T0,Q2			;+Q2
	FMPR	T0,T4			;*W2
	FADR	T0,Q1			;+Q1
	FMPR	T0,T4			;*W2
	FMPR	T0,A1(T3)		; Z = Z*A1(NP1+1)
	FADR	T0,A1(T3)		; + A1(NP1+1)
	FSC	T0,(T1)			; ADD M1 TO THE EXP OF Z

RET:	POP	P,T5
RET2:	SKIPE	IFLAG			;IF IFLAG IS ON
	  MOVN	T0,T0			;  NEGATE RESULT
RET3:	POP	P,T4
	POP	P,T3
	POP	P,T2
RET1:	GOODBY	(1)			;RETURN

BIGW:		127.0E0			;UPPER BOUND FOR WW
SMALLW:	-129.0E0			;LOWER BOUND FOR W
XK:	0.4426950409E0			;LOG2(E)-1.0
RP1:	0.8333332862E-1			;
RP2:	0.1250648500E-1			;
Q1:	0.6931471806E+0			;USED TO DETERMINE
Q2:	0.2402265061E+0			;2**W2
Q3:	0.5550404881E-1			;
Q4:	0.9616206596E-2			;
Q5:	0.1305255159E-2			;
A1:	1.0E0				;A1(I), I=1,17 =
A12:	200752225751			;2**((1-I))/16. THIS
A13:	200725403067			;TABLE IS SEARCHED 
A14:	200701463367			;TO DETERMINE P.
A15:	200656423746			;
A16:	200634222141			;
A17:	200612634521			;
A18:	200572042435			;
A19:	200552023632			;
A110:	200532540767			;
A111:	200513773265			;
A112:	200475724623			;
A113:	200460337603			;
A114:	200443417234			;
A115:	200427127017			;
A116:	200413253033			;
A117:	0.5E0				;
A2:	633244441546			;
A22:	144605245161			;
A23:	633243741100			;
A24:	637260060666			;
A25:	144510250245			;
A26:	140443204215			;
A27:	633165304342			;
A28:	143763044173			;
MASK1:	000777777777			;MASK FOR MANTISSA
MASK2:	200000000000			;MASK FOR EXPONENT
MASK:	777400000000			;MASKS FOR FINDING W1
MSK1:	777600000000			;
MSK2:	777700000000			;
MSK3:	777740000000			;
MSK4:	777760000000			;
MSK5:	777770000000			;
MSK6:	777774000000			;
MSK7:	777776000000			;
MSK8:	777777000000			;
MSK9:	777777400000			;
MSK10:	777777600000			;
MSK11:	777777700000			;

	RELOC				;DATA
IFLAG:	0				;ODD INT EXP  FLAG
M:	0				;
	RELOC
	PRGEND
TITLE   RAN	RANDOM NUMBER GENERATOR
;                    (INTEGER)
SUBTTL  IMSL, INC.    JANUARY 23, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORRANCE  WITH  THE  TERMS  OF  SUCH  LICENSE  AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;SETRAN MAY BE USED AS FOLLOWS
;  THE SEED FOR RAN MAY BE INITIALIZED TO AN INTEGER VALUE IN THE
;  EXCLUSIVE RANGE (1,2147483647) BY A CALL TO SETRAN(I) WITH I = SEED.
;  SETRAN PROTECTS AGAINST AN ILLEGAL SEED BY SETTING SEED EQUAL TO
;  MOD(ABS(SEED),2147483648).
;  A CALL TO SETRAN WITH I = 0 WILL SET THE SEED TO THE DEFAULT VALUE
;  USED BY RAN. THE DEFAULT VALUE OF SEED IS 123457.
;  UPON EACH CALL TO RAN A NEW SEED IS GENERATED FOR SUBSEQUENT USE.
;RAN(I) IS CALCULATED AS FOLLOWS
;  FIRST THE NEW SEED IS CALCULATED AS
;  SEED = MOD(SEED*16807,2147483647)
;  THE RANDOM NUMBER IS THEN CALCULATED AS
;  RAN = SEED/2147483648
;A CALL TO SAVRAN, CALL SAVRAN(I), RETURNS THE LAST SEED USED BY 
;  RAN IN I.
;

;REQUIRED (CALLED) ROUTINES:  NONE

;THE ROUTINES SETRAN AND SAVRAN HAVE THE FOLLOWING CALLING SEQUENCE:

;  XMOVEI	L,ARG
;  PUSHJ	P,SETRAN
;       OR
;  PUSHJ	P,SAVRAN

;THE RESULT FOR SAVRAN IS RETURNED IN ARG

;THE ROUTINE RAN HAS THE FOLLOWING CALLING SEQUENCE:

;  PUSHJ	P,RAN

;THE ANSWER IS RETURNED IN ACCUMULATOR T0

	SEARCH	FORPRM
	TWOSEG	400000
	SALL

	HELLO	(SETRAN)	;ENTRY TO SETRAN
	MOVM	T0,@(L)		;OBTAIN ABSOLUTE VALUE OF ARGUMENT
	AND	T0,CON4		;T0=MOD(T0,2**31)
	CAIN	T0,0		;IF T0 IS ZERO
	  MOVE	T0,JSEED	;SET T0 TO DEFAULT SEED
	MOVEM	T0,ISEED	;MOVE NEW SEED TO MEMORY
	GOODBY	(1)		;RETURN

	HELLO	(RAN)		;ENTRY TO RAN
    	MOVE	T0,ISEED	;OBTAIN CURRENT SEED
	MUL	T0,CON3		;SEED=SEED*16807
	DIV	T0,CON4		;MOD(SEED,(2**31)-1)
	MOVEM	T1,ISEED	;MOVE NEW SEED TO MEMORY
	MOVSI	T0,237000	;FLOAT SEED AND DIVIDE BY 2**31
	DFAD	T0,DZERO	;NORMALIZE RESULT
	GOODBY	(1)		;RETURN

   	HELLO	(SAVRAN)	;ENTRY TO SAVRAN
	MOVE	T0,ISEED	;OBTAIN CURRENT SEED
	MOVEM	T0,@(L)		;MOVE CURRENT SEED TO ARGUMENT
	GOODBY	(1)		;RETURN

DZERO:	EXP	0,0		;ZEROS
CON3:	^D630360016		;MULTIPLIER FROM VERSION 5A
CON4:	017777777777		;(2**31) - 1

	RELOC			;DATA
ISEED:	^D524287		;SEED FROM VERSION 5A
JSEED:	^D524287		;SEED FROM VERSION 5A
	RELOC
 	PRGEND
TITLE	RANS	SHUFFLED RANDOM NUMBER GENERATOR  
;		(SINGLE PRECISION)
SUBTTL	IMSL, INC.	FEBRUARY 26, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

;RANS IS A PRIME-MODULUS RANDOM NUMBER GENERATOR WITH SHUFFLING WHICH
;COMPUTES PSEUDO RANDOM NUMBERS AS FOLLOWS:
;  ON THE INITIAL REFERENCE TO RANS, RAN IS CALLED 128 TIMES TO 
;  GENERATE S(1),S(2),...,S(128) (UNIFORM RANDOM DEVIATES IN (0,1)) AND A
;  NEW SEED X(0). X(0) IS OBTAINED BY CALLING SAVRAN AFTER S(128) HAS BEEN
;  GENERATED.

;  THEN X(I+1) = (16807*X(I) MOD ((2**31)-1)
;       J = (X(I+1) MOD 128) +1
;       T = S(J)
;       S(J) = X(I+1)/(2**31)
;  RANS RETURNS T AS ITS FUNCTION VALUE.

;REQUIRED (CALLED) ROUTINES: RAN

;REGISTER T2 WAS SAVED, USED, AND RESTORED

;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE;

;	PUSHJ	P,RAN

;THE ANSWER IS RETURNED IN ACCUMULATOR T0

	SEARCH	FORPRM
	TWOSEG	400000
	SALL

	HELLO	(RANS)		;ENTRY TO RANS
     	PUSH	P,T2			;
	SKIPN	T1,IOPT			;IF THIS IS NOT INITIAL ENTRY
 	  JRST	GGUW			;THEN GO GENERATE AND SHUFFLE
	SETZM	IOPT			;
	MOVE	T2,SETCNT		;SET COUNTERS

GGUB:	FUNCT	RAN,<IOPT>		;GENERATE A RANDOM NUMBER
	MOVEM	T0,WK-1(T2)
	AOBJN	T2,GGUB			;RETURN TO GGUB UNTIL 128
					;NUMBERS HAVE BEEN GENERATED

GGUW:	FUNCT	SAVRAN,<ICEED>	;GET LAST SEED GENERATED
	MUL	T0,CON3			;SEED = SEED*16807
	DIV	T0,CON4			;MOD(SEED,(2**31)-1)
	MOVEM	T1,ICEED		;MOVE NEW SEED TO MEMORY
	FUNCT	SETRAN,<ICEED>	;SET NEW SEED
	ANDI	T1,177			;SEED = MOD(SEED,128.)
	ADDI	T1,1			;J = SEED+1
	MOVE	T0,ICEED		;RETRIEVE SEED
	FLTR	T0,T0			;FLOAT SEED
	FSC	T0,-37			;RESULT = SEED/2**31
	MOVE	T2,T0			;
	MOVE	T0,WK-1(T1)		;RESULT = WK(J)
	MOVEM	T2,WK-1(T1)		;WK(J) = T2
	POP	P,T2
	GOODBY	(1)

SETCNT:	777600000001			;SET COUNTERS
CON4:	017777777777			;(2**31)-1
CON3:	40647				;16807

	RELOC				;DATA
ICEED:	0				;
IOPT:	1				;OPTION SWITCH
WK:	BLOCK	200			;ALLOCATE WORK AREA
	RELOC
	PRGEND
TITLE	COS	SINE AND COSINE FUNCTIONS
;	        (SINGLE PRECISION FLOATING POINT)
SUBTTL  IMSL, INC.	JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

SEARCH	FORPRM
NOSYM
ENTRY	COS
EXTERN	COS.
COS=COS.
PRGEND
TITLE	SIN	SINE AND COSINE FUNCTIONS
;	        (SINGLE PRECISION FLOATING POINT)
SUBTTL  IMSL, INC.	JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

SEARCH	FORPRM
NOSYM
ENTRY	SIN
EXTERN	SIN.
SIN=SIN.
PRGEND
TITLE	COSD	SINE AND COSINE FUNCTIONS
;	        (SINGLE PRECISION FLOATING POINT)
SUBTTL  IMSL, INC.	JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

SEARCH	FORPRM
NOSYM
ENTRY	COSD
EXTERN	COSD.
COSD=COSD.
PRGEND
TITLE	SIND	SINE AND COSINE FUNCTIONS
;	        (SINGLE PRECISION FLOATING POINT)
SUBTTL  IMSL, INC.	JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

SEARCH	FORPRM
NOSYM
ENTRY	SIND
EXTERN	SIND.
SIND=SIND.
PRGEND
TITLE	SIN.	SINE AND COSINE FUNCTIONS
;	        (SINGLE PRECISION FLOATING POINT)
SUBTTL  IMSL, INC.	JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY

;COS(X) AND SIN(X) ARE CALCULATED AS FOLLOWS

;  NOTE THAT COS(X) = COS(-X) AND SIN(X) = -SIN(-X)
;  LET ABS(X) = N*PI + F WHERE ABS(F) <= PI/2
;  WHEN ABS(F) < EPS (SEE CONSTANTS, BELOW), SIN(F) = F
;  OTHERWISE, THE ARGUMENT REDUCTION IS:
;	N = THE NEAREST INTEGER TO ABS(X)/PI, FOR SIN, OR
;	    THIS INTEGER + 1/2 FOR COS	

;	THEN THE REDUCED ARGUMENT F = ABS(X)-N*PI

;	LET G = F**2
;	THEN R(G) = ((((R5*G + R4)*G + R3)*G + R2)*G + R1)*G
;	AND SIN(F) = F + F*R(G).  THE R(I) APPEAR BELOW

;	FINALLY,
;		SIN(X) = SIGN(X)*SIN(F)*(-1)**N, AND
;		COS(X) = SIN(X + PI/2)

;  THE RANGE OF DEFINITION IS GIVEN BY [|X|/PI] < 2**26 FOR RADIANS, AND BY
;  [|X|/180] < 2**20 FOR DEGREES.
;  SIN(X) = COS(X) = 0.0 AND AN
;  ERROR MESSAGE WILL RESULT FOR ARGUMENTS OUT OF THAT RANGE
 
;REQUIRED (CALLED) ROUTINES:  NONE

;REGISTERS T2 AND T3 WERE SAVED, USED, AND RESTORED
 
;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:
 
;  XMOVEI	L,ARG
;  PUSHJ	P,SIN
;             OR
;  PUSHJ	P,COS
 
;THE ANSWER IS RETURNED IN ACCUMULATOR T0

	SEARCH	FORPRM
	TWOSEG	400000
	SALL
	HELLO	(COSD,.)
	PUSH	P,T2		;SAVE REGISTERS
	PUSH	P,T3
	PUSH	P,T4
	MOVM	T0,@(L)		;GET DABS(X) IN T0 AND T2
	SETZ	T1,
	CAMGE	T0,K180		;IS ARG REDUCTION NECESSARY?
	  JRST	GTCOSD		;NO, SKIP IT
	DMOVE	T2,T0
	FDVRI	T2,(180.0)	;GET X / 180
	CAML	T2,[225400000000] ;MORE THAN 20 BITS?
	  JRST	OV		;YES, CAN'T RETURN ACCURATE RESULT
	FIX	T4,T2		;GET N
	FLTR	T2,T4
	FADRI	T2,(0.5)
	FMPR	T2,K180
	FSBR	T0,T2		;GET |X| - ([|X|/180] + 1/2) * 180
	DFMP	T0,PI180	;CONVERT TO RADIANS
	AOJA	T4,GETABS	;CONTINUE BELOW

GTCOSD:	FSBRI	T0,(90.0)	;OFFSET ARG TO [-90,90]
	MOVEI	T4,1		;SET SIGN TO MINUS
	JRST	GETRAD		;GO CONVERT TO RADIANS

	HELLO	(SIND,.)
	PUSH	P,T2		;SAVE REGISTERS
	PUSH	P,T3
	PUSH	P,T4
	MOVM	T0,@(L)		;GET DABS(X) IN T0 AND T2
	SETZB	T1,T4		;CLEAR SIGN FLAG
	CAMGE	T0,[90.0]	;IS ARG REDUCTION NECESSARY?
	  JRST	GTSIND		;NO, SKIP IT
	DMOVE	T2,T0
	FDVRI	T2,(180.0)	;GET X / 180
	CAML	T2,[225400000000] ;MORE THAN 20 BITS?
	  JRST	OV		;YES, CAN'T RETURN ACCURATE RESULT
	FIXR	T4,T2		;GET N
	FLTR	T2,T4
	FMPR	T2,K180
	FSBR	T0,T2		;GET X - [X/180]*180

GTSIND:	SKIPGE	@(L)		;CHECK ARG SIGN
	  TRC	T4,1		;NEGATIVE, COMPLEMENT RESULT SIGN

GETRAD:	DFMP	T0,PI180	;CONVERT TO RADIANS
	JRST	GETABS		;CONTINUE BELOW
	HELLO	(COS,.)
	PUSH	P,T2		;SAVE REGISTERS
	PUSH	P,T3
	PUSH	P,T4
	MOVM	T0,@(L)		;GET DABS(X) IN T0-T1
	SETZ	T1,
	CAMG	T0,PI		;IS ARG REDUCTION NECESSARY?
	  JRST	GETCOS		;NO, SKIP IT
	DMOVE	T2,T0		;COPY X
	DFMP	T2,ONEDPI	;GET X / PI
	CAML	T2,[233400000000] ;MORE THAN 26 BITS?
	  JRST	OV		;YES, CAN'T RETURN ACCURATE RESULT
	FIX	T4,T2		;GET [|X|/PI]
	FLTR	T2,T4
	FADRI	T2,(0.5)	;GET [|X|/PI] + 1/2
	SETZ	T3,		;CLEAR LOW WORD
	DFMP	T2,PI		;GET |X| - ([|X|/PI] + 1/2) * PI
	DFSB	T0,T2
	AOJA	T4,GETABS	;CONTINUE ARG REDUCTION BELOW

GETCOS:	DFSB	T0,PI2		;OFFSET ARG TO [-PI/2,PI/2]
	MOVEI	T4,1		;SET SIGN TO MINUS
	JRST	GETABS		;CONTINUE BELOW

	HELLO	(SIN,.)
	PUSH	P,T2		;SAVE REGISTERS
	PUSH	P,T3
	PUSH	P,T4
	MOVM	T0,@(L)		;GET DABS(X) IN T0-T1
	SETZB	T1,T4		;CLEAR SIGN FLAG
	CAMG	T0,PI2		;IS ARG REDUCTION NECESSARY?
	  JRST	GETSIN		;NO, SKIP IT
	DMOVE	T2,T0		;GET DBLE(X) IN T2
	DFMP	T2,ONEDPI	;GET X / PI
	CAML	T2,[233400000000] ;MORE THAN 26 BITS?
	  JRST	OV		;YES, CAN'T RETURN ACCURATE RESULT
	FIXR	T4,T2		;GET [X/PI] = N
	FLTR	T2,T4
	SETZ	T3,		;CLEAR LOW WORD
	DFMP	T2,PI		;GET X - [X/PI] * PI
	DFSB	T0,T2

GETSIN:	SKIPGE	@(L)		;CHECK SIGN OF ARG
	  TRC	T4,1		;NEGATIVE, COMPLEMENT RESULT SIGN

GETABS:	JUMPGE	T0,RND		;IF X POSITIVE, GO ROUND IT
	DMOVN	T0,T0		;GET ABS(X)
	TRC	T4,1		;COMPLEMENT SIGN OF RESULT

RND:	TLNN	T1,(1B1)	;NEED ROUNDING?
	  JRST	CALC		;NO, WON
	ADDI	T0,1		;YES, INCREMENT FRACTION OF HIGH WORD
	TLO	T0,400		;FIX POSSIBLE SPILL INTO EXPONENT
CALC:	CAMGE	T0,EPS		;IF F .LT. EPS,
	  JRST	RET1		;SIN OR COS = F (WITHIN SIGN)
	MOVE	T3,T0
	FMPR	T3,T3		;OBTAIN G
	MOVE	T2,T3		
	FMPR	T2,R5		;((((G*R5
	FADR	T2,R4		;+R4)
	FMPR	T2,T3		;*G
	FADR	T2,R3		;+R3)
	FMPR	T2,T3		;*G
	FADR	T2,R2		;+R2)
	FMPR	T2,T3		;*G
	FADR	T2,R1		;+R1)
	FMPR	T2,T3		;*G = R(G)
	FMPR	T2,T0		;*F
	FADR	T0,T2		;+F

RET1:	TRNE	T4,1		;IF SIGN FLAG SET,
	  MOVN	T0,T0		;NEGATE RESULT
RET:	POP	P,T4		;RESTORE ACCUMULATORS
	POP	P,T3
	POP	P,T2
	GOODBY(1)		;RETURN

OV:	MOVEI	T0,0		;RETURN ZERO
	LERR	(LIB,%,SIN or COS: ABS(arg) too large; result = zero)
	JRST	RET

PI:	EXP 202622077325,021026430215 	;PI
PI2:	EXP 201622077325,021026430215   ;PI/2
ONEDPI:	EXP 177505746033,162344202513	;1/PI
PI180:	EXP 173435750650,224516471053   ;PI/180
K180:	EXP 180.0,0			;180
R1:	601252525253		;-.166666666
R2:	172421042056		;.833333072E-2
R3:	613137720533		;-.198408328E-3
R4:	156561327224		;.275239711E-5
R5:	630145743634		;-.238683464E-7
EPS:	163552023642		;0.863167530E-4
 	PRGEND
TITLE	SINH	HYPERBOLIC SINE FUNCTION
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.	JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


SEARCH	FORPRM
NOSYM
ENTRY	SINH
EXTERN	SINH.
SINH=SINH.
PRGEND
TITLE	SINH.	HYPERBOLIC SINE FUNCTION
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.	JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


;SINH IS CALCULATED AS FOLLOWS:

;  LET V BE APPROXIMATELY 2 SO THAT LN V AND ABS(X)+LN V
;  CAN BE EXACTLY REPRESENTED WHEN X IS EXACTLY REPRESENTABLE.
;  THEN, LETTING W = ABS(X), AND NOTING THAT -SINH(-X)=SINH(X),
;  FOR
;	0 <= W < EPS, SINH = W*SIGN(X)
;	EPS <= W <= 1, SINH = (W*P4(W**2))*SIGN(X), ALGORITHM 1
;	1 < W <= 88.029678, SINH = SIGN(X)*(EXP(W)-EXP(-W))/2, ALGORITHM 2
;	88.029678 < W < 128 * LN(2)
;		SINH = SIGN(X)*((V/2)*EXP(W - LN V)), ALGORITHM 3
;	W >= 128 * LN(2), SINH = SIGN(X) * MACHINE INFINITY

;	LET Z = W**2.  THEN
;		P4(Z) = 1 + Z*(C1 + Z*(C2 + Z*(C3 + C4*Z)))
;		    WHERE THE C(I) ARE GIVEN BELOW

;THE RANGE OF DEFINITION FOR SINH IS ABS(X) <= 88.722,
;  AND ARGUMENTS OUT OF THIS RANGE WILL CAUSE AN ERROR MESSAGE
;  TO BE TYPED.  A RESULT OF SIGN(X)*MACHINE INFINITY WILL BE RETURNED

;REQUIRED (CALLED) ROUTINES:  EXP

;REGISTER T2 IS SAVED, USED, AND RESTORED

;THE ROUTINE IS CALLED IN THE FOLLOWING MANNER:

;  XMOVEI	L,ARG
;  PUSHJ	P,SINH

;THE ANSWER IS RETURNED IN AC T0

	SEARCH	FORPRM
	TWOSEG	400000
	SALL

	HELLO	(SINH,.)
	MOVM	T0,@(L)		;ABS(X) = W
	CAMGE	T0,EPS		;IF W < EPS,
	  JRST	EXPP1		;RETURN--SINH = X
	CAMLE	T0,EIGHT8	;IF W > 88.029678,
	  JRST	ALG3		;GO TO ALGORITHM 3
	CAMG 	T0,ONE		;IF W <= 1,
	  JRST	ALG1		;GO TO ALGORITHM 1
;				 OTHERWISE, ALGORITHM 2:
	MOVEM	T0,TEMP
	FUNCT	EXP.,<TEMP>	;EXP(ABS(X))
	CAML	T0,TWO14	;IF EXP(ABS(X)).GT.2**14
	JRST	HALVE		;NEGLECT EXP(-ABS(X))
	HRLZI	T1,576400	;-1.0 
	FDVR	T1,T0		;-EXP(-ABS(X))
	FADR	T0,T1		;EXP(ABS(X))-EXP(-ABS(X))
HALVE:	FSC	T0,-1	        ;/2.0
	JRST	EXPP1
;				 ALGORITHM 1
ALG1:	PUSH	P,T2
	MOVE	T1,T0		;W
	FMPR	T0,T0		;W**2
	MOVE	T2,T0
	FMPR	T0,C4		;C4*W**2
	FADR	T0,C3		;+C3
	FMPR	T0,T2		;*W**2
	FADR	T0,C2		;+C2
	FMPR	T0,T2		;*W**2
	FADR	T0,C1		;+C1
	FMPR	T0,T2		;*W**2
	FMPR	T0,T1		;*W
	FADR	T0,T1		;+W = W*P4(Z)
	POP	P,T2		;RESTORE T2
	JRST	EXPP1
;				 ALGORITHM 3
ALG3:	CAMGE	T0,XXMAX	;IF ARGUMENT IS NOT TOO LARGE
	  JRST	EXPP		;CALCULATE AT EXPP
	LERR	(LIB,%,SINH: result overflow)
	HRLOI	T0,377777	;SINH = +MACHINE INFINITY.
	JRST	EXPP1		
EXPP:	FSBR	T0,LN2VE	;W-LN(V)
	MOVEM	T0,TEMP
	FUNCT	EXP.,<TEMP>	;EXP(W - LN V)
	MOVE	T1,T0		;SAVE A COPY OF EXP(2 - LN2VE)
	FMPR	T0,CON1		;MULTIPLY BY (LN2VE - LN2)
	FADR	T0,T1		;SUM = (1/2)*EXP(2)
EXPP1:	SKIPGE	@(L)		;CONSIDER SIGN OF SINH
	  MOVN	T0,T0	
	GOODBY	(1)		;SINH RETURN

LN2VE:	200542714000		;LN(V)=.693161011
EIGHT8:	207540074620		;88.029678
XXMAX:	207542710300
C1:	176525252524 		;1.666666643E-1
C2:	172421042352		;8.333352593E-3
C3:	164637771324		;1.983581245E-4
C4:	156572227373		;2.818523951E-6
CON1:	160720040562		;LN2VE - LN(2)
ONE:	1.0E0
EPS:	164400000000
TWO14:	217400000000

	RELOC			;DATA
TEMP:	0			;TEMPORARY STORAGE FOR EXP ARG
	RELOC
	PRGEND
TITLE	SQRT	SQUARE ROOT FUNCTION  
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.	JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

SEARCH	FORPRM
NOSYM
ENTRY	SQRT
EXTERN	SQRT.
SQRT=SQRT.
PRGEND
TITLE	SQRT.	SQUARE ROOT FUNCTION
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.	JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;SQRT(X) IS CALCULATED AS FOLLOWS

;  THE SQUARE ROOT OF ABS(X) IS CALCULATED; THERE IS AN ERROR MESSAGE NOTING
;  WHEN X IS NEGATIVE.  THE INITIAL GUESS IS OPTIMUM FOR NUMBERS 
;  BETWEEN 0.5 AND 1.0.  THIS GUESS IS FOLLOWED BY TWO ITERATIONS
;  OF NEWTON'S METHOD.

;THE RANGE OF DEFINITION FOR SQRT IS THE NON-NEGATIVE REPRESENTABLE
;  REAL NUMBERS

;REQUIRED (CALLED) ROUTINES:  NONE

;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:

;  XMOVEI	L,ARG
;  PUSHJ	P,SQRT

;THE ANSWER IS RETURNED IN ACCUMULATOR T0

	SEARCH	FORPRM
	TWOSEG	400000
	SALL

	HELLO	(SQRT,.)	;ENTRY TO SQRT ROUTINE
	SKIPG	T1,@(L)		;OBTAIN X AND CHECK FOR NEGATIVITY
	  JRST	SQRTLE		;NO, HANDLE NON-POSITIVE ARGUMENT

SQRTP:	MOVE	T0,T1		;SAVE NUMBER
	LSH	T1,-1		;DIVIDE EXP BY 2
	TLZE	T1,400		;WAS EXPONENT ODD?
	  JRST	SQRT2		;YES

;HERE WHEN EXPONENT IS EVEN.  T1 CONTAINS AN UNNORMALIZED FLOATING
;  POINT NUMBER, THE FRACTION PART OF WHICH IS 1/2 THE FRACTION OF
;  THE ARGUMENT.  OUR INITIAL GUESS IS MADE BY A LINEAR APPROXIMATION
;  USING Y0 = SE (X + C), WHERE SE AND C ARE CONSTANTS USED FOR
;  EVEN EXPONENTS IN X.

	ADD	T1,[XWD 267,607000]	;COMPUTE LINEAR APPROXIMATION
	FMPRI	T1,301454		;RESCALE EXPONENT
	JRST	SQRT3

;HERE, WITH ODD EXPONENT, USE Y0 = SO * (X+C).

SQRT2:	ADD	T1,[XWD 267,607000]	;LINEAR APPROXIMATION
	FMPRI	T1,301650		;RESCALE EXPONENT

SQRT3:	FDV	T0,T1		;ORIGINAL / INITIAL GUESS
	FAD	T1,T0		;AVERAGE THEM
	FSC	T1,-1

	MOVM	T0,@(L)		;GET ORIGINAL NUMBER
	FDV	T0,T1		;SECOND ITERATION
	FADR	T0,T1
	FSC	T0,-1		;AVERAGE THIRD GUESS WITH SECOND

	GOODBY	(1)		;SQRT RETURN

SQRTLE:	JUMPE	T1,ZERO
	LERR	(LIB,%,<SQRT: negative arg; result = SQRT(ABS(arg))>)
	MOVM	T1,T1		;GET MAGNITUDE
	JRST	SQRTP		;POSITIVE NOW

ZERO:	MOVEI	T0,0		;HERE ON ZERO ARG. RETURN ZERO
	GOODBY	(1)		;SQRT RETURN

	PRGEND
TITLE   COTAN	TANGENT AND COTANGENT FUNCTIONS
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL  IMSL, INC.      JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

SEARCH	FORPRM
NOSYM
ENTRY	COTAN
EXTERN	COTAN.
COTAN=COTAN.
PRGEND
TITLE	TAN	TANGENT AND COTANGENT FUNCTIONS  
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL  IMSL, INC       JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

SEARCH	FORPRM
NOSYM
ENTRY	TAN
EXTERN	TAN.
TAN=TAN.
PRGEND
TITLE	TAN.	TANGENT AND COTANGENT FUNCTIONS
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL  IMSL, INC       JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;TAN(X) AND COTAN(X) ARE CALCULATED AS FOLLOWS;

;	THE IDENTITIES
;	 TAN(PI/2.0-G)=1.0/TAN(G)
;	 TAN(N*PI+H)=TAN(H), -PI/2.0 < H <= PI/2.0
;	 TAN(-X)=-TAN(X)
;	 COTAN(X)=1.0/TAN(X)
;	 COTAN(-X)=-COTAN(X)
;	ARE USED TO REDUCE THE ORIGINAL PROBLEM TO A PROBLEM WITH
;	AN ARGUMENT GREATER THAN -PI/2.0 AND LESS THAN OR EQUAL TO
;	PI/2.0, PI=3.14159265.
;	THEN DEFINE N AND F SO THAT
;	 X=N*PI/4.0+F, 0.0 <= F <= PI/4.0, WITH PI=3.14159265.
;	THEN
;	 TAN(F) = F, IF F,2**(-14)
;		= F*R(F**2), OTHERWISE
;	 WHERE
;	   R(F**2) = (P0+F**2*(P1+F**2*P2))/(Q0+F**2*(Q1+F**2))
;	 AND
;	   P0=62.604
;	   P1=-6.9716
;	   P2=6.7309
;	   Q0=P0
;	   Q1=-27.839
;	THE RESULT IS THEN RECIPROCATED, IF NECESSARY, AND GIVEN
;	THE APPROPRIATE SIGN.

; COEFFICIENTS ARE DERIVED FROM THOSE GIVEN IN CODY AND WAITE, "SOFTWARE
; MANUAL FOR ELEMENTARY FUNCTIONS", FOR MACHINES WITH 25-32 BIT PRECISION

;THE RANGE OF DEFINITION FOR TAN IS ABS(X) <= 2**27*(PI/2)
;  AND FOR COTAN(X), 2**(-126) * (1/2+2**(-27)) < ABS(X) <= 2**27 * (PI/2)
;  IS NECESSARY. OTHERWISE, ERROR MESSAGES WILL RESULT.

;REQUIRED (CALLED) ROUTINES:  NONE

;REGISTERS T2, T3, T4, AND T5 WERE SAVED, USED, AND RESTORED

;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:

;  XMOVEI	L,ARG
;  PUSHJ	P,TAN
;	OR
;  PUSHJ	P,COTAN

;THE ANSWER IS RETURNED IN ACCUMULATOR T0

	SEARCH	FORPRM
	TWOSEG	400000
	SALL

	HELLO	(COTAN,.)	;ENTRY TO COTAN ROUTINE
	PUSH	P,T2
	MOVM	T2,@(L)		;OBTAIN Y = ABS(X)
	MOVEI	T1,1		;1 = COTAN FLAG
	CAML	T2,EPS1		;IF Y IS NOT TOO SMALL FOR COTAN,
	  JRST 	ALG		;CONTINUE
	LERR	(LIB,%,COTAN: result overflow)
	HRLOI	T0,377777	;ANSWER = + MACHINE INFINITY
	SKIPGE	T2,@(L)		;IF X IS NEGATIVE
	MOVN	T0,T0		;RESULT = -RESULT
	POP	P,T2		;RESTORE ACCUMULATOR
	GOODBY	(1)		;RETURN

	HELLO	(TAN,.)		;ENTRY TO TAN ROUTINE
	PUSH	P,T2
	MOVM    T2,@(L)		;OBTAIN Y = ABS(X)
	SETZ	T1,
ALG:	CAMG	T2,XMAX		;IF Y IS NOT TOO LARGE,
	  JRST	ALGC		;CONTINUE ALGORITHM
	LERR	(LIB,%,TAN or COTAN: ABS(arg) too large; result = zero)
	SETZ	T0,
	POP	P,T2		;RESTORE ACCUMULATOR
	GOODBY	(1)		;RETURN

ALGC:	PUSH	P,T3		;SAVE ACCUMULATORS
	PUSH	P,T4
	PUSH	P,T5
	SETZ	T3,
	CAMG	T2,PID4         ;SKIP ARGUMENT REDUCTION IF
	  JRST  COMP1           ;ARG .LT. PI/4
	DFMP	T2,FORDPI       ;T2+T3=(N+G)
	FIX	T4,T2           
	MOVE	T0,T4           ;SAVE N IN T0
	TRNE	T4,1            ;TEST N
	  JRST	ODD	        ;JUMP TO ODD IF N IS ODD
	FLTR	T4,T4
	SETZ	T5,
	DFSB	T2,T4	        ;T2,T3 = G
	DFMP	T2,PIDD4        ;T4 = PI/4*G = F
	TLNE	T3,(1B1)	;ROUND T2 AND
	  ADDI	T2,1		;GUARD AGAINST SPILL
	TLO	T2,(1B9)	;INTO EXPONENT
	JRST	COMP
ODD:	ADDI	T4,1	        ;T4 = N+1
	FLTR	T4,T4
	SETZ	T5,
	DFSB	T4,T2	        ;T2,T3 = 1-G
	DFMP	T4,PIDD4        ;T4 = PI/4(1-G) = PI/4-F
	TLNE	T5,(1B1)	;ROUND T2 AND
	  ADDI	T4,1		;GUARD AGAINST SPILL
	TLO	T4,(1B9)	;INTO EXPONENT
	MOVE	T2,T4	        ;T2 = PI/4-F
COMP:	MOVE	T3,T0	        ;MOVE N TO T3
COMP1:	CAMGE	T2,EPS		;IF F IS LESS THAN EPS
	  JRST	LT              ;GO TO LT
	MOVE	T5,T2           ;OTHERWISE
	FMPR 	T5,T5           ;G=F*F
	MOVE	T4,T5		;RESULT = F*(R-Q)/Q + F
	FMPR	T4,R2		;FORM R
	FADR	T4,R1
	FMPR	T4,T5
	MOVE	T0,T5
	FADR	T0,Q1		;FORM Q
	FMPR	T5,T0
	FSBR	T4,T5		;FORM R-Q
	FADR	T5,R0		;COMPLETE Q BY ADDING R0
	FDVR	T4,T5		;(R-Q)/Q
	FMPR	T4,T2		;*F
	FADR	T2,T4		;+F
LT:	MOVE	T0,T2
   	ANDI	T3,3
	CAIGE 	T3,2            ;IS N .GE. 2 ?
	  JRST	NLE2            ;NO, GO TO NLE2
	MOVN	T0,T0           ;RESULT = -RESULT
	MOVN	T3,T3
	ADDI	T3,3            ;N =3-N
NLE2:	CAMN	T3,T1           ;IF N IS EQUAL TO IFLAG
	  JRST	SSGN            ;GO TO SSGN
	HRLZI	T3,201400       ;PUT 1 IN T3
	FDVR	T3,T0           ;RESULT = 1/RESULT
	MOVE	T0,T3
SSGN:	SKIPGE	T2,@(L)		;IF X IS NEGATIVE
	  MOVN	T0,T0		;RESULT = -RESULT
	POP	P,T5
	POP	P,T4
	POP	P,T3
	POP	P,T2
      	GOODBY	(1)		;RETURN

EPS1:   002400000001            ;2**(-126)*(1/2 + 2**(-27))
XMAX:   233622077325		;PI * 2**26
PID4:	200622077325            ;PI/4
PIDD4:  DOUBLE 200622077325,021026430216  ;PI/4  (DOUBLE PRECISION)
FORDPI:	DOUBLE 201505746033,162344202512  ;4/PI  (DOUBLE PRECISION)
EPS:    163400000000            ;2**(-14)
R0:	206764652343            ;62.60411195
R1:	574101637670            ;-6.971684006
R2:     175423545327            ;6.730910259*(10**(-2))
Q1:	572102441002            ;-27.83972122
	PRGEND
TITLE	TANH	HYPERBOLIC TANGENT FUNCTION  
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.	JUNE 1, 1979


;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

SEARCH	FORPRM
NOSYM
ENTRY	TANH
EXTERN	TANH.
TANH=TANH.
PRGEND
TITLE	TANH.	HYPERBOLIC TANGENT FUNCTION
;		(SINGLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.	JUNE 1, 1979

;COPYRIGHT (C) 1979, 1981 BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

;TANH(X) IS CALCULATED AS FOLLOWS

;  TANH(X) = -TANH(-X).  LET F = ABS(X)
;	IF F > 9.8479016, TANH = 1.0*SIGN(X)
;	IF F > LN(3)/2 AND F <= 9.8479016, TANH = RESULT 1 =
;		SIGN(X)*(1 - 2/(EXP(2*F) + 1)))
;	IF F < 2**(-15), TANH = F*SIGN(X)

;	OTHERWISE, LET G = F**2, AND OBTAIN RESULT 2 AS
;		TANH = SIGN(X)*(F + F*R(G)), WHERE
;		R(G) = G*(A + B*G)/(C + G).  A, B, AND C APPEAR BELOW

;THE RANGE OF DEFINITION FOR TANH IS THE REPRESENTABLE REAL NUMBERS

;REQUIRED (CALLED) ROUTINES:  EXP

;REGISTER T2 WAS SAVED, USED, AND RESTORED

;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:

;  XMOVEI	L,ARG
;  PUSHJ	P,TANH

;THE ANSWER IS RETURNED IN ACCUMULATOR T0

	SEARCH	FORPRM
	TWOSEG	400000
	SALL

	HELLO	(TANH,.)	;ENTRY TO TANH ROUTINE
	MOVM	T0,@(L)		;ABS(X) = F
	CAMLE	T0,AMAX		;IF F > 9.84...,
	  JRST	CAREA		;GO TO COMPLETION AREA
	CAMGE	T0,A215		;IF F < 2**(-15),
	  JRST	COMP1		;GO TO COMPLETION AREA
	PUSH	P,T2		;SAVE A REGISTER.
	MOVE	T1,T0		;COPY F INTO T1
	MOVE	T2,T0		;  AND T2.
	CAMLE	T2,ALN3		;IF F > (LN 3)/2,
	  JRST	RES1		;GO TO OBTAIN RESULT 1
;				 OBTAIN RESULT 2
	FMPR	T1,T1		;R(G) CALCULATION.  F*F = G
	MOVE	T0,T1
	FMPR	T0,B		;*B
	FADR	T0,A		;+A
	FMPR	T0,T1		;*G = G*(A + B*G)
	FADR	T1,C		
	FDVR	T0,T1		;R(G) = G*(A + B*G) / (C + G)
	FMPR	T0,T2		;*F
	FADR	T0,T2		;F + F*R(G) IS IN T0
	JRST	COMPL		;GO TO COMPLETION AREA
;				 COMPUTE RESULT 1
RES1:	FSC	T1,1		;2*F
	MOVEM	T1,TEMP
	FUNCT	EXP.,<TEMP>	;EXP(2*F)
	FADRI	T0,201400	;+1.0
	MOVSI	T1,575400	;OBTAIN -2.0
	FDVR	T1,T0		;/EXP(2*F)+1)
	FADRI	T1,201400	;+1. RESULT 1 COMPLETE
	MOVE	T0,T1		;PUT IT IN T0

COMPL:	POP	P,T2		;RESTORE ACCUMULATORS
COMP1:	SKIPGE	@(L)		;CHANGE TANH SIGN IF NECESSARY
	  MOVN	T0,T0
	GOODBY	(1)		;TANH RETURN

CAREA:	MOVSI	T0,201400	;RESULT = 1.0 IS IN T0
	JRST	COMP1

AMAX:	204473104012		;9.8479016
A215:	162400000000		;2**(-15)
ALN3:	200431175237		;0.549306145
A:	577132164714		;-0.823772813
B:	607011671163		;-0.383101067E-2
C:	202474250317		;2.47131965

	RELOC			;DATA
TEMP:	0			;TEMPORARY STORAGE FOR EXP ARG
	RELOC
	PRGEND
TITLE	FLOAT	INTEGER TO REAL CONVERSION
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	FLOAT
FLOAT=FLOAT.##
PRGEND
TITLE	FLOAT.	INTEGER TO REAL CONVERSION
SUBTTL	D. TODD /DRT 15-FEB-1973

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

	SEARCH	FORPRM
	TWOSEG	400000
	NOSYM
	SALL

	HELLO	(FLOAT,.)	;ENTRY TO FLOAT ROUTINE
	MOVE	T0,@(L)		;GET THE ARGUMENT
	PJRST	FLT.0##		;USE FLT.0 ROUTINE
	PRGEND
TITLE	IFIX	REAL TO INTEGER CONVERSION
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	IFIX
IFIX=IFIX.##
PRGEND
TITLE	INT	REAL TO INTEGER CONVERSION
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	INT
INT=INT.##
PRGEND
TITLE	IFIX.	REAL TO INTEGER CONVERSION
SUBTTL	D. TODD /DRT/ED YOURDON/KK/TWE/DMN Feb-1973

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

	SEARCH	FORPRM
	TWOSEG	400000
	NOSYM
	SALL

	HELLO	(INT,.)		;ENTRY TO INT ROUTINE.
	JRST	IFIX1		;GO TO MAIN ROUTINE.

	HELLO	(IFIX,.)	;ENTRY TO IFIX ROUTINE
IFIX1:	MOVE	T0,@(L)		;GET THE ARGUMENT
	PJRST	IFX.0##		;USE IFX.0
	PRGEND
	TITLE	IFX.0
	ENTRY	IFX.0
	TWOSEG	400000
	NOSYM
IFX.0:	FIX	0,0
	POPJ	17,
	PRGEND
	TITLE	IFX.1
	ENTRY	IFX.1
	TWOSEG	400000
	NOSYM
IFX.1:	FIX	1,1
	POPJ	17,
	PRGEND
	TITLE	IFX.2
	ENTRY	IFX.2
	TWOSEG	400000
	NOSYM
IFX.2:	FIX	2,2
	POPJ	17,
	PRGEND
	TITLE	IFX.3
	ENTRY	IFX.3
	TWOSEG	400000
	NOSYM
IFX.3:	FIX	3,3
	POPJ	17,
	PRGEND
	TITLE	IFX.4
	ENTRY	IFX.4
	TWOSEG	400000
	NOSYM
IFX.4:	FIX	4,4
	POPJ	17,
	PRGEND
	TITLE	IFX.5
	ENTRY	IFX.5
	TWOSEG	400000
	NOSYM
IFX.5:	FIX	5,5
	POPJ	17,
	PRGEND
	TITLE	IFX.6
	ENTRY	IFX.6
	TWOSEG	400000
	NOSYM
IFX.6:	FIX	6,6
	POPJ	17,
	PRGEND
	TITLE	IFX.7
	ENTRY	IFX.7
	TWOSEG	400000
	NOSYM
IFX.7:	FIX	7,7
	POPJ	17,
	PRGEND
	TITLE	IFX.10
	ENTRY	IFX.10
	TWOSEG	400000
	NOSYM
IFX.10:	FIX	10,10
	POPJ	17,
	PRGEND
	TITLE	IFX.11
	ENTRY	IFX.11
	TWOSEG	400000
	NOSYM
IFX.11:	FIX	11,11
	POPJ	17,
	PRGEND
	TITLE	IFX.12
	ENTRY	IFX.12
	TWOSEG	400000
	NOSYM
IFX.12:	FIX	12,12
	POPJ	17,
	PRGEND
	TITLE	IFX.13
	ENTRY	IFX.13
	TWOSEG	400000
	NOSYM
IFX.13:	FIX	13,13
	POPJ	17,
	PRGEND
	TITLE	IFX.14
	ENTRY	IFX.14
	TWOSEG	400000
	NOSYM
IFX.14:	FIX	14,14
	POPJ	17,
	PRGEND
	TITLE	IFX.15
	ENTRY	IFX.15
	TWOSEG	400000
	NOSYM
IFX.15:	FIX	15,15
	POPJ	17,
	PRGEND
	TITLE	FLT.0
	ENTRY	FLT.0
	TWOSEG	400000
	NOSYM
FLT.0:	FLTR	0,0
	POPJ	17,
	PRGEND
	TITLE	FLT.1
	ENTRY	FLT.1
	TWOSEG	400000
	NOSYM
FLT.1:	FLTR	1,1
	POPJ	17,
	PRGEND
	TITLE	FLT.2
	ENTRY	FLT.2
	TWOSEG	400000
	NOSYM
FLT.2:	FLTR	2,2
	POPJ	17,
	PRGEND
	TITLE	FLT.3
	ENTRY	FLT.3
	TWOSEG	400000
	NOSYM
FLT.3:	FLTR	3,3
	POPJ	17,
	PRGEND
	TITLE	FLT.4
	ENTRY	FLT.4
	TWOSEG	400000
	NOSYM
FLT.4:	FLTR	4,4
	POPJ	17,
	PRGEND
	TITLE	FLT.5
	ENTRY	FLT.5
	TWOSEG	400000
	NOSYM
FLT.5:	FLTR	5,5
	POPJ	17,
	PRGEND
	TITLE	FLT.6
	ENTRY	FLT.6
	TWOSEG	400000
	NOSYM
FLT.6:	FLTR	6,6
	POPJ	17,
	PRGEND
	TITLE	FLT.7
	ENTRY	FLT.7
	TWOSEG	400000
	NOSYM
FLT.7:	FLTR	7,7
	POPJ	17,
	PRGEND
	TITLE	FLT.10
	ENTRY	FLT.10
	TWOSEG	400000
	NOSYM
FLT.10:	FLTR	10,10
	POPJ	17,
	PRGEND
	TITLE	FLT.11
	ENTRY	FLT.11
	TWOSEG	400000
	NOSYM
FLT.11:	FLTR	11,11
	POPJ	17,
	PRGEND
	TITLE	FLT.12
	ENTRY	FLT.12
	TWOSEG	400000
	NOSYM
FLT.12:	FLTR	12,12
	POPJ	17,
	PRGEND
	TITLE	FLT.13
	ENTRY	FLT.13
	TWOSEG	400000
	NOSYM
FLT.13:	FLTR	13,13
	POPJ	17,
	PRGEND
	TITLE	FLT.14
	ENTRY	FLT.14
	TWOSEG	400000
	NOSYM
FLT.14:	FLTR	14,14
	POPJ	17,
	PRGEND
	TITLE	FLT.15
	ENTRY	FLT.15
	TWOSEG	400000
	NOSYM
FLT.15:	FLTR	15,15
	POPJ	17,
	PRGEND
TITLE	ABS	SINGLE PRECISION ABSOLUTE VALUE FUNCTION
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	ABS
ABS=ABS.##
PRGEND
TITLE	IABS	SINGLE PRECISION ABSOLUTE VALUE FUNCTION
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	IABS
IABS=IABS.##
PRGEND
TITLE	ABS.	SINGLE PRECISION ABSOLUTE VALUE FUNCTION
SUBTTL	D. TODD /DRT/ED YOURDON/KK/TWE	15-Feb-1973

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


	SEARCH	FORPRM
	TWOSEG	400000
	NOSYM
	SALL

	HELLO	(ABS,.)		;ENTRY TO ABS ROUTINE
	MOVM	T0,@(L)		;GET /ARG/.
	GOODBY	(1)		;RETURN

	HELLO	(IABS,.)	;ENTRY TO IABS ROUTINE.
	MOVM	T0,@(L)		;GET /ARG/.  IF OVERFLOW, SET ANSWER TO +INF
	JOV	[HRLOI T0,377777
		 GOODBY (1)]
	GOODBY	(1)		;RETURN

	PRGEND
TITLE	DIM	SINGLE PRECISION POSITIVE DIFFERENCE FUNCTION
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	DIM
DIM=DIM.##
PRGEND
TITLE	DIM.	SINGLE PRECISION DIFFERENCE FUNCTION
SUBTTL	D. TODD /DRT/ED YOURDON/TWE	15-Feb-1973

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

	SEARCH	FORPRM
	TWOSEG	400000
	NOSYM
	SALL

	HELLO	(DIM,.)		;ENTRY TO DIM ROUTINE
	MOVE	T0,@0(L)	;PICK UP FIRST ARGUMENT
	CAMG	T0,@1(L)	;IF A .GT. B, GO TO SUBTRACT.
	TDZA	T0,T0		;O'E, ZERO A AND GO TO EXIT.
	FSBR	T0,@1(L)	;CALC A - B.
	GOODBY	(2)		;RETURN

	PRGEND
TITLE	IDIM	INTEGER POSITIVE DIFFERENCE FUNCTION
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	IDIM
IDIM=IDIM.##
PRGEND
TITLE	IDIM.	INTEGER POSITIVE DIFFERENCE FUNCTION
SUBTTL	D. TODD /DRT/ED YOURDON/KK/TWE	15-Feb-1973

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


;IDIM RETURNS THE POSITIVE DIFFERENCE OF A AND B:
;IF (A-B) .LE. 0, THEN DIM(A,B)=0
;IF(A-B) .G. 0 , THEN DIM(A,B)=(A-B)

	SEARCH	FORPRM
	TWOSEG	400000
	NOSYM
	SALL

	HELLO	(IDIM,.)	;ENTRY TO IDIM ROUTINE
	MOVE	T0, @(L)	;PICK UP FIRST ARGUMENT
	CAMG	T0,@1(L)	;IF A .LE. B,
	TDZA	T0,T0		;SET ANSWER TO 0
	SUB	T0,@1(L)	;IF A .GT. B,
	JOV	[HRLOI T0,377777 ;ANS = A - B,
		GOODBY (2)]	;+ OVERFLOW MAY OCCUR.
	GOODBY	(2)		;RETURN

	PRGEND
TITLE	SIGN	SINGLE PREICISION XFER OF SIGN FUNCTION
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	SIGN
SIGN=SIGN.##
PRGEND
TITLE	ISIGN	SINGLE PREICISION XFER OF SIGN FUNCTION
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	ISIGN
ISIGN=ISIGN.##
PRGEND
TITLE	SIGN.	SINGLE PRECISION AND INTEGER XFER OF SIGN FUNCTION
SUBTTL	D. TODD /DRT/ED YOURDON/KK/TWE	12-Feb-1973

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


;FROM	LIB40	V.32(323)

;SIGN(A,B) AND ISIGN(A,B)
;IF B .GE. 0, THEN ABSF(A) IS RETURNED IN ACCUMULATOR 0
;IF B .L. 0, THEN -ABSF(A) IS RETURNED IN ACCUMULATOR 0

	SEARCH	FORPRM
	TWOSEG	400000
	NOSYM
	SALL

	HELLO	(SIGN,.)	;ENTRY TO SIGN
	MOVM	T0,@(L)		;GET MAGNITUDE OF FIRST ARGUMENT
	SKIPGE	@1(L)		;IS SECOND ARGUMENT POSITIVE?
	MOVN	T0,T0		;NO, NEGATE RESULT
	GOODBY	(2)		;RETURN

	HELLO	(ISIGN,.)	;ENTRY TO ISIGN
	MOVM	T0,@(L)		;GET MAGNITUDE OF FIRST ARGUMENT
	SKIPGE	@1(L)		;IS SECOND ARGUMENT POSITIVE?
	MOVN	T0,T0		;NO, NEGATE RESULT
				;(ON OVERFLOW, T0 IS CORRECT)
	GOODBY	(2)		;RETURN

	PRGEND
TITLE	AINT	FLOATING POINT TRUNCATION FUNCTION
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	AINT
AINT=AINT.##
PRGEND
TITLE	AINT.	FLOATING POINT TRUNCATION FUNCTION
SUBTTL	ED YOURDON /KK/TWE	15-FEB-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


;FROM 	LIB40	V.32(323)

;FLOATING POINT TRUNCATION FUNCTION.
;TRUNCATES FRACTIONAL PART OF FLOATING POINT NUMBER
;AND RETURNS ANSWER AS A FLOATING POINT NUMBER.
;THE ANSWER IS RETURNED IN AC 0.

	SEARCH	FORPRM
	TWOSEG	400000
	NOSYM
	SALL

	HELLO	(AINT,.)	;ENTRY TO AINT ROUTINE.
	MOVM	T0,@(L)		;GET ABS(ARG)
	CAML	T0,MOD1		;IS ABS(ARG) .LT. 2**26?
	  JRST	AINT1		;NO, NO FRACTION BITS, EXIT.
	FAD	T0,MOD1		;YES, REMOVE
	FSB	T0,MOD1		;THE FRACTION BITS.
AINT1:	SKIPGE	@(L)		;SET THE
	  MOVN	T0,T0		;CORRECT SIGN AND
	GOODBY	(1)		;RETURN

MOD1:	233400000000		;2**26

	PRGEND
TITLE	MOD	INTEGER MOD FUNCTION
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	MOD
MOD=MOD.##
PRGEND
TITLE	MOD.	INTEGER MOD FUNCTION
SUBTTL	D. TODD /DRT/ED YOURDON/KK 15-Feb-1973

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


;FROM	LIB40	V.32(323)

;INTEGER MOD FUNCTION
;MOD(A,B) = A-[A/B]*B, WHERE [A/B] IS THE GREATEST (IN
;MAGNITUDE) INTEGER IN A/B.  THAT IS, THE MOD FUNCTION 
;RETURNS THE REMAINDER OF THE QUOTIENT OF A AND B.  HENCE,
;9 MOD 2 IS 1, AND SO FORTH.

	SEARCH	FORPRM
	TWOSEG	400000
	NOSYM
	SALL

	HELLO	(MOD,.)		;ENTRY TO MOD ROUTINE
	MOVE	T0,@(L)		;FIRST ARG TO AC 0.
	IDIV	T0,@1(L)	;DIVIDE, REMAINDER IN AC 1.
	MOVE	T0,T1		;PUT THE ANSWER IN AC 0.
	GOODBY	(2)		;RETURN

	PRGEND
TITLE	AMAX1	MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	AMAX1
AMAX1=AMAX1.##
PRGEND
TITLE	MAX1	MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	MAX1
MAX1=MAX1.##
PRGEND
TITLE	AMAX0	MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	AMAX0
AMAX0=AMAX0.##
PRGEND
TITLE	MAX0	MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	MAX0
MAX0=MAX0.##
PRGEND
TITLE	MAX.	MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL	D. TODD /DRT/HPW	11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

;FROM LIB40 V.005.
;AMAX1, MAX1, AMAX0, AND MAX0 CALCULATE THE MAXIMUM OF A
;STRING OF ARGUMENTS

	SEARCH	FORPRM
	TWOSEG	400000
	NOSYM
	SALL

	HELLO	(AMAX1,.)	;ENTRY TO AMAX1 ROUTINE.
	PUSHJ	P,MAX.		;FIND THE MAXIMUM AND
	GOODBY	(2)		;AMAX1 RETURN

	HELLO	(MAX0,.)	;ENTRY TO MAX0 ROUTINE.
	PUSHJ	P,MAX.		;FIND THE MAXIMUM AND
	GOODBY	(2)		;MAX0 RETURN

	HELLO	(MAX1,.)	;ENTRY TO MAX1 ROUTINE.
	PUSHJ	P,MAX.		;FIND THE MAXIMUM AND
	FIX	T0,T0		;FIX IT
	GOODBY	(2)		;MAX1 RETURN

	HELLO	(AMAX0,.)	;ENTRY TO AMAX0 ROUTINE.
	PUSHJ	P,MAX.		;FIND THE MAXIMUM AND
	FLTR	T0,T0		;FLOAT IT
	GOODBY	(2)		;AMAX0 RETURN

MAX.:	PUSH	P,T3		;Save an ac
	HLLZ	T3,-1(L)	;Get the F10 arg count
	JRST	MAX.2		;DON'T COMPARE FIRST TIME
MAX.1:	CAMGE	T0,@(L)		;IS CURRENT ARG .GT. NEXT ARG?
MAX.2:	MOVE	T0,@(L)		;NO, PUT ARG IN A.
	ADDI	L,1		;Bump arg pointer
	AOBJN	T3,MAX.1	;Continue thru the arg list
	POP	P,T3		;Restore ac
	POPJ	P,		;RETURN
	PRGEND
TITLE	AMIN1	MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	AMIN1
AMIN1=AMIN1.##
PRGEND
TITLE	MIN1	MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	MIN1
MIN1=MIN1.##
PRGEND
TITLE	AMIN0	MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	AMIN0
AMIN0=AMIN0.##
PRGEND
TITLE	MIN0	MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL	H. P. WEISS/HPW		11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

NOSYM
ENTRY	MIN0
MIN0=MIN0.##
PRGEND
TITLE	MIN.	MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL	D. TODD /DRT/HPW	11-DEC-73

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

;FROM LIB40 V.005.
;AMIN1, MIN1, AMIN0, AND MIN0 CALCULATE THE MINIMUM OF A
;STRING OF ARGUMENTS

	SEARCH	FORPRM
	TWOSEG	400000
	NOSYM
	SALL

	HELLO	(AMIN1,.)	;ENTRY TO AMIN1 ROUTINE.
	PUSHJ	P,MIN.		;FIND THE MINIMUM AND
	GOODBY	(2)		;AMIN1 RETURN

	HELLO	(MIN0,.)	;ENTRY TO MIN0 ROUTINE.
	PUSHJ	P,MIN.		;FIND THE MINIMUM AND
	GOODBY	(2)		;MIN0 RETURN

	HELLO	(MIN1,.)	;ENTRY TO MIN1 ROUTINE.
	PUSHJ	P,MIN.		;FIND THE MINIMUM AND
	FIX	T0,T0		;FIX IT
	GOODBY	(2)		;MIN1 RETURN

	HELLO	(AMIN0,.)	;ENTRY TO AMIN0 ROUTINE.
	PUSHJ	P,MIN.		;FIND THE MINIMUM AND
	FLTR	T0,T0		;FLOAT IT
	GOODBY	(2)		;AMIN0 RETURN

MIN.:	PUSH	P,T3		;Save an ac
	HLLZ	T3,-1(L)	;Get the F10 arg count
	JRST	MIN.2		;DON'T COMPARE FIRST TIME
MIN.1:	CAMLE	T0,@(L)		;IS CURRENT ARG .LT. NEXT ARG?
MIN.2:	MOVE	T0,@(L)		;NO, PUT ARG IN A.
	ADDI	L,1		;Bump arg pointer
	AOBJN	T3,MIN.1	;Continue thru the arg list
	POP	P,T3		;Restore ac
	POPJ	P,		;EXIT.

	PRGEND
	TITLE ANINT	Floating point nearest whole number

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1981 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH	FORPRM
	TWOSEG	400000
	NOSYM
	ENTRY	ANINT
	EXTERN	ANINT.
	ANINT=ANINT.
	PRGEND

	TITLE	ANINT.	Floating point nearest whole number.
	SUBTTL	C. McCutcheon - 6/25/81

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

; Fortran Instrinsic Function to return a single precision
; nearest whole number of the single precision number passed.
; (Both the number passed and returned are floating point.)

; Number returned is:	Integer(A+.5)	if A .GE. 0
; 			Integer(A-.5)	if A .LT. 0.

	SEARCH	FORPRM
	TWOSEG	400000
	SALL

	HELLO	(ANINT,.)	;Enter routine

	MOVM	T0,@0(L)	;Get argument to truncate.
	JUMPN	T0,NZERO	;Number passed = 0?
	GOODBYE			;Yes - Return

; Now shift out the fractional part of the number.

NZERO:	TLNN	T0,200000	;Is num .LT. 1/2?
	 JRST	ZERO		;Yes, go return zero.

	FAD	T0,[200400,,0]	;Add .5 before truncation.

	HLRZ	T1,T0		;Get new exponent.
	LSH	T1,-^D9		;Put rightmost.
	CAILE	T1,233		;If no fractional part,
	 JRST	DONE		; return the number passed.
				;ANINT(232777,,777777) must fall through.

	LSH	T0,-233(T1)	;Shift into integer position.
	MOVN	T1,T1		;Negate exponent.
	LSH	T0,233(T1)	;Shift back to where found.

	SKIPGE	@0(L)		;If original number .LT. zero,
	 MOVN	T0,T0		; negate it again.

	GOODBYE			;Return

ZERO:	TDZA	T0,T0		;Set result to zero and skip
DONE:	 MOVE	T0,@0(L)	;No fractional part, return
	GOODBYE			;Return

	PRGEND
	TITLE NINT	Integer nearest whole numer of floating

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1981 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH	FORPRM
	TWOSEG	400000
	NOSYM
	ENTRY	NINT
	EXTERN	NINT.
	NINT=NINT.
	PRGEND

	TITLE	NINT.	Integer nearest whole number of floating.
	SUBTTL	C. McCutcheon - 6/25/81

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

; Fortran Instrinsic Function to return the nearest integer
; to the single precision floating point number passed.

; Number returned is:	Integer(A+.5)	if A .GE. 0
; 			Integer(A-.5)	if A .LT. 0.

	SEARCH	FORPRM
	TWOSEG	400000
	SALL

	HELLO	(NINT,.)	;Enter routine

	MOVM	T0,@0(L)	;Get argument to truncate.
	JUMPN	T0,NZERO	;If 0 was passed,
	GOODBYE			; return.

NZERO:	FAD	T0,[200400,,0]	;Add .5 before truncation.

; Now shift out the fractional part of the number.

	HLRZ	T1,T0		;Get exponent.
	LSH	T1,-^D9		;Put rightmost.
	CAILE	T1,243		;If not representable as integer,
	 JRST	DONE		; return largest integer.

	FIX	T0,T0		;Make it into an integer

	SKIPGE	@0(L)		;If original number .LT. zero,
	 MOVN	T0,T0		; negate it again.

	GOODBYE			;Return

; Number not representable as integer, return largest integer.

DONE:	LERR	(LIB,%,<NINT: result overflow>)
	HRLOI	T0,377777	;Largest positive number.
	SKIPGE	@0(L)		;If original number .LT. zero,
	 HRLZI	T0,400000	;Largest negative number.
	GOODBYE			;Return

	END