Google
 

Trailing-Edge - PDP-10 Archives - BB-D480G-SB_FORTRAN10_V11.0_short - mthgdb.mac
There are 9 other files named mthgdb.mac in the archive. Click here to see a list.

	SEARCH MTHPRM
	TV	MTHGDB	GFLOAT DOUBLE PRECISION ROUTINES ,2(4020)

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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 *****

1100	CKS	--------
	Creation.

1464	DAW	-------
	Put LERR's in new format.

1673	CDM	9-Sept-81
	Added functions (GDIM, GINT, GNINT, GPROD IGNINT).

1721	CDM	15-Sept-81
	Added fix to GDIM to prevent overflow for GDIM(-INF,+INF).

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

***** Begin Mathlib *****

3055	CKS/JLC	17-Mar-82
	Fix underflow/overflow error message in GEXP2.

3200	JLC	10-May-82
	Mathlib integration. Change all LERRs to $LCALLs. Change
	TWOSEG/RELOC to SEGMENT macros.

3201	RVM	20-May-82
	Fix problem that made an argument of plus or minus one
	to GASIN and GACOS illegal.

3206	AHM	8-Jun-82
	Remove CKS's older version  of GINT. in  favor of CDM's  newer
	version.

3215	RVM	20-Aug-82
	Change a CAIGE to a CAIG in GINT.  Numbers less than 1.00D0
	were not being set to 0.00D0.

***** Begin Version 1A *****

3233	CKS	23-Mar-83
	Rewrote GMOD to remove restrictions on the magnitudes of
	its arguments.

3243	BCM	29-Mar-83
	Get and clear PC flags with new GETFLG and RESFLG macros.  Fixes
	always clearing underflow in MTHTRP.  Only applies to JOV branches.

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

***** Begin Version 2 *****

4002	JLC	3-Aug-83
	Move GEXP. to after GTAN., which calls GEXP.
	Make 1.0 a special case for GEXP3.

4011	JLC	4-May-84
	Add code for MOD, AMOD, DMOD, and GMOD for 2nd arg=0.

4012	MRB	6-Jun-84
	Change name of routines GTODA and DTOGA to GTODA. and DTOGA.
	to allow flagger. These symbols will be defined in FORCOM.

4145	MRB	17-Aug-84
	Change GABS., GMAX1., GMIN1. & GSIGN. to <nnn.+0> to get 
	macro to generate the correct polish stuff.

4020	DCE	17-Dec-85
	The GFLOATING exponentiation routine uses an incorrect method of
	getting the exponent of the magnitude of certain intermediate 
	GFLOATING numbers. A MOVM on the first word of the double word 
	value is used followed by stripping out the exponent field. 
	This does not work for all negative GFLOATING numbers where the 
	mantissa part in the first word is all zero (the first 
	non-zero bit of the mantissa is in the second word). Due to the 
	fact that these errors occur in an intermediate calculation, 
	it is impossible to specify the class of input numbers which 
	will result in this problem.
\
	PRGEND
TITLE	GACOS	ARC SINE AND ARC COSINE FUNCTIONS
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.      JUNE 19, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GACOS
EXTERN	GACOS.
GACOS=GACOS.
PRGEND
TITLE	GASIN	ARC SINE AND ARC COSINE FUNCTIONS
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.      JUNE 19, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GASIN
EXTERN	GASIN.
GASIN=GASIN.
PRGEND
TITLE	GASIN.	ARC SINE AND ARC COSINE FUNCTIONS
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.    	JUNE 19, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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.

;DASIN(X) AND DACOS(X) ARE CALCULATED AS FOLLOWS

;  LET R(G) = (G*(RP1+G*(RP2+G*(RP3+G*(RP4+G*RP5)))))/(Q0+G*(Q1
;               +G*(Q2+G*(Q3+G*(Q4+G)))))
;      (RP1,RP2,RP3,RP4,RP5,Q0,Q1,Q2,Q3,Q4, AND Q5 ARE GIVEN BELOW)

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

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

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

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

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

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

;REQUIRED (CALLED) ROUTINES:  DSQRT

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

;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:

;  MOVEI	L,ARG
;  PUSHJ	P,GASIN
;	OR
;  PUSHJ	P,GACOS

;THE HIGH ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T0
;THE LOW ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T1

	SEARCH	MTHPRM
	SEGMENT	CODE
	SALL

	HELLO	(GACOS,.)	;ENTRY TO GACOS ROUTINE
	HRRZI	T0,2		;SET FLAG TO TWO
	MOVEM	T0,FLAG		;MOVE FLAG TO MEMORY
	JRST	GETX		;GO TO GETX
	
	HELLO	(GASIN,.)	;ENTRY TO GASIN ROUTINE
	SETZM	FLAG		;SET FLAG TO ZEROES
GETX:	DMOVE	T0,@(L)		;OBTAIN X
	JUMPGE	T0,XPOS		;IF X IS NEGATIVE
	  DMOVN	T0,T0		;Y = -X
XPOS:	CAMGE	T0,HALF		;IF Y IS .LT. 1/2
	  JRST	LE		;GO TO LE
	CAME	T0,HALF		;IF Y IS .GT. 1/2
	  JRST	GT		;GO TO GT
	JUMPE	T1,LE		;
GT:	CAMLE	T0,ONE		;IF Y IS .GT. ONE
	  JRST	MSTK		;GO TO MSTK
	CAME	T0,ONE		;IF Y IS .LT. ONE
	  JRST	ALG		;GO TO ALG
	JUMPE	T1,ALG		;[3201] CHECK SECOND WORD
MSTK:	$LCALL	AOI
;LERR	(LIB,%,<DASIN or DACOS: ABS(arg) .GT. 1.0; result = +infinity>)
	HRLOI	T0,377777	;RESULT = 
	SETO	T1,		;+MACHINE INFINITY
	GOODBY	(1)		;RETURN

ALG:	PUSH	P,T2		;SAVE ACCUMULATORS
	PUSH	P,T3
	PUSH	P,T4
	PUSH	P,T5
	MOVN	T5,FLAG		;GET A COPY OF - FLAG
	HRRZI	T4,2		;SET T4 TO 2
	ADD	T5,T4		;I = 2-FLAG
	HRLZI	T2,200140	;SET T2,T3 TO
	SETZ	T3,		;ONE
	GFSB	T2,T0		;G = 1-Y
	EXTEND	T2,[GFSC -1]	;* 1/2
	DMOVEM	T2,TEMP		;SAVE A COPY OF G
	FUNCT	GSQRT.,<TEMP>	;Y = GSQRT(G)
	EXTEND	T0,[GFSC 1]	;* 2
	DMOVN	T0,T0		;Y = -Y
	MOVEM	T5,I		;MOVE I TO MEMORY
	JRST	GOTY		;GO TO GOTY
LE:	PUSH	P,T2		;SAVE ACCUMULATORS
	PUSH	P,T3
	PUSH	P,T4
	PUSH	P,T5
	MOVE	T5,FLAG		;I = FLAG
	MOVEM	T5,I		;MOVE I TO MEMORY
	CAMGE	T0,TWOM30	;IF Y < TWOM30
	JRST	GOTRES		;GO TO GOTRES
	DMOVE	T2,T0		;SAVE A COPY OF Y
	GFMP	T2,T2		;G = Y*Y
GOTY:	DMOVE	T4,T2		;SAVE A COPY OF G
	GFAD	T4,Q4		;XDEN = G + Q4
	GFMP	T4,T2		;*G
	GFAD	T4,Q3		;+Q3
	GFMP	T4,T2		;*G
	GFAD	T4,Q2		;+Q2
	GFMP	T4,T2		;*G
	GFAD	T4,Q1		;+Q1
	GFMP	T4,T2		;*G
	GFAD	T4,Q0		;+Q0
	DMOVEM	T2,TEMP		;SAVE A COPY OF G
	GFMP	T2,RP5		;XNUM = G*RP5
	GFAD	T2,RP4		;+RP4
	GFMP	T2,TEMP		;*G
	GFAD	T2,RP3		;+RP3
	GFMP	T2,TEMP		;*G
	GFAD	T2,RP2		;+RP2
	GFMP	T2,TEMP		;*G
	GFAD	T2,RP1		;+RP1
	GFMP	T2,TEMP		;*G
	GFDV	T2,T4		;RESULT = XNUM/XDEN
	GFMP	T2,T0		;*Y
	JRST	GETI		;GO TO GETI
GOTRES:	DMOVE	T2,AHI		;ZERO T2
GETI:	MOVE	T5,I		;GET A COPY OF I
	SKIPE	FLAG		;IF FLAG IS .NE. 0
	  JRST	NE		;GO TO NE
	GFAD	T0,ALO(T5)
	GFAD	T0,T2
	GFAD	T0,AHI(T5)
	SKIPGE	@(L)		;IF X IS NEGATIVE
	  DMOVN	T0,T0		;RESULT = -RESULT
	POP	P,T5		;RESTORE ACCUMULATORS
	POP	P,T4
	POP	P,T3
	POP	P,T2
	GOODBY	(1)		;RETURN

NE:	SKIPGE	@(L)		;IF X IS NEGATIVE
	  JRST 	NEGX		;GO TO NEGX
	DMOVN	T0,T0		;RESULT = -RESULT
	GFAD	T0,ALO(T5)
	GFSB	T0,T2
	GFAD	T0,AHI(T5)
	POP	P,T5		;RESTORE ACCUMULATORS
	POP	P,T4
	POP	P,T3
	POP	P,T2
	GOODBY	(1)		;RETURN

NEGX:	GFAD	T0,BLO(T5)
	GFAD	T0,T2
	GFAD	T0,BHI(T5)
	POP	P,T5		;RESTORE ACCUMULATORS
	POP	P,T4
	POP	P,T3
	POP	P,T2
	GOODBY	(1)		;RETURN

RP1:    DOUBLE  577211206522,276137263562       ;-.27368494524164255994D+2      
RP2:    DOUBLE  200671152471,260255221215       ;.57208227877891731407D+2       
RP3:    DOUBLE  577130237232,262622254077       ;-.39688862997504877339D+2      
RP4:    DOUBLE  200450470273,047303444713       ;.10152522233806463645D+2       
RP5:    DOUBLE  577723321022,120636063337       ;-.69674573447350646411D+0      
Q0:     DOUBLE  576726744776,016507406363       ;-.16421096714498560795D+3      
Q1:     DOUBLE  201164111170,200753410270       ;.41714430248260412556D+3       
Q2:     DOUBLE  576620210610,035225367030       ;-.38186303361750149284D+3      
Q3:     DOUBLE  201045571744,262621615746       ;.15095270841030604719D+3       
Q4:     DOUBLE  577220264274,210147474061       ;-.23823859153670238830D+2      
AHI:	DOUBLE	0,0
A1HI:   DOUBLE  200162207732,242102643021       ;PI/2                           
BHI:    DOUBLE  200262207732,242102643021       ;PI                             
B1HI:   DOUBLE  200162207732,242102643021       ;PI/2                           
ALO:	DOUBLE	0,0				;
A1LO:	DOUBLE	170551423063,024270033407	;NEXT 59 BITS OF PI/2
BLO:	DOUBLE	170651423063,024270033407	;NEXT 59 BITS OF PI
B1LO:	DOUBLE	170551423063,024270033407	;NEXT 59 BITS OF PI/2
TWOM30:	174340000000				;HIGH ORDER PART OF 2**(-30)
ONE:	200140000000				;1.0
HALF:	200040000000				;1/2

	SEGMENT	DATA

I:	0
FLAG:	0
TEMP:	DOUBLE	0,0
	PRGEND
TITLE	GATAN2	ARC TAN FUNCTION
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL  IMSL, INC.	MAY 9, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GATAN2
EXTERN	GATN2.
GATAN2=GATN2.
PRGEND
TITLE	GATAN	ARC TAN FUNCTION
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL	Chris Smith/CKS

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GATAN
EXTERN	GATAN.
GATAN=GATAN.
PRGEND
TITLE	GATAN.	ARC TAN FUNCTION
;		(DOUBLE PRECISION FLOATING POINT)

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;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.



;DATAN(X) is computed as follows:
;
;If X < 0, compute DATAN(|X|) below, then DATAN(X) = -DATAN(-X).
;
;If X > 0, use the identity
;
;	DATAN(X) = DATAN(XHI) + DATAN(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 double precision number,
;and so Z can be calculated without loss of significance.
;
;DATAN(XHI) is found by table lookup.  It is stored as ATANHI + ATANLO to
;provide guard bits for the final addition to DATAN(Z).
;
;DATAN(Z) is evaluated by means of a polynomial approximation from Hart et al.
;(formula 4904).
;
;If X < tan(pi/32), DATAN(X) = DATAN(Z).
;If X > 1/tan(pi/32), DATAN(X) = pi/2 - DATAN(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	MTHPRM
	SEGMENT	CODE
	SALL

	T6=6			;MORE AC NAMES
	T7=7
	T8=10



	HELLO (GATAN,.)		;DATAN ENTRY

	PUSH	P,T2		;SAVE REGISTERS
	PUSH	P,T3
	PUSH	P,T4
	PUSH	P,T5
	PUSH	P,T6

	DMOVE	T0,@(L)		;GET ARGUMENT X
	MOVEM	T0,SGNFLG	;SAVE ARGUMENT SIGN FOR RESULT
	CAIGE	T0,0		;GET |X|
	  DMOVN	T0,T0

	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 HIGH WORD OF X
	LSHC	T2,^D12		;GET EXPONENT, SHIFT HIGH FRACTION BIT
				;(ALWAYS 1) INTO SIGN BIT OF T3
	ASHC	T2,3		;GET THREE FRACTION BITS, LEAVING
				;THE 1 BEHIND
	HLRZ	T2,OFFSET-20000+24(T2) ;GET OFFSET INTO XHI TABLES

	DMOVE	T3,T0		;GET A COPY OF X
	GFSB	T0,XHI(T2)	;GET X-XHI
	GFMP	T3,XHI(T2)	;    X*XHI
	GFAD	T3,ONE		;    1 + X*XHI
	GFDV	T0,T3		;    (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:	DMOVE	T3,T0		;GET |Z|
	CAIGE	T3,0
	  DMOVN	T3,T3
	CAMG	T3,EPS		;IS IT SMALL ENOUGH THAT ATAN(Z) = Z?
	  JRST	SMALLX		;YES, BE FAST, AVOID UNDERFLOW
	GFMP	T3,T3		;GET Z**2
	DMOVE	T5,P06		;GET P(Z**2)
	GFMP	T5,T3
	GFAD	T5,P05
	GFMP	T5,T3
	GFAD	T5,P04
	GFMP	T5,T3
	GFAD	T5,P03
	GFMP	T5,T3
	GFAD	T5,P02
	GFMP	T5,T3
	GFAD	T5,P01
	GFMP	T3,T5
	GFMP	T3,T0		; * Z
	GFAD	T0,T3		; + Z = ATAN(Z)

SMALLX:	GFAD	T0,ATANLO(T2)	;  + ATAN(XHI) LOW
	GFAD	T0,ATANHI(T2)	;  + ATAN(XHI) HI   = DATAN(X)
	SKIPG	SGNFLG		;ATTACH SIGN TO RESULT
	  DMOVN	T0,T0
RET:	POP	P,T6		;RETURN
	POP	P,T5
	POP	P,T4
	POP	P,T3
	POP	P,T2
	POPJ	P,

LARGEX:	DMOVE	T3,T0		;GET -1/X
	DMOVN	T0,ONE
	GFDV	T0,T3
	MOVEI	T2,PI2OFFS	;GET OFFSET OF PI/2
	JRST	CALC		;GO COMPUTE PI/2 + ATAN(-1/X)
SUBTTL DATAN2 (Y,X)


;To compute DATAN2(Y,X), let U = |Y| and V = |X|, and compute DATAN(U/V).
;Then find DATAN2(Y,X) based on the signs of Y and X as follows:
;
;	 X	 Y	 DATAN2(Y/X)
;	
;	pos	pos	  DATAN(U/V)
;	pos	neg	 -DATAN(U/V)
;	neg	pos	-(DATAN(U/V) - pi)
;	neg	neg	  DATAN(U/V) - pi
;
;The add of -pi is combined with the add of DATAN(XHI) which is the last step
;of the DATAN algorithm.
;
;The reduced argument for DATAN 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 27 significant bits
;	VLO has at most 35 significant bits
;
;and choose XHI with at most 13 significant bits.  Then VHI*XHI and VLO*XHI can
;be exactly represented as double precision numbers, and the numerator is
;
;	U - V*XHI = (U - VHI*XHI) - VLO*XHI



	HELLO (GATN2.,GATAN2)	;DATAN2 ENTRY

	PUSH	P,T2		;SAVE REGISTERS
	PUSH	P,T3
	PUSH	P,T4
	PUSH	P,T5
	PUSH	P,T6

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

	DMOVE	T3,T0		;GET |Y/X|, ATAN ARG
	CAIGE	T3,0
	  DMOVN	T3,T3
	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	[DMOVE T0,T3	;YES, DO SO
		 JRST SMALL2]
	LSHC	T2,^D12		;GET INDEX INTO OFFSET TABLES
	ASHC	T2,3
	HLRZ	T2,OFFSET-20000+24(T2) ;GET INDEX INTO XHI TABLES

	PUSH	P,T7		;SAVE MORE REGISTERS
	PUSH	P,T8

	DMOVE	T0,@0(L)	;GET |Y| = U
	CAIGE	T0,0
	  DMOVN	T0,0
	DMOVEM	T0,USAVE	;SAVE FOR LATER
	DMOVE	T3,@1(L)	;GET |X| = V
	CAIGE	T3,0
	  DMOVN	T3,T3
	MOVE	T5,T3		;GET A COPY OF V
	DMOVE	T7,T3		;GET ANOTHER
	SETZ	T6,		;GET HIGH 27 BITS OF V = VHI
	GFSB	T7,T5		;GET LOW 35 BITS OF V = VLO
	GFMP	T5,XHI(T2)	;GET V*XHI = VHI * XHI
	GFMP	T7,XHI(T2)	;	    + VLO * XHI
	GFSB	T0,T5		;GET (U - VHI*XHI)
	GFSB	T0,T7		;		   - VLO*XHI
	DMOVE	T5,USAVE	;GET U BACK
	GFMP	T5,XHI(T2)	;GET U * XHI
	GFAD	T3,T5		;GET V + U*XHI
	GFDV	T0,T3		;GET (U - V*XHI) / (V + U*XHI)

	POP	P,T8		;RESTORE REGISTERS
	POP	P,T7

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:	DMOVN	T0,@1(L)	;GET -X/Y
	GFDV	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
	 $LCALL	RUN,RET
;	  LERR	(LIB,%,<DATAN2: result underflow>,,RET)
				;IF SECOND ARG (X) POSITIVE, RESULT UNDERFLOWS
	DMOVN	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
	$LCALL	BAZ
;LERR	(LIB,%,<DATAN2: both arguments are zero, result=0.0>)
	SETZB	T0,T1		;RETURN 0
	JRST	RET

OVER:	DMOVE	T0,PI2		;OVERFLOW, RESULT IS PI/2 WITH SIGN OF FIRST ARG
YSIGN:	SKIPGE	@0(L)		;ATTACH SIGN OF FIRST ARGUMENT (Y)
	  DMOVN	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.

DEFINE OFFS (X) <
 IRP X,<XWD 2*X,X>
>

	RADIX 10
OFFSET:	OFFS	<1,1,1,2,2,3,3,4,4,4,5,5,5,6,6,7,7,7,8,8,8,9,9,9>
	OFFS	<10,10,10,10,11,11,11,12,12,12,12,12,13,13,13,13>
	OFFS	<13,13,14,14,14,14,14,14,14,14,14,14,14,14,14>
	RADIX 8

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

XHI: 	EXP    000000000000,0		; .0000000000000000000    not used
 	EXP    177565774000,0		; .1054534912109375000    X1
 	EXP    177640774000,0		; .1288757324218750000    X2
 	EXP    177647774000,0		; .1562194824218750000    
 	EXP    177661764000,0		; .1952209472656250000    
 	EXP    177677740000,0		; .2497558593750000000    
 	EXP    177747754000,0		; .3121948242187500000    
 	EXP    177761720000,0		; .3898925781250000000    
 	EXP    177777630000,0		; .4984130859375000000    
 	EXP    200051574000,0		; .6522216796875000000    
 	EXP    200067404000,0		; .8673095703125000000    
 	EXP    200145344000,0		; 1.170166015625000000    
 	EXP    200164510000,0		; 1.645019531250000000    
 	EXP    200251104000,0		; 2.570800781250000000    
 	EXP    200352700000,0		; 5.359375000000000000    X14

ATANHI:	EXP  000000000000,000000000000		; .0000000000000000000    ATAN(0)
 	EXP  177565626152,025171771712		; .1050651824695016828    ATAN(X1)
 	EXP  177640637315,230510354743		; .1281692623534198424    
 	EXP  177647527650,022607523014		; .1549669515088296697    
 	EXP  177661266130,275334150302		; .1927961221331547523    
 	EXP  177676517562,252343141216		; .2447488705187413410    
 	EXP  177746567507,360775545336		; .3026068193134274480    
 	EXP  177757453662,234657557072		; .3717628303965550499    
 	EXP  177773136266,273706162457		; .4623772720674932798    
 	EXP  200044771623,334166732152		; .5779354489017924541    
 	EXP  200055563263,207236241201		; .7144577222199199901    
 	EXP  200067214043,155315244501		; .8636495725719767220    
 	EXP  200140622720,225243500416		; 1.024591515455200379    
 	EXP  200146311711,011245646124		; 1.199822549393342833    
 	EXP  200154271467,254276104335		; 1.386328658261967262    ATAN(X14)
PI2: 	EXP  200162207732,242102643022		; 1.570796326794896620    PI/2
MPI: 	EXP  577515570045,135675134756		;-3.141592653589793241    -PI
 	EXP  577517324610,256420774615		;-3.036527471120291553    -PI + ATAN(X1)
 	EXP  577517622022,067321553615		;-3.013423391236373393    -PI + ATAN(X2)
 	EXP  577520155437,337025522117		;-2.986625702080963569    
 	EXP  577520643352,351552743372		;-2.948796531456638489    
 	EXP  577521515034,210413303027		;-2.896843783071051899    
 	EXP  577522447016,133774711512		;-2.838985834276365791    
 	EXP  577523535433,261363112666		;-2.769829823193238186    
 	EXP  577525103674,065265753224		;-2.679215381522299960    
 	EXP  577526766412,124732723411		;-2.563657204688000783    
 	EXP  577531124722,077544605217		;-2.427134931369873246    
 	EXP  577533433056,071160406077		;-2.277943081017816514    
 	EXP  577536101415,250416775165		;-2.117001138134592862    
 	EXP  577601672023,305040140060		;-1.941770104196450408    
 	EXP  577607651602,150070376271		;-1.755263995327825979    -PI + ATAN(X14)
 	EXP  577615570045,135675134756		;-1.570796326794896620    -PI/2

ATANLO:	EXP  000000000000,000000000000		; .0000000000000000000    
 	EXP  607611362655,250215702700		;-.9237013676958846587E-19
 	EXP  170143152717,266776243666		; .5964602757438210869E-19
 	EXP  170154077372,225515747423		; .7474896823762959724E-19
 	EXP  607735160270,370510376242		;-.2946026702232522009E-19
 	EXP  610004420274,014224300071		;-.2518569148307390217E-19
 	EXP  170347024456,077470314101		; .2645467902793737610E-18
 	EXP  607510312505,015573123116		;-.1883944550948088893E-18
 	EXP  170254520527,135456552170		; .1513056980995441703E-18
 	EXP  170452555761,155354735174		; .5788933265131145596E-18
 	EXP  170453236423,212017737506		; .5869551379299690115E-18
 	EXP  607321026727,320125051737		;-.6363620490158901181E-18
 	EXP  170443623615,021735205127		; .4850262996822095826E-18
 	EXP  607222115425,120272454763		;-.1242727478712024599E-17
 	EXP  607226174644,043107635453		;-.1131804334593366021E-17
 	EXP  607223046146,050560067016		;-.1217705177797396539E-17
 	EXP  170654731631,327217710762		; .2435410355594793078E-17
 	EXP  607123161307,104424247040		;-.2427449340111014898E-17
 	EXP  607106015110,124777656057		;-.3142794913755447875E-17
 	EXP  170471157106,257651240651		; .7754358478556155783E-18
 	EXP  170674303434,273125014744		; .3273311826560871401E-17
 	EXP  170570727666,236602064744		; .1542862926123315625E-17
 	EXP  170543470577,076355704763		; .9652336698973597403E-18
 	EXP  607111346356,050107456126		;-.2957154527430437100E-17
 	EXP  170577335536,232205477162		; .1719354315705933698E-17
 	EXP  607336325130,312454401102		;-.4551432698457065547E-18
 	EXP  607127601336,271623700703		;-.2181804934405659197E-17
 	EXP  607101137417,313245123351		;-.3405122121351518328E-17
 	EXP  170665676575,033607152207		; .2920436655277002656E-17
 	EXP  170554001110,376732276727		; .1192682876882768478E-17
 	EXP  170560060327,321547457416		; .1303606021001427053E-17
 	EXP  170554731631,327217710762		; .1217705177797396539E-17
 
;COEFFICIENTS OF APPROXIMATION POLYNOMIAL ATAN(X) = X*P(X**2)

P06:	EXP 177546176241,173026455171	; .074700604980000000
P05:	EXP 600221360346,262546426550	;-.090879628821850000
P04:	EXP 177570707036,320713526601	; .111110916853003200
P03:	EXP 600133333333,171014105013	;-.142857142198848259
P02:	EXP 177663146314,314620200167	; .199999999998937080
P01:	EXP 600025252525,125252526621	;-.333333333333332690
ONE:	EXP 200140000000,000000000000	; 1.00000000000000000

EPS:	EXP 174372113547	;LARGEST X WITH DATAN(X) = X (HIGH WORD)
				;(IE, ALL DOUBLE PRECISION X WITH HIGH
				; WORD OF X <= EPS HAVE DATAN(X)=X).
MINX:	EXP 177562332734	;TAN(PI/32)	  (HIGH WORD, ROUNDED DOWN)
MAXX:	EXP 200450471543	;1/TAN(PI/32)	  (HIGH WORD, ROUNDED UP)


	SEGMENT	DATA

SGNFLG:	BLOCK	1		;SIGN TO BE ATTACHED TO RESULT
USAVE:	BLOCK	2		;TEMP STORAGE FOR U 

	PRGEND
TITLE	GCOSH	HYPERBOLIC COSINE FUNCTION
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.      JUNE 7, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GCOSH
EXTERN	GCOSH.
GCOSH=GCOSH.
PRGEND
TITLE	GCOSH.	HYPERBOLIC COSINE FUNCTION
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.    	JUNE 7, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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.

;DCOSH(X) IS CALCULATED AS FOLLOWS

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

;       Y <= 709.089565, DCOSH = (EXP(Y)+EXP(-Y))/2,
;       709.089565 <= Y < 1024 * LN(2)
;               DCOSH = (V/2)*EXP(Y - LN V),
;       Y >= 1024 * LN(2), DCOSH = +MACHINE INFINITY

;THE RANGE OF DEFINITION FOR DCOSH IS ABS(X) < 1024 * LN(2) AND ERROR MESSAGES
;  WILL RESULT FOR ARGUMENTS OUT OF THAT RANGE.  DCOSH WILL BE SET
;  TO + MACHINE INFINITY.

;REQUIRED (CALLED) ROUTINES:  GEXP

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

;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:

;  MOVEI	L,ARG
;  PUSHJ	P,GCOSH

;THE HIGH ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T0
;THE LOW ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T1

	SEARCH	MTHPRM
	SEGMENT	CODE
	SALL

	HELLO	(GCOSH,.)	;ENTRY FOR GCOSH ROUTINE
	DMOVE	T0,@(L)		;OBTAIN X
	JUMPGE	T0,DCSH		;IF X IS NEGATIVE
	  DMOVN	T0,T0		;Y = -X
DCSH:	CAMGE	T0,TWENT2	;IF ABS(X) < 22, GO TO
	  JRST 	ALG2		;  FULL CALCULATION.
     	CAMG	T0,BIGX		;IF Y IS .LE. BIGX
	  JRST	EASY		;THEN GO TO EASY
	CAMGE	T0,YMAXHI	;IF HI OF Y < YMAXHI
	  JRST	GETW		;  GO TO GETW
	CAME	T0,YMAXHI	;IF HI OF Y > YMAXHI
	  JRST	MSTK		;GO TO MSTK
	CAMGE	T1,YMAXLO	;HI OF Y = YMAXHI
	  JRST	GETW		; IF LO OF Y .LE. YMAXLO, GO TO GETW
MSTK:	HRLOI	T0,377777	;SET RESULT TO
	SETO	T1,		;MACHINE INFINITY
	$LCALL	ROV
;LERR	(LIB,%,<DCOSH: result overflow>)
	GOODBY	(1)		;RETURN
GETW:	GFAD	T0,LNV		;W = Y-LNV
	DMOVEM	T0,TEMP		;MOVE W TO A TEMP REGISTER
	FUNCT	GEXP.,<TEMP>	;Z = EXP(W)
	DMOVEM	T0,TEMP		;SAVE A COPY OF Z
	GFMP	T0,CON1		;RESULT = Z*CON1
	GFAD	T0,TEMP		;+Z
	  JFCL	MSTK
	GOODBY	(1)		;RETURN
	
EASY:	DMOVEM	T0,TEMP		;MOVE Y TO TEMP
	FUNCT	GEXP.,<TEMP>	;GET ITS EXP
	EXTEND	T0,[GFSC -1]	;DIV BY 2
	GOODBY(1)		;RETURN
ALG2:	CAMG	T0,TM30		;IF ABS(X) .LT. 2**(-30) THE
	  JRST	TINY		;  RESULT IS 1.
     	PUSH	P,T2		;SAVE MORE ACCUMULATORS
	PUSH	P,T3		
	PUSH	P,T4
	PUSH	P,T5
	DMOVEM	T0,TEMP		;MOVE Y TO A TEMPORARY REGISTER
	FUNCT	GEXP.,<TEMP>	;Z = EXP(Y)
	DMOVE	T2,T0		;SAVE A COPY OF Z
	HRLZI	T4,200140	;SET T4 TO 1.0
	SETZ	T5,		;CLEAR SECOND WORD
	GFDV	T4,T2		;1/Z
	GFAD	T0,T4		;+Z
	EXTEND	T0,[GFSC -1]	;*1/2
	POP	P,T5
	POP	P,T4		;RESTORE ACCUMULATORS
	POP	P,T3
	POP	P,T2
	GOODBY	(1)		;RETURN
TINY:	HRLZI	T0,200140	;RESULT IS 1
	SETZ	T1,
	GOODBY	(1)

ONE:	200140000000				;1.0
BIGX:	201254242673				;709.089565
YMAXHI:	201254271027				;709.782712893383998706
YMAXLO:	367643475715				;
LNV:	DOUBLE	577723506750,010134300000	;-.693147180559947174D0
CON1:	DOUBLE	172041452000,000000000000	;.186417721E-14
TWENT2:	200554000000				;22
TM30:	174340000000				;2**(-30)

	SEGMENT	DATA

TEMP:	DOUBLE	0,0
	PRGEND
TITLE	GEXP2.	DOUBLE ** INTEGER EXPONENTIATION
SUBTTL	MARY PAYNE/MHP/CKS

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1983, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
	SEGMENT	CODE
	SALL

;	Mary Payne, July 30, 1982

	HELLO	(GEXP2,.)
	DMOVEM	T2,SAVE2	;Save T2-T4
	MOVEM	T4,SAVE4

	DMOVE	T0,ONE		;Floating 1 to T0-T1
	MOVM	T2,@1(L)	;|exponent| to T2
	JUMPE	T2,EXP0		;Exponent = 0 is special
	DMOVE	T3,@0(L)	;Base to T3-T4.
	JUMPN	T3,STEP1	;If base not 0 go to main flow
	JRST	BASE0		;Else to special code

LOOP:	GFMP	T3,T3		;Square current result
	  JOV	OVER2		;Over/underflow possible
STEP1:	TRNE	T2,1		;If exponent is odd
	  GFMP	T0,T3		;  update current result
	    JOV  OVER		;  Branch on over/underflow
	LSH	T2,-1		;Discard low bit of exponent
	JUMPN	T2,LOOP		;Iterate if not 0

	SKIPL	@1(L)		;If exponent > 0
	  JRST	RET		;  return
	DMOVE	T3,T0		;[3243] Copy result
	DMOVE	T0,ONE		;Get reciprocal of
	GFDV	T0,T3		;[3243] result; Underflow impossible
	  JOV	OVMSG		;  On overflow get message
	JRST	RET		;Else return

EXP0:	SKIPE	@0(L)		;Exponent 0. If base not
	  JRST	RET		;  0, result is 1. Return
	$LCALL	ZZZ		;zero**zero is indeterminate, result=zero
	SETZB	T0,T1		;Store 0
	JRST	RET

BASE0:	SKIPL	@1(L)		;If exponent > 0
	  JRST	ZERO		;  result is 0
	$LCALL	ROV		;Else overflow
	HRLOI	T0,377777	;Store +biggest
	HRLOI	T1,377777
	JRST	RET

ZERO:	SETZB	T0,T1		;Result is 0
	JRST	RET		;Return

;
;The following block of code deals with over/underflow in the
;square operation at LOOP:. Note that the "exponent" cannot be
;0 -- LOOP: is entered only if T2 is not 0. Moreover, if T2 is
;not 1 subsequent operations will aggravate the over/underflow
;condition in such a way that both the result of the iteration
;and its reciprocal will have the same exception as currently
;indicated. If, however, T2 = 1, and the square overflowed, it
;is possible that its reciprocal will be in range. We therefore
;complete the current pass through the loop, and if the LSH of T2
;makes it zero, we join the handling at OVER: for overflow/underflow
;on the MUL of T0 by T3. Note that no exception can occur on the
;MUL of T0 by a wrapped over/underflow of the square, so that the
;exception flags will still be valid after this step.
;

OVER2:	GFMP	T0,T3		;No over/underflow. Hence flags
				;  from square of T3 still valid
	LSH	T2,-1		;Discard low bit of exponent
	JUMPE	T2,OVER		;If T2 = 0, T0 has wrapped final
				;  result or its reciprocal
				;  which may be in range

				;Final product surely over/underflows.
	GETFLG	T2		;[3243] get exception flags into t2
	TLNE	T2,(PC%FUF)	;If underflow flag set, reciprocal
	  JRST	UNDER		;  overflows. Go test sign of exponent

	SKIPL	@1(L)		;For overflow, if exponent > 0
	  JRST	UNDMSG		;  final result underflows.
	JRST	OVMSGF		;Else reciprocal gives overflow

;
;The rest of the code handles over/underflow on the product of
;T0 by T3 and calculation of the reciprocal, if this is done.
;

OVER:	GETFLG	T2		;[3243] Get exception flags into t2
	TLNE	T2,(PC%FUF)	;If underflow flag set
	  JRST	UNDER		;  underflow on product
	SKIPL	@1(L)		;Else, overflow on result if
	  JRST	OVMSGF		;  exponent > 0. Get message
	DMOVE	T3,T0		;[3243] Copy result
	DMOVE	T0,ONE		;For exponent < 0, get
	GFDV	T0,T3		;[3243] reciprocal of wrapped overflow
	  JOV	RETF		;Underflow impossible; overflow
				;  compensates previous overflow
	JRST	UNDMSG		;Else, get underflow message

UNDER:	SKIPL	@1(L)		;Product underflowed. If exponent
	  JRST	UNDMSG		;  >/= 0, result underflows
				;Else reciprocal overflows

;[3243] entry point necessary because other branches join OVMSG
OVMSGF:	RESFLG	T2		;[3243] restore the flags, t2-t3 are dbl wd PC
OVMSG:	$LCALL	ROV		;Result overflow
	JUMPL	T0,NEGOV	;If result > 0
	HRLOI	T0,377777	;Store +BIGGEST
	HRLOI	T1,377777
	JRST	RET		;  and return

NEGOV:	MOVSI	T0,400000	;If result < 0, store -BIGGEST
	MOVEI	T1,1
	JRST	RET		;  and return

UNDMSG:	$LCALL	RUN		;Result underflow
	SETZ	T0,
RETF:	RESFLG	T2		;[3243] clear the PC flags
RET:	DMOVE	T2,SAVE2	;Restore T2-T4
	MOVE	T4,SAVE4
	POPJ	P,

ONE:	EXP	200140000000,0	;G-floating 1.0

	SEGMENT	DATA

SAVE2:	BLOCK	2		;Temp for T2-T3
SAVE4:	BLOCK	1		;Temp for T4

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

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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.


;GEXP3 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
; DABS(X)**Y IS CALCULATED.)
;  -1024.9375 <= FLOAT(INT((Y*LOG2(X))*16))/16 < 1023.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 GEXP3 IS GIVEN ABOVE, AND ERROR MESSAGES
;  WILL RESULT FOR ARGUMENTS OUT OF THAT RANGE

;REQUIRED (CALLED) ROUTINES:  NONE

;REGISTERS T2, T3, T4, T5, P1, P2, P3, AND P4 WERE SAVED, USED, AND RESTORED

;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:

;  MOVEI	L,ARG
;  PUSHJ	P,EXP3

;THE HIGH ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T0
;THE LOW ORDER PART OF THE ANSWER IS RETURNED IN T1

	SEARCH	MTHPRM
	SEGMENT	CODE
	SALL

	HELLO	(GEXP3,.)		;ENTRY TO GEXP3. ROUTINE
	PUSH	P,T2			;SAVE ACCUMULATORS
	PUSH	P,T3		
	DMOVE	T0,@(L)			;GET THE BASE
	CAMN	T0,[200140,,0]		;IS IT EXACTLY 1.0?
	 JUMPE	T1,POPRET		;YES. JUST RETURN EXACTLY 1.0
	DMOVE	T2,@1(L)		;GET THE EXPONENT
	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,T4			;SAVE ACCUMULATORS
	PUSH	P,T5
	PUSH	P,P1
	PUSH	P,P2
	DMOVE	T4,T2			;GET A COPY OF Y
	JUMPGE	T4,YP			;IF Y IS NEGATIVE
	  DMOVN	T4,T4			;NEGATE IT
YP:	MOVE	P2,T4			;GET HIGH ORDER OF Y
	SETZ	P1,			;SET P1 TO ZERO
	LSHC	P1,14			;GET EXPONENT OF Y
	SUBI	P1,1765			;GET SHIFTING FACTOR
	LSHC	T4,(P1)			;SHIFT OFF EXP AND PART OF INTEGER
	TLNE	T4,400000		;IF Y IS ODD
	  SETOM	IFLAG			;SET IFLAG TO ONES
	LSHC	T4,1			;SHIFT OFF LAST OF INTEGER PART
	DMOVN	T0,T0			;NEGATE X
	JUMPN	T5,MSTK			;IF LO OF Y .NE. 0, GO TO MSTK
	JUMPE	T4,YINT			;IF HI OF Y = 0, GO TO YINT
MSTK:	$LCALL	NNA
;LERR	(LIB,%,<GEXP3: negative ** non-integer; ABS(base) used instead of base>)
	JRST	CONT			;GO TO CONT

X0:	JUMPG	T2,RET1			;IF Y IS NOT GT 0
	JUMPE	T2,ZERZER		;SEPARATE OUT 0**0 CASE
	$LCALL	ZNI
;LERR	(LIB,%,<GEXP3: base is 0 and exponent is le 0; result = infinity>)
	HRLOI	T0,377777		;RESULT = INFINITY
	HRLOI	T1,377777
POPRET:	POP	P,T3			;RESTORE ACCUMULATORS
	POP	P,T2
	GOODBY	(1)			;RETURN

ZERZER:	$LCALL	ZZZ			;"0**0 undefined, result = 0"
	JRST	POPRET			;GO RETURN

XOK:	PUSH	P,T4			;SAVE ACCUMULATORS
	PUSH	P,T5
	PUSH	P,P1
	PUSH	P,P2
YINT:	JUMPN	T3,CONT			;IF LO OF Y IS NOT 0, GO TO CONT
	JUMPN	T2,YONE			;IF Y .NE. 0 GO TO YONE, OTHERWISE
	DMOVE	T0,A1			;SET RESULT TO 1.0
	JRST	RET2			;GO TO RET2
YONE:	CAMN	T2,A1			;IF Y = 1.0 
	  JRST	RET2			;GO TO RET2
CONT:	PUSH	P,P3
	PUSH	P,P4
	MOVE	T4,T0			;OBTAIN THE EXPONENT
	ASH	T4,-30			;SHIFT MANTISSA OFF
	SUBI	T4,2000			;SUBTRACT 1024 FROM EXPONENT
	AND	T0,MASK1		;EXTRACT MANTISSA
	IOR	T0,MASK2		;SET EXPONENT TO 0
					;THE FOLLOWING TESTS DETERMINE P
	MOVEI	T5,2			;NP = 1
	CAMLE	T0,A1+20		;IF F GT A1(9)
	  JRST	NXT2			;THEN GO TO NXT2
	CAME	T0,A1+20		;
	  JRST	OK1			;
	CAMLE	T1,A1+21		;
	  JRST	NXT2
OK1:	ADDI	T5,20			;
NXT2:	CAMLE	T0,A1+6(T5)
	JRST	NXT4			;
	CAME	T0,A1+6(T5)		;
	  JRST	OK2			;
	CAMLE	T1,A1+7(T5)		;
	  JRST	NXT4			;
OK2:	ADDI	T5,10			;
NXT4:	CAMLE	T0,A1+2(T5)		;
	  JRST	NXT3			;
	CAME	T0,A1+2(T5)
	JRST	OK3			;
	CAMLE	T1,A1+3(T5)		;
	  JRST	NXT3			;
OK3:	ADDI	T5,4			;
NXT3:	MOVEM	T5,PTEMP		;SAVE A COPY OF P
	DMOVE	P1,T0			;SAVE A COPY OF F
	GFAD	P1,A1(T5)		;F+A1(2*P+2)
	GFSB	T0,A1(T5)		;F-A1(2*P+2)
	SUBI	T5,2			;FORM [(2*P+2)-
	ASH	T5,-1			;2/2]
	GFSB	T0,A2(T5)		;Z=(F-A1(P+1))-A2((P+1)/2)
	GFDV	T0,P1			;/(F+A1(P+1))
	EXTEND	T0,[GFSC 1]		;
	DMOVE	P1,T0			;SAVE A COPY OF Z
	GFMP	P1,P1			;FORM Z**2
	DMOVE	P3,P1			;SAVE A COPY OF Z**2
	GFMP	P3,RP4			;R(Z)=RP4*Z**2
	GFAD	P3,RP3			;+RP3
	GFMP	P3,P1			;*Z**2
	GFAD	P3,RP2			;+RP2
	GFMP	P3,P1			;*Z**2
	GFAD	P3,RP1			;+RP1
	GFMP	P3,P1			;*Z**2
	GFMP	P3,T0			;*Z
	GFAD	P3,T0			;+Z
	GFMP	P3,C			;U2 = R(Z) * C

	ASH	T4,4			;U1 = M*16
	MOVE	T5,PTEMP		;GET A COPY OF P
	ASH	T5,-1
	SUB	T4,T5			;-P
	FLTR	T4,T4			;FLOAT IT
	SETZ	T5,			;
	EXTEND	T4,[GDBLE T4]		;
	EXTEND	T4,[GFSC -4]		;
	DMOVE	T0,T2			;SAVE A COPY OF Y
	JUMPGE	T2,YPOS			;IF Y IS NEGATIVE
	  DMOVN	T0,T0			;NEGATE IT
YPOS:	MOVE	P1,T0			;GET COPY OF HIGH ORDER OF Y
	ASH	P1,-30			;SHIFT OFF MANTISSA
	CAIGE	P1,2024			;IF THE EXPONENT IS LESS THAN 2024
	  JRST	SMALLY			;GO TO SMALLY
	CAIE	P1,2024			;IF THE EXPONENT IS > 2024
	  JRST	LARGEY			;GO TO LARGEY
	SETZ	T1,			;ZERO SECOND WORD
	  JRST SGNCHK			;GO TO SGNCHK
SMALLY:	SUBI	P1,1775			;GET SHIFTING FACTOR
	SETZ	T1,			;SET Y1 TO 0
	JUMPGE	P1,GETY1			;IF P1 IS .GE. 0
	SETZ	T0,			;THEN GO TO GETY1
	JRST	GETY2			;
GETY1:	AND	T0,MSK3(P1)			;GET Y1
	JRST	SGNCHK			;GO TO CHECK SIGN
LARGEY:	CAIL	P1,2067			;IF EXPONENT IS .GE. 2067
	  JRST	SGNCHK			;GO TO SGNCHK
	SUBI	P1,2025			;GET SHIFTING FACTOR
	AND	T1,REDMSK(P1)			;GET LOW ORDER PART OF Y1
SGNCHK:	JUMPGE	T2,GETY2			;IF Y IS NEGATIVE
	  DMOVN	T0,T0			;NEGATE Y1
GETY2:	DMOVE	P1,T2			;SAVE A COPY OF Y
	GFSB	T2,T0			;Y2 = Y-Y1
	GFMP	T2,T4			;FORM Y2*U1
	JFCL
	GFMP	P1,P3			;FORM Y*U2
	JFCL
	GFAD	T2,P1			;W = Y*U2+Y2*U1
	GFMP	T4,T0			;FORM U1*Y1
	JFCL
	DMOVE	T0,T2			;RECONSTRUCT W
	GFAD	T0,T4
	JFCL
	CAMG	T0,BIGW			;IF W IS NOT TOO BIG
	  JRST	WOK			;GO TO WOK
OVFL:	$LCALL	ROV
;LERR	(LIB,%,<GEXP3: result overflow>)
	HRLOI	T0,377777		; RESULT = INFINITY
	HRLOI	T1,377777
	JRST	RET3			;GO TO RET3
WOK:	CAML	T0,SMALLW		;IF W IS NOT TOO SMALL
	  JRST	WOK2			;THEN PROCEED
UNFL:	$LCALL	RUN
;LERR	(LIB,%,<GEXP3: result underflow>)
	SETZ	T0,			; RESULT = 0
	SETZ	T1,
	POP	P,P4			;RESTORE ACCUMULATORS
	POP	P,P3
	POP	P,P2
	POP	P,P1
	POP	P,T5
	POP	P,T4
	POP	P,T3
	POP	P,T2
	GOODBY	(1)			;RETURN
WOK2:	SKIPGE	P1,T2			;[4020] GET |W|
	DMOVN	P1,T2			;[4020] THE HARD WAY (IF NEGATIVE)
	SETZ	P2,			;ZERO P2
	MOVE	P3,P1			;
	ASH	P3,-30			;SHIFT OFF MANTISSA
	SUBI	P3,1775			;GET SHIFTING FACTOR
	JUMPGE	P3,GETW1		;IF P3 .GE. 0
					;THEN GO TO GETW1
	SETZ	P1,			;OTHERWISE, SET W1 = 0
	JRST	GETW2			;GO TO GETW2
GETW1:	CAIG	P1,MSKTOP		;[4002] BEYOND TABLE?
	AND	P1,MSK3(P3)		;GETW1
	JUMPG	T2,GETW2		;IF W IS NEGATIVE
	  DMOVN	P1,P1			;NEGATE W1
GETW2:	GFSB	T2,P1			;W2 = W-W1
	GFAD	T4,P1			;W = W1+U1*Y1
	SKIPGE	T0,T4			;[4020] SAVE A COPY OF ABS(W)
	DMOVN	T0,T4			;[4020] THE HARD WAY (IF NEGATIVE)
	MOVE	P1,T0			;
	SETZ	T1,			;ZERO T1
	ASH	P1,-30			;SHIFT OFF MANTISSA
	SUBI	P1,1775			;GET SHIFTING FACTOR
	JUMPGE	P1,GTW1			;IF P1 IS .GE. 0
					;THEN GO TO GTW1
	SETZ	T0,			;OTHERWISE, SET W1 TO 0
	JRST	GTW2			;GO TO GET W2
GTW1:	CAIG	P1,MSKTOP		;[4002] BEYOND TABLE?
	AND	T0,MSK3(P1)		;GET W1
	JUMPGE	T4,GTW2			;IF W IS NEGATIVE
	  DMOVN	T0,T0			;NEGATE W1
GTW2:	GFSB	T4,T0			;FORM W-W1
	GFAD	T2,T4			;W2 = W2+(W-W1)
	SKIPGE	T4,T2			;[4020] SAVE A COPY OF ABS(W2)
	DMOVN	T4,T2			;[4020] THE HARD WAY (IF NEGATIVE)
	MOVE	P1,T4			;
	SETZ	T5,			;ZERO	T5
	ASH	P1,-30			;SHIFT	OFF MANTISSA
	SUBI	P1,1775			;GET SHIFTING FACTOR
	JUMPGE	P1,GW			;IF P1 IS .GE. 0
					;THEN GO TO GW
	SETZ	T4,			;OTHERWISE, SET W=0
	JRST	GW2			;GO TO GW2
GW:	CAIG	P1,MSKTOP		;[4002] BEYOND TABLE?
	AND	T4,MSK3(P1)		;GET W
	JUMPGE	T2,GW2			;IF W2 IS NEGATIVE
	  DMOVN	T4,T4			;NEGATE W
GW2:	GFAD	T0,T4			;FORM W1 + W
	EXTEND T0,[GSNGL T0]		;
	FSC	T0,4			;*16
	FIX	T0,T0			;IW1
	GFSB	T2,T4			;W1 = W2 - W
	JUMPLE	T2,W2POS		;IF W2 .GT. 0
	GFSB	T2,SXTNTH		;W2 = W2-.0625
	ADDI	T0,1			;IW1 = IW1+1
W2POS:	MOVE	T5,T0			;SAVE A COPY OF IW1
	JUMPGE	T5,NPOS
	  ADDI	T5,17
NPOS:	ASH	T5,-4			;M1 = IW1/16
	JUMPL	T0,INEG			;IF IW1 .GE. 0
	ADDI	T5,1			;M1 = M1+1
INEG:	MOVE	T4,T5			;SAVE A COPY OF M1
	ASH	T4,4			;P1 = 16*M1
	SUB	T4,T0			;-IW1
	ASH	T4,1			;
	DMOVE	T0,T2			;SAVE A COPY OF W2
	GFMP	T2,Q7			;Z = Q7*W2
	GFAD	T2,Q6			;+Q6
	GFMP	T2,T0			;*W2
	GFAD	T2,Q5			;+Q5
	GFMP	T2,T0			;*W2
	GFAD	T2,Q4			;+Q4
	GFMP	T2,T0			;*W2
	GFAD	T2,Q3			;+Q3
	GFMP	T2,T0			;*W2
	GFAD	T2,Q2			;+Q2
	GFMP	T2,T0			;*W2
	GFAD	T2,Q1			;+Q1
	GFMP	T0,T2			;*W2
	GFMP	T0,A1(T4)		;*A1(P1+1)
	GFAD	T0,A1(T4)		;+A1(P1+1)
	EXTEND	T0,[GFSC (T5)]	;ADD M1 TO THE EXP OF Z
	JFCL	EXCPT
RET3:	POP	P,P4			;RESTORE ACCUMULATORS
	POP	P,P3
RET2:	SKIPE	IFLAG			;IF Y IS ODD NEGATIVE INTEGER
	  DMOVN	T0,T0			;NEGATE RESULT
	POP	P,P2
	POP	P,P1
	POP	P,T5
	POP	P,T4
RET1:	POP	P,T3
	POP	P,T2
	GOODBY	(1)			;RETURN
EXCPT:	JUMPG	T5,OVFL			;IF T5 >0 GO TO OVFL
	JRST	UNFL			;OTHERWISE, GO TO UNFL

SXTNTH:	DOUBLE	177540000000,000000000000	;.0625D0
BIGW:	201277740000				;UPPER BOUND FOR WW
SMALLW:	576440000000				;LOWER BOUND FOR W
RP1:    DOUBLE  177552525252,252525251443       ;.833333333333332114D-1
RP2:    DOUBLE  177263146314,314740401603       ;.125000000005037992D-01
RP3:    DOUBLE  177044444441,161170665342       ;.223214212859242590D-2
RP4:    DOUBLE  176570743756,332257605031       ;.434457756721631196D-3
C:      DOUBLE  200156125073,051270137606       ;1.442695040888963407D0
Q7:     DOUBLE  176076473357,034454617751       ;.149288526805956082D-4
Q6:     DOUBLE  176450275727,001604616375       ;.154002904409897646D-3
Q5:     DOUBLE  176753541760,306574663707       ;.133335413135857847D-02
Q4:     DOUBLE  177247312533,160461663013       ;.961812905951724170D-02
Q3:     DOUBLE  177470654106,270060115477       ;.555041086640855953D-1
Q2:     DOUBLE  177675376757,374054231615       ;.240226506959095371D0
Q1:     DOUBLE  200054271027,367643475706       ;.693147180559945296D0
A1:     DOUBLE  200140000000,000000000000       ;A1(I), I=1,17 =
A12:    DOUBLE  200075222575,025111033141       ;2**((1-I)/16). THIS
A13:    DOUBLE  200072540306,347672220712       ;TABLE IS SEARCHED
A14:    DOUBLE  200070146336,354125123411       ;TO DETERMINE P.
A15:    DOUBLE  200065642374,312655165530       ;
A16:    DOUBLE  200063422214,025077022007       ;
A17:    DOUBLE  200061263452,021252033327       ;
A18:    DOUBLE  200057204243,237260060666       ;
A19:    DOUBLE  200055202363,063763571444       ;
A110:   DOUBLE  200053254076,352205205126       ;
A111:   DOUBLE  200051377326,251542504707       ;
A112:   DOUBLE  200047572462,140443204215       ;
A113:   DOUBLE  200046033760,121433342514       ;
A114:   DOUBLE  200044341723,163526107032       ;
A115:   DOUBLE  200042712701,343725057267       ;
A116:   DOUBLE  200041325303,147630441731       ;
A117:   DOUBLE  200040000000,000000000000       ;
A2:	DOUBLE	170461734720,307535546011
A22:	DOUBLE	607304062611,120221564632
A23:	DOUBLE	170276106540,343712762662
A24:	DOUBLE	607625040217,333155037217
A25:	DOUBLE	170362230025,031075315002
A26:	DOUBLE	170466404421,360475356413
A27:	DOUBLE	607330176555,216025626545
A28:	DOUBLE	607323056225,270604125171
MASK1:	000077777777				;MASK FOR MANTISSA
MASK2:	200000000000				;MASK FOR EXPONENT
REDMSK:	600000000000
RDMSK2:	700000000000
RDMSK3:	740000000000
RDMSK4:	760000000000
RDMSK5:	770000000000
RDMSK6:	774000000000
RDMSK7:	776000000000
RDMSK8:	777000000000
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
MSK12:	777777740000
MSK13:	777777760000
MSK14:	777777770000
MSK15:	777777774000
MSK16:	777777776000
MSK17:	777777777000
MSK18:	777777777400
MSK19:	777777777600
MSK20:	777777777700
MSK21:	777777777740
MSK22:	777777777760
MSK23:	777777777770
MSK24:	777777777774
MSK25:	777777777776
MSK26:	777777777777
MSKTOP==MSK26-MSK3		;MAX INDEX TO USE FOR MSK3

	SEGMENT	DATA

PTEMP:	0
IFLAG:	0
	PRGEND
TITLE	GLOG10	LOG BASE 10 FUNCTION
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.      APRIL 8, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GLOG10
EXTERN	GLG10.
GLOG10=GLG10.
PRGEND
TITLE	GLOG	NATURAL LOG FUNCTION
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.	APRIL 8, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GLOG
EXTERN	GLOG.
GLOG=GLOG.
PRGEND
TITLE	GLOG.	NATURAL LOG FUNCTION
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.	APRIL 8, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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.


;DLOG10(X) AND DLOG(X) ARE CALCULATED AS FOLLOWS

;	FOR X = 0 AN ERROR MESSAGE IS ISSUED AND -MACHINE INFINITY
;	IS RETURNED AS THE RESULT. 
;	FOR X < 0 AN ERROR MESSAGE IS ISSUED, X IS SET T0 -X AND 
;	CALCULATION CONTINUES.
;	FOR X > 0, X = F*2**F(M), 1/2 < F < 1
;	DEFINE G AND N SO THAT F = G*2(-N), 1/SQRT(2) <= G < SQRT(2).
;	NOW
;		DLOG(X) = (K*M-N) * DLOG(2) + DLOG(G)
;	AND
;		DLOG10(X) = DLOG10(E) * DLOG(X) = DLOG(X)/DLOG(10)
;
;	DLOG(G) IS EVALUATED BY DEFINING S = (G-1)/(G+1) AND Z = 2*S
;	AND THEN CALCULATING DLOG(G) = DLOG((1+Z/2)/(1-Z/2)) USING
;	A MINIMAX RATIONAL APPROXIMATION.

;THE RANGE OF DEFINITION FOR DLOG/DLOG10 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:

;  MOVEI	L,ARG
;  PUSHJ	P,GLOG  
;	OR
;  PUSHJ	P,GLOG10

;THE HIGH ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T0.
;THE LOW ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T1.

	SEARCH	MTHPRM
	SEGMENT	CODE
	SALL

	HELLO	(GLG10.,GLOG10)	;ENTRY TO LOG BASE 10 ROUTINE.
	SETZM	FLAG		;CLEAR FLAG FOR DLOG10 ENTRY
	JRST 	ALG		;GO TO ALGORITHM

	HELLO	(GLOG,.)	;ENTRY TO NATURAL LOG ROUTINE
	SETOM	FLAG		;SET FLAG FOR DLOG ENTRY
ALG:	DMOVE	T0,@(L)		;GET ARG
	JUMPG	T0,STRT		;IF ARG > ZERO GO TO STRT
	JUMPN	T0,ARGN		;OTHERWISE, IF ARG .NE. 0 GO TO ARGN
	$LCALL	AZM
;LERR	(LIB,%,<DLOG or DLOG10: zero arg; result = -infinity>)
	HRLZI	T0,400000	;SET RESULT TO
	HRRZI	T1,000001	;LARGE NEGATIVE NUMBER
	GOODBY	(1)
ARGN:	$LCALL	NAA
;LERR	(LIB,%,<DLOG or DLOG10: negative arg; result = LOG(ABS(arg))>)
	DMOVN	T0,T0		;ARG = -ARG

STRT:	PUSH	P,T2		;SAVE ACCUMULATORS
	PUSH	P,T3
	PUSH	P,T4
	PUSH	P,T5
	HLRZ	T2,T0		;LEFT OF T0 TO RIGHT OF T2
	LSH	T2,-6		;ISOLATE EXPONENT
	SUBI	T2,2000		;SUBTRACT 1024 FROM THE EXP
	DMOVE	T4,T0		;GET COPY OF ARG
	AND	T4,MASK1	;EXTRACT MANTISSA
	IOR	T4,MASK2	;SET EXP TO 0
	CAMLE	T4,HI		;IS HIGH PART OF F > SQRT(.5)
	  JRST	FGT		;YES, GO TO FGT
	CAME	T4,HI		;NO, IS F = HIGH OF SQRT(.5)
	  JRST 	FLT		;NO, GO TO FLT
	CAMLE	T5,LOW		;YES, IS LOW PART > LOW PART OF SQRT(.5)
	  JRST 	FGT		;YES, GO TO FGT
FLT:	SUBI	T2,1		;N = N-1
	EXTEND	T2,[GFLTR T2]
	MOVEM	T2,N		; SAVE N
	GFAD	T4,MHALF	;ZNUM = F-.5
	DMOVE 	T2,T4		;GET COPY OF ZNUM
	EXTEND	T4,[GFSC -1]	;ZDEN = ZNUM * .5
	GFAD	T4,HALF		; + .5
	JRST	EVALRZ
FGT:	EXTEND	T2,[GFLTR T2]
	MOVEM	T2,N		; SAVE N
	DMOVE	T2,T4
	GFAD	T2,B3		;ZNUM = F - 1.0
	EXTEND	T4,[GFSC -1]	;ZDEN = F*.5
	GFAD	T4,HALF		; + .5
EVALRZ:	GFDV	T2,T4		;Z = ZNUM/ZDEN
	DMOVE 	T4,T2		;
	GFMP	T4,T4		;W = Z*Z
	DMOVE	T0,T4		;SAVE COPY OF W
	GFAD	T4,B2		; FORM B(W). B(W) = W + B2
	GFMP	T4,T0		; * W
	GFAD	T4,B1		; + B1
	GFMP	T4,T0		; * W
	GFAD	T4,B0		; + B0
	DMOVEM	T0,SAVEW	; SAVE A COPY OF W
	GFMP	T0,A2		;FORM A(W). A(W)= A2*W
	GFAD	T0,A1		; + A1
	GFMP	T0,SAVEW	; * W
	GFAD	T0,A0		; + A0
	GFDV	T0,T4		;R(Z) = A(W)/B(W)
	GFMP	T0,SAVEW	; * W
	GFMP	T0,T2		; *Z
	GFAD	T0,T2		; + Z
	MOVE	T2,N		;RETRIEVE N
	MOVEI	T3,0		;ZERO OUT SECOND WORD
	GFMP	T2,C1		;FORM N*C1
	MOVE	T4,N		;RETRIEVE N
	MOVEI	T5,0		;ZERO OUT SECOND WORD
	GFMP	T4,C2		;FORM N*C2
	GFAD	T0,T4		;RESULT = N*C2 + R(Z)
	GFAD	T0,T2		; + N*C1
	SKIPN	FLAG
	  GFMP	T0,C3		;IF DLOG10 ROUTINE, RESULT = RESULT*C3
	POP	P,T5		;RESTORE ACCUMULATORS
	POP	P,T4
	POP	P,T3
	POP	P,T2
	GOODBY	(1)

C1:     DOUBLE  200054300000,000000000000       ;.693359375D0                   
C2:     DOUBLE  601310277575,034757152744       ;-2.12194440054690583D-4        
C3:     DOUBLE  177767455730,251156241615       ;.434294481903251828D0          
A0:     DOUBLE  577037740007,152304514557       ;-.641249434237455811D2         
A1:     DOUBLE  200540611121,000552775450       ;.163839435630215342D2          
A2:     DOUBLE  577715357522,145224132710       ;-.789561128874912573D0         
B0:     DOUBLE  576517720013,037446761043       ;-.769499321084948798D3         
B1:     DOUBLE  201147002037,320522317573       ;.312032220919245328D3          
B2:     DOUBLE  577134251775,244603076112       ;-.356679777390346462D2         
B3:     DOUBLE  577640000000,000000000000       ;-.1D1                          
HALF:   DOUBLE  200040000000,000000000000       ;.5D0                           
MHALF:  DOUBLE  577740000000,000000000000       ;-.5D0                          
HI:		200055202363
LOW:		063763571444
MASK1:		000077777777
MASK2:		200000000000

	SEGMENT	DATA

N:		0
FLAG:		0
SAVEW:  DOUBLE  000000000000,000000000000                                       
	PRGEND
TITLE	GMOD	DOUBLE PRECISION REMAINDER FUNCTION
SUBTTL	MARY PAYNE /MHP/CKS	25-Jan-80

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1980, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GMOD
EXTERN	GMOD.
GMOD=GMOD.
PRGEND
TITLE	GMOD.	G-FLOATING REMAINDER

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1983, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
	SEGMENT	CODE
	SALL

; This routine was rewritten during edit 3233.

; G-floating MOD routine with no limit on the magnitudes
; of the arguments. This routine calculates
;
;	|ARG1| - [|ARG1/ARG2|]*|ARG2|
;
; and returns the result with the sign of ARG1. Special code is
; provided for avoiding intermediate exceptions. The final result
; will not overflow. It may underflow, in which case a result of 0
; is returned and an error message is written.
; 
; For A and B positive floating point numbers, let A = 2^n*F and
; B = 2^m*G. We would like to compute R = A - B*int[A/B]. We introduce
; the following sequences of numbers to assist in computing R. For
; p and d positive integers, let J = 2^p*G, I = 2^p*F and define
; I(0) = I - q*J, where q = 0 if I < J and 1 otherwise. For i >= 0 let
;
;                       L(i+1) = 2^d*I(i) 
;
;               I(i+1) = L(i+1) - J*int[L(i+1)/J].
;
; Using an induction argument it is not difficult to show that
;
;            I(k) = 2^(kd)*I(0) - J*int[2^(kd)*I(0)/J].
;
; Now let 0 = < n - m = kd + r, where 0 =< r < d, then 
;
;                 R = A - B*int[A/B]
;                   = 2^n*F - 2^m*G*int[2^(n-m)*F/G]
;     ==>     2^p*R = 2^n*[I(0) + q*J] - 2^m*J*int[2^(n-m)*(I(0) + q*J)/J]
;                   = 2^n*I(0) - 2^m*J*int[2^(n-m)*I(0)]
;     ==> 2^(p-m)*R = 2^(kd+r)*I(0) - J*int[2^(kd+r)*I(0)/J]
;                   = 2^r*I(k) - J*int[2^r*I(k)/J]
;                   = L - J*int[L/J],
;
; where L = 2^r*I(k).
;
; Based on the above, we have the following algorithm for computing R:
;
;             Step 1: m <--- the exponent value of B
;                     c <--- the exponent value of A - m
;                     if c < 0, end with R = A
;             Step 2: I <--- 2^p*(fraction field of A)
;                     J <--- 2^p*(fraction field of B)
;                     If I >= J, I <--- I - J
;                     go to step 5
;             Step 3: L <--- 2^d*I         
;             Step 4: L <--- L - J*int[L/J]
;             Step 5: c <--- c - d
;             Step 6: if c > 0 go to step 3
;	      Step 7: if c = -d, exit with R = L
;             Step 8: L <--- 2^(d+c)*I = 2^r*I
;             Step 9: L <--- L - J*int[L/J]
;             Step 10: R <--- 2^(m-p)*L

	SEARCH	MTHPRM
	SEGMENT	CODE
	SALL

	T6=6			;Additional AC names
	T7=7
	T8=8

DEFINE DMOVM (AC,E) <		;Double absolute value
	DMOVE AC,E
	TLNE AC,(1B0)
	 DMOVN AC,AC
> ;DMOVM

DEFINE DCAML (AC,E) <		;Double integer compare
	CAMN	AC, E
	CAMGE	AC+1, E+1
	CAMLE	AC, E
> ;DCAML

	HELLO (GMOD,.)

	DMOVEM	T2, SAV23	;Save registers 2, 3,
	DMOVEM	T4, SAV45	;  4, 5
	DMOVEM	T6, SAV67	;  6, 7
	MOVEM	T8, SAV8	;  and 8

	DMOVM	T0, @0(L)	; T0 = |A|
	DMOVM	T4, @1(L)	; T4 = |B|
	JUMPE	T4,GMRETZ	;IF ARG2=0, GO RETURN ZERO
;
; Step 1
;
	MOVE	T6, T4		; T6 = |B|hi
	AND	T6, [777700000000]
				; T6 = Exponent field of B (including bias)
	MOVE	T7, T0		; T7 = |A|hi
	SUB	T7, T6		; High 12 bits of T7 = c
	JUMPL	T7, TSTSGN	; Done if c < 0

;
; Step 2
;
STEP2:	ASHC	T6, -30		; Get c in the low bits of T7
				;  and m+2000 in low bits of T6
	TLZ	T0, 777700	; T0 = I
	TLZ	T4, 777700	; T4 = J
	DCAML	T0, T4		; Compare I to J
	DSUB	T0, T4		; If I >= J, I <--- I - J
	JRST	STEP5
;
; Steps 3 through 6
;
STEP3:	SETZB	T2, T3		; T0/T3 = L = 2^35*I -- d = 35
	DDIV	T0, T4		; T0 = int(L/J), T2 = L - J*int(L/J)
	DMOVE	T0, T2		; T0 = L - J*int(L/J)
STEP5:	SUBI	T7, 106		; c <--- c - d
	JUMPG	T7, STEP3	; If c > 0 go to Step 3
;
; Steps 7 and 8 9: At this point c = r - d or r = c + d;
;
	SETZB	T2, T3		; T0/T3 = 2^35*I

				; Shift T0/T3 right T7 places
	CAMG	T7, [-43]	; More than 1 word to shift
	 JRST	[EXCH T1, T2	; Yes, do first 35 bits with word operations
		 EXCH T0, T1
		 MOVN T8, T7	; Get negative shift count
		 ASHC T2, 43(T7)  ; Shift T2-T3
		 ASH  T2, -43(T8) ; Reposition T2
		 ASHC T1, 43(T7)  ; Shift T1-T2
		 JRST STEP8]
	MOVN	T8, T7		; Get negative shift count
	ASHC	T1, (T7)	; Shift T1-T2
	ASH	T1, (T8)	; Reposition T1
	ASHC	T0, (T7)	; Shift T0-T1

STEP8:	DDIV	T0, T4		; T2 = 2^(p-m)*R
;
; Step 9 - Obtain R in floating point format and check for underflow
;
	DMOVE	T0, T2		; Copy fraction into T0
	EXTEND	T0, [GFSC (T6)]	; Insert biased exponent and normalize
	  JFCL	UNDER		; Can underflow

TSTSGN:	SKIPGE	@0(L)		;Remainder in T0. If A < 0
	  DMOVN	T0,T0		;  negate it
RESTOR:	DMOVE	T2,SAV23	;Restore registers 2, 3
	DMOVE	T4,SAV45	;  4, 5
	DMOVE	T6,SAV67	;  6, 7
	MOVE	T8,SAV8		;  and 8
	POPJ	P,		; Return
;
; If processing continues here, the remainder has underflowed.
;
UNDER:	$LCALL	RUN		;Result underflow
	SETZB	T0, T1		;Store 0 for result
	JRST	RESTOR		;Restore registers and return

;
;IF ARG2 IS ZERO, RETURN 0 WITH A WARNING MESSAGE
;
GMRETZ:	SETZB	T0,T1		;RETURN ZERO
	$LCALL	MZZ		;WITH MESSAGE
	JRST	RESTOR

	SEGMENT	DATA
SAV23:	BLOCK	2
SAV45:	BLOCK	2
SAV67:	BLOCK	2
SAV8:	BLOCK	1

	PRGEND
TITLE	GCOS	SINE AND COSINE FUNCTIONS
;	        (DOUBLE PRECISION FLOATING POINT)
SUBTTL  IMSL, INC.	MAY 1, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GCOS
EXTERN	GCOS.
GCOS=GCOS.
PRGEND
TITLE	GSIN	SINE AND COSINE FUNCTIONS
;	        (DOUBLE PRECISION FLOATING POINT)
SUBTTL  IMSL, INC.	MAY 1, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GSIN
EXTERN	GSIN.
GSIN=GSIN.
PRGEND
TITLE	GSIN.	SINE AND COSINE FUNCTIONS
;	        (DOUBLE PRECISION FLOATING POINT)
SUBTTL  IMSL, INC.	MAY 1, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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:
;       LET X1 = ABS(X)
;	N = THE NEAREST INTEGER TO ABS(X), FOR SIN, OR
;				TO ABS(X) + PI/2, FOR COS
;       THEN XN = [N/PI], THE GREATEST INTEGER IN N/PI.

;       THEN THE REDUCED ARGUMENT F = (((X1 - XN*C1) -XN*C2) -XN*C3)
;               WHERE C1+C2+C3 = PI TO EXTRA PRECISION AND ARE GIVEN BELOW.

;	LET G = F**2
;		THEN R(G) = (G*XNUM/XDEN+RP1)*G 
;	WHERE XNUM = ((RP5*G+RP4)*G+RP3)*G+RP2
;	      XDEN = ((G*Q2)*G+Q1)*G+Q0
;	AND RP5,RP4,RP3,RP2,RP1,Q2,Q1, AND Q0 ARE GIVEN BELOW
;	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 FOR SIN IS ABS(X) <= 1686629713.  ABS(X)+PI/2, IN
;  COS(X), MUST BE LESS THAN 1686629713.  SIN(X) = COS(X) = 0.0 AND AN
;  ERROR MESSAGE 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:
 
;  MOVEI	L,ARG
;  PUSHJ	P,GSIN
;             OR
;  PUSHJ	P,GCOS
 
;THE HIGH ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T0.
;THE LOW ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T1.

	SEARCH	MTHPRM
	SEGMENT	CODE
	SALL

	HELLO	(GCOS,.)	;ENTRY TO COSINE ROUTINE
	DMOVE	T0,@(L)		;OBTAIN ARGUMENT
	PUSH	P,T2		;SAVE AN ACCUMULATOR
	HRLZI	T2,201400	;SET SGN TO 1.
	JUMPGE	T0,XPOS		;IF X IS NEGATIVE
	  DMOVN	T0,T0		;Y = -X
XPOS:	DMOVEM	T0,XDEN		;SAVE A COPY OF ABS(X)
	SETOM	FLAG		;SET FLAG FOR COSINE ENTRY
	GFAD	T0,PID2		;Y = Y+PID2
	JRST	ALG		;PROCEED TO MAIN ALGORITHM

	HELLO	(GSIN,.)	;ENTRY TO SIN ROUTINE
	DMOVE	T0,@(L)		;GET ARG
	PUSH	P,T2		;SAVE AN ACCUMULATOR
	HRLZI	T2,201400	;SET SIGN TO 1.0
	SETZM	FLAG		;CLEAR FLAG FOR SINE ROUTINE
	JUMPGE	T0,ALG		;IF ARG IS NEGATIVE
	DMOVN	T0,T0		;THEN, SET Y=-X AND
	HRLZI	T2,576400	;SET VALUE OF SIGN TO -1.
ALG:	MOVEM	T2,SGN		;MOVE SIGN TO MEMORY
	CAMGE	T0,YMAX1	;IF HI OF Y<HI OF YMAX
	  JRST YOK		;PROCEED TO YOK
	CAME	T0,YMAX1	;IF HI OF Y > HI OF YMAX
	  JRST	ERR1		;GO TO ERR1
	CAMGE	T1,YMAX2	;HI OF Y=HI OF YMAX, IS LO OF Y < LO OF YMAX?
	  JRST	YOK		;YES, PROCEED TO YOK
ERR1:	$LCALL	ATZ
;LERR	(LIB,%,<DSIN or DCOS: ABS(arg) too large; result = zero>)
	MOVEI	T0,0		;SET RESULT
	MOVEI	T1,0		;TO ZERO
	POP	P,T2		;RESTORE ACCUMULATOR
	GOODBY	(1)		;
YOK:	PUSH	P,T3		;SAVE ACCUMULATORS
	PUSH	P,T4		;
	PUSH 	P,T5
	DMOVE	T2,T0		;SAVE A COPY OF ABS(X)
	SKIPE	FLAG		;IF THIS IS THE COS ROUTINE
	  DMOVE	T2,XDEN		;RESTORE ABS(X) TO T2
	GFMP	T0,ODPI		;RN = Y/PI
	JFCL
	EXTEND	T0,[DGFIXR T0]	;FIX RN
	MOVE	T5,T1		;SAVE N
	EXTEND	T0,[DGFLTR T0]	;XN=FLOAT(N)
	TRNE	T5,1		;IS N ODD?
	  MOVNS	SGN		;YES,NEGATE SIGN
	SKIPE	FLAG		;IF THE COSINE IS WANTED
	  GFAD	T0,PT5		;THEN XN=XN-.5
	DMOVE	T4,T0		;SAVE A COPY OF XN
	GFMP	T0,C1		;FORM XN*C1
	GFSB	T2,T0		;F=ABS(X)-(XN*C1)
	DMOVE	T0,T4		;SAVE A COPY OF XN
	GFMP	T0,C3		;FORM XN*C3
	GFMP	T4,C2		;FORM XN*C2
	GFSB	T2,T4		;-XN*C2
	GFSB	T2,T0		;F=F-XN*C3
	DMOVE	T0,T2		;SAVE A COPY OF F
	JUMPGE	T2,FPOS		;IF F IS NEGATIVE
	  DMOVN	T2,T2		;F = -F
FPOS:	CAML	T2,EPS		;IF F IS .GE. EPS
	  JRST	GEEPS		;GO TO GEEPS
	SKIPGE	SGN		;IF SGN IS NEGATIVE
	  DMOVN	T0,T0		;F = -F
	POP	P,T5		;RESTORE ACCUMULATORS
	POP	P,T4
	POP	P,T3
	POP	P,T2
	GOODBY	(1)		;RETURN
GEEPS:	GFMP	T2,T2		;G = F*F
	DMOVE	T4,T2		;SAVE A COPY OF G
	GFAD	T2,Q2		;XDEN = G+Q2
	GFMP	T2,T4		;*G
	GFAD	T2,Q1		;+Q1
	GFMP	T2,T4		;*G
	GFAD	T2,Q0		;+Q0
	DMOVEM	T2,XDEN		;MOVE XDEN TO MEMORY
	DMOVE	T2,T4		;GET A COPY OF G
	GFMP	T2,RP5		;XNUM = G*RP5
	GFAD	T2,RP4		;+RP4
	GFMP	T2,T4		;*G
	GFAD	T2,RP3		;+RP3
	GFMP	T2,T4		;*G
	GFAD	T2,RP2		;+RP2
	GFMP	T2,T4		;*G
	GFDV 	T2,XDEN		;R(G) = XNUM/XDEN
	GFAD	T2,RP1		;+RP1
	GFMP	T2,T4		;*G
	GFMP	T2,T0		;*F
	GFAD	T0,T2		;+F
	SKIPGE	SGN		;IF SGN IS NEGATIVE
	  DMOVN	T0,T0		;THEN NEGATE T0
RET:	POP	P,T5		;RESTORE ACCUMULATORS
	POP	P,T4		;
	POP	P,T3
	POP	P,T2
	GOODBY	(1)

EPS:	174340000000				;2**(-30)
PID2:   DOUBLE 	200162207732,242102643022       ;PI/2
ODPI:   DOUBLE  177750574603,156234420251       ;1/PI
C1:     DOUBLE  200262207732,240000000000       ;HIGH 30 BITS OF PI
C2:     DOUBLE  174442055060,200000000000	;NEXT 28 BITS OF PI
C3:	DOUBLE	171064611431,212134015604	;C1+C2+C3=PI TO 120 BITS
Q2:     DOUBLE  201161273135,127076131616       ;0.394924723520450141 D+3
Q1:     DOUBLE  202142232235,112027153730       ;0.702492288221842518D+5
Q0:     DOUBLE  202751252025,266402115312       ;0.541748285645351853D+7
RP5:    DOUBLE  600516152672,335644427111       ;-0.121560740596710190D-1
RP4:    DOUBLE  200342202301,360464200740       ;0.428183075897778265D+01
RP3:    DOUBLE  576602640645,001056761116       ;-0.489487151969463797D+03
RP2:    DOUBLE  202054054660,302527505074       ;0.451456904704461990D+05
RP1:    DOUBLE  600125252525,125252525242       ;-.166666666666666667D0
PT5:    DOUBLE  577740000000,000000000000       ;-.5
YMAX1:	203762207732				;YMAX = 
YMAX2:	242102643021				;  (PI*2**29)

	SEGMENT	DATA

FLAG:	0
SGN:	DOUBLE	0,0
XDEN:	DOUBLE	0,0
	PRGEND
TITLE	GSINH	HYPERBOLIC SINE FUNCTION
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.      JUNE 7, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GSINH
EXTERN	GSINH.
GSINH=GSINH.
PRGEND
TITLE	GSINH.	HYPERBOLIC SINE FUNCTION
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.    	JUNE 7, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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.

;GSINH(X) IS CALCULATED AS FOLLOWS

;  LET V BE APPROXIMATELY 2 SO THAT LNV AND ABS(X)+LN V
;  CAN BE EXACTLY REPRESENTED WHEN X IS EXACTLY REPRESENTABLE.
;  THEN, LETTING Y = ABS(X), AND NOTING THAT -SINH(-X)=SINH(X),
;  FOR
;       0 <= Y < EPS, GSINH = Y*SIGN(X)
;       EPS <= Y <= 1, GSINH = X-X*(Z*R(Z)), WHERE Z = Y**2 AND
;       R(Z) IS GIVEN BELOW.
;       1 < Y <= 709.089565, GSINH = SIGN(X)*(EXP(Y)-EXP(-Y))/2,
;       709.089565 <= Y < 1024 * LN(2)
;               GSINH = SIGN(X)*((V/2)*EXP(Y - LN V)),
;       Y >= 1024 * LN(2), SINH = +MACHINE INFINITY * SIGN(X)

;       LET Z = Y**2. THEN
;       R(Z) = (RP0 + Z*(RP1 + Z*(RP2 + Z*RP3)))/(Q0 + Z*(Q1 + Z*(Q2 + Z)))
;       WHERE RP0, RP1, RP2, Q0, Q1, AND Q2 ARE GIVEN BELOW.

;THE RANGE OF DEFINITION FOR GSINH IS ABS(X) < 1024 * LN(2) AND ERROR MESSAGES
;  WILL RESULT FOR ARGUMENTS OUT OF THAT RANGE.  GSINH WILL BE SET
;  TO + MACHINE INFINITY * SIGN(X).

;REQUIRED (CALLED) ROUTINES:  DEXP

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

;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:

;  MOVEI	L,ARG
;  PUSHJ	P,GSINH

;THE HIGH ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T0
;THE LOW ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T1

	SEARCH	MTHPRM
	SEGMENT	CODE
	SALL

	HELLO	(GSINH,.)	;ENTRY TO GSINH ROUTINE
	DMOVE	T0,@(L)		;OBTAIN X
	PUSH	P,T5		;SAVE REGISTER T5
	HRLZI	T5,200140	;SET FLAG TO 1
	JUMPGE	T0,XPOS		;IF X IS NEGATIVE
	  MOVN	T5,T5		;NEGATE FLAG
	  DMOVN	T0,T0		;Y = -X
XPOS:	CAMLE	T0,ONE		;IF Y IS .GT. 1.0
	  JRST	DCSH		;GO TO DCSH
LE:	CAMG	T0,TWOM30	;IF Y IS .LE. 2**-30
	  JRST	RET2		;GO TO RET1
	JUMPGE	T5,NXT		;IF X IS NEGATIVE
	DMOVN	T0,T0		;Y = X
NXT:	PUSH	P,T2		;SAVE ACCUMULATORS
	PUSH	P,T3
	PUSH	P,T4
	DMOVE	T2,T0		;SAVE A COPY OF X
	DMOVNM	T0,TEMP		;MOVE A COPY OF -X TO MEMORY
	GFMP	T2,T2		;Z = X*X
	DMOVE	T4,T2		;SAVE A COPY OF Z
	GFAD	T4,Q2		;XDEN = Z + Q2
	GFMP	T4,T2		;*Z
	GFAD	T4,Q1		;+Q1
	GFMP	T4,T2		;*Z
	GFAD	T4,Q0		;+Q0
	DMOVEM	T2,Z		;MOVE A COPY OF Z TO MEMORY
	GFMP	T2,RP3		;XNUM = Z*RP3
	GFAD	T2,RP2		;+RP2
	GFMP	T2,Z		;*Z
	GFAD	T2,RP1		;+RP1
	GFMP	T2,Z		;*Z
	GFAD	T2,RP0		; +RP0
	GFDV	T2,T4		;R(Z) = XNUM/XDEN
	GFMP	T2,Z		;*Z
	GFMP	T2,TEMP		;*(-X)
	GFAD	T0,T2		;+X
	POP	P,T4		;RESTORE ACCUMULATORS
	POP	P,T3
	POP	P,T2
	POP	P,T5
	GOODBY	(1)		;RETURN
 
DCSH:	CAMGE	T0,TWENT2		;IF ABS(X) < 22, GO TO
	  JRST	ALG2			;  FULL CALCULATION
     	CAMG	T0,BIGX		;IF Y IS .LE. BIGX
	  JRST	EASY		;THEN GO TO EASY
	CAMGE	T0,YMAXHI	;IF HI OF Y < YMAXHI
	  JRST	GETW		;  GO TO GETW
	CAME	T0,YMAXHI	;IF HI OF Y > YMAXHI
	  JRST	MSTK		;GO TO MSTK
	CAMGE	T1,YMAXLO	;HI OF Y = YMAXHI
	  JRST	GETW		;IF LO OF Y .LE. YMAXLO, GO TO GETW
MSTK:	HRLOI	T0,377777	;SET RESULT TO
	SETO	T1,		;MACHINE INFINITY
	  JUMPG	T5,DSNH		;IF X IS NEGATIVE
	  DMOVN	T0,T0		;RESULT = -RESULT
DSNH:	$LCALL	ROV
;LERR	(LIB,%,<DSINH: result overflow>)
	POP	P,T5		;RESTORE ACCUMULATOR
	GOODBY	(1)		;RETURN

GETW:	GFAD	T0,LNV		;W = Y-LNV
	DMOVEM	T0,TEMP		;MOVE W TO A TEMP REGISTER
	FUNCT	GEXP.,<TEMP>	;Z = EXP(W)
	DMOVEM	T0,TEMP		;SAVE A COPY OF Z
	GFMP	T0,CON1		;RESULT = Z*CON1
	GFAD	T0,TEMP		;+Z
	  JFCL	MSTK		;OVERFLOW POSSIBLE
RET2:	JUMPGE	T5,RET3		;IF SGNFLG IS NEGATIVE
	DMOVN	T0,T0		;RESULT = -RESULT
RET3:	POP	P,T5		;RESTORE ACCUMULATOR
	GOODBY	(1)		;RETURN
EASY:	DMOVEM	T0,TEMP		;MOVE Y TO TEMP
	FUNCT	GEXP.,<TEMP>	;GET ITS EXP
	EXTEND	T0,[GFSC -1] 	;DIV BY 2
	JRST	RET2		;GET RIGHT SIGN FOR RESULT.
ALG2:	PUSH	P,T2		;SAVE MORE ACCUMULATORS
	PUSH	P,T3		
	PUSH	P,T4
	DMOVEM	T0,TEMP		;MOVE Y TO A TEMPORARY REGISTER
	FUNCT	GEXP.,<TEMP>	;Z = DEXP(Y)
	DMOVN	T2,T0		;SAVE A COPY OF Z
	MOVEM	T5,SGNFLG	;MOVE FLAG TO MEMORY
	HRLZI	T4,200140	;SET T4 TO 1.0
	SETZ	T5,		;CLEAR SECOND WORD
	GFDV	T4,T2		;1/Z
	GFAD	T0,T4		;+Z
	EXTEND	T0,[GFSC -1]	;*1/2
	POP	P,T4		;RESTORE ACCUMULATORS
	POP	P,T3
	POP	P,T2
RET1:	SKIPGE	SGNFLG		;IF SGNFLG IS NEGATIVE
	  DMOVN	T0,T0		;RESULT = -RESULT
RET:	POP	P,T5		;RESTORE ACCUMULATOR
	GOODBY	(1)		;RETURN

RP0:    DOUBLE  202352744232,262463203065       ;.35181283430177117881D+6       
RP1:    DOUBLE  201655127025,264501221757       ;.11563521196851768270D+5       
RP2:    DOUBLE  201050741013,034133711232       ;.16375798202630751372D+3       
RP3:    DOUBLE  200062423475,303374403264       ;.78966127417357099479D+0       
Q0:     DOUBLE  575137624613,372031435521       ;-.21108770058106271242D+7      
Q1:     DOUBLE  202043241271,035545730675       ;.36162723109421836460D+5       
Q2:     DOUBLE  576635220743,361550001577       ;-.27773523119650701667D+3      
LNV:    DOUBLE  577723506750,010134300000       ;-.693147180559947174D0         
ONE:	200140000000				;1.0
BIGX:		201254242673			;709.089565
YMAXHI:		201254271027			;709.782712893383998706
YMAXLO:		367643475715			;
TWOM30:		174340000000			;2**-30
CON1:		172041452000			;.186417721E-14
TWENT2:		200554000000			;

	SEGMENT	DATA

SGNFLG:	0
TEMP:	DOUBLE	0,0
Z:	DOUBLE	0,0
	PRGEND
TITLE	GSQRT	SQUARE ROOT FUNCTION
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.	MARCH 19, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GSQRT
EXTERN	GSQRT.
GSQRT=GSQRT.
PRGEND
TITLE	GSQRT.	SQUARE ROOT FUNCTION  
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.	MARCH 19, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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.

;GSQRT(X) IS CALCULATED AS FOLLOWS

;THE ROUTINE CALCULATES THE SQUARE ROOT OF THE ABSOLUTE VALUE OF A
;DOUBLE PRECISION ARGUMENT BY DOING A LINEAR SINGLE PRECISION 
;APPROXIMATION ON THE HIGH ORDER WORD, FOLLOWED BY TWO SINGLE PRECISION
;NEWTON ITERATIONS AND TWO DOUBLE PRECISION NEWTON ITERATIONS. AN ERROR
;MESSAGE RESULTS FOR NEGATIVE ARGUMENTS.

;REQUIRED (CALLED) ROUTINES:  NONE

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

;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:

;  MOVEI	L,ARG
;  PUSHJ	P,GSQRT

;THE HIGH ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T0
;THE LOW ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T1

	SEARCH	MTHPRM
	SEGMENT	CODE

	HELLO	(GSQRT,.)		;ENTRY TO GSQRT ROUTINE

	DMOVE	T0,@(L)			;GET DP ARGUMENT
	JUMPG	T0,GSQRTP		;ARGUMENT IS GREATER THAN 0
	JUMPE	T0,GSQRT4		;ARGUMENT IS ZERO
	$LCALL	NAA
;LERR	(LIB,%,<GSQRT: negative arg; result = GSQRT(DABS(arg))>)

	DMOVN	T0,T0			;ARG = -ARG
GSQRTP:	PUSH	P,T2			;SAVE ACCUMULATORS
	PUSH	P,T3
	PUSH	P,T4
	PUSH	P,T5
	DMOVE	T4,T0			;COPY ARG
	LSH	T4,-1			;COMPUTE LINEAR APPROXIMATION
	TLZE	T4,40
	  JRST	GSQRT2			;YES, GO TO GSQRT2
	ADD	T4,[XWD 26,760700]
	GFMP	T4,[EXP 300145400000,0]
	JRST	GSQRT3
GSQRT2:	ADD	T4,[XWD 26,760700]
	GFMP	T4,[EXP 300165000000,0]
GSQRT3:	DMOVE	T2,T0			;COPY ORIGINAL ARG
	GFDV	T2,T4			;DO NEWTON ITERATIONS
	GFAD	T2,T4
	EXTEND	T2,[GFSC -1]
	DMOVE	T4,T0
	GFDV	T4,T2
	GFAD	T4,T2
	EXTEND	T4,[GFSC -1]
	DMOVE	T2,T0
	GFDV	T2,T4
	GFAD	T2,T4
	EXTEND	T2,[GFSC -1]
	GFDV	T0,T2
	GFAD	T0,T2
	EXTEND	T0,[GFSC -1]
	POP	P,T5			;RESTORE ACCUMULATORS
	POP	P,T4
	POP	P,T3
	POP	P,T2
GSQRT4:	GOODBY	(1)			;RETURN
	PRGEND
TITLE   GCOTAN	TANGENT AND COTANGENT FUNCTIONS
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL  IMSL, INC.      APRIL 16, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GCOTAN
EXTERN	GCOTN.
GCOTAN=GCOTN.
PRGEND
TITLE	GTAN	TANGENT AND COTANGENT FUNCTIONS
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL  IMSL, INC       APRIL 16, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GTAN
EXTERN	GTAN.
GTAN=GTAN.
PRGEND
TITLE	GTAN.	TANGENT AND COTANGENT FUNCTIONS
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL  IMSL, INC       APRIL 16, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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.14159265358979324.
;	THEN DEFINE N AND F SO THAT
;	 X=N*PI/4.0+F, 0.0 <= F <= PI/4.0, WITH PI=3.14159265358979324.
;	THEN
;	 TAN(F) = F, IF F<2**(-30)
;		= R(F), OTHERWISE
;	 WHERE
;	    R(F)=(((XP3*G+XP2)*G+XP1)*G+XP0)/((((Q4*G+Q3)*G+Q2)*G+Q1)*G+Q0)
;	 AND
;	    G = F*F
;	    XPi AND Qi ARE GIVEN BELOW
;	THE APPROXIMATION IS DERIVED FROM ONE GIVEN IN CODY AND WAITE,
;	"SOFTWARE MANUAL FOR THE ELEMENTARY FUNCTIONS"

;	THE RESULT IS THEN RECIPROCATED, IF NECESSARY, AND GIVEN
;	THE APPROPRIATE SIGN.

;THE RANGE OF DEFINITION FOR GTAN IS 0 < ABS(X) < ((2**29) * (PI/2)) = 843314856.D0

;  AND FOR GCOTAN(X), (2**(-1023))*(1+(2**(-58))) < ABS(X) < ((2**29)*(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:

;  MOVEI	L,ARG
;  PUSHJ	P,GTAN
;	OR
;  PUSHJ	P,GCOTAN

;THE HIGH ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T0,
;THE LOW ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T1.

	SEARCH	MTHPRM
	SEGMENT	CODE
	SALL

	HELLO	(GCOTN.,GCOTAN)	;ENTRY TO GCOTAN ROUTINE
	PUSH	P,T4		;SAVE ACCUMULATORS
	PUSH	P,T5
	SETZM	FLAG		;CLEAR FLAG FOR GCOTAN
	DMOVE	T0,@(L)		;GET ARG
	DMOVE	T4,T0		;Y = X
	JUMPGE	T0,XPOS		;IF X IS NEGATIVE
	  DMOVN	T0,T0		;SET Y = -X
XPOS:	CAMGE	T0,EPS1		;IF THE HI ORDER PART OF Y IS TOO SMALL
	  JRST	ERR1		;THEN GO TO ERR1
	CAME	T0,EPS1		;IF HI OF Y  >  HI OF EPS
	  JRST	YOK		;THEN GO TO YOK
	JUMPN	T1,YOK		;HI OF Y = HI OF EPS, IS LO OF Y  OK?
ERR1:	$LCALL	ROV
;LERR	(LIB,%,DCOTAN: result overflow)
	HRLOI	T0,377777	;SET RESULT TO MACHINE
	HRLOI	T1,377777	;INFINITY
	JUMPGE	T4,RET		;IF ARG IS NEGATIVE
	  DMOVN	T0,T0		;RESULT = - RESULT
	POP	P,T5		;RESTORE ACCUMULATORS
	POP	P,T4
	GOODBY	(1)		;RETURN

	HELLO	(GTAN,.)	;ENTRY TO TAN ROUTINE
	PUSH 	P,T4		;SAVE ACCUMULATORS
	PUSH	P,T5
	SETOM	FLAG		;SET FLAG FOR GTAN ENTRY
	DMOVE	T0,@(L)		;GET COPY OF ARG
	DMOVE	T4,T0		;Y = X
	JUMPGE	T0,YOK		;IF X IS NEGATIVE
	DMOVN	T0,T0		;Y = -X
YOK:	CAMGE	T0,YMAX1	;IF HI OF Y < HI OF YMAX
	  JRST	ALG		;PROCEED TO ALG
	CAME	T0,YMAX1	;IF HI OF Y > HI OF YMAX
	  JRST ERR2		;GO TO ERR2
	CAMG	T1,YMAX2	;HI OF Y=HI OF YMAX, IS LO OF Y .LE. LO OF YMAX?
	  JRST ALG		;YES, PROCEED TO ALG
ERR2:	$LCALL	ATZ
;LERR	(LIB,%,<DTAN or DCOTAN: ABS(arg) too large; result = zero>)
	MOVEI	T0,0		;SET RESULT TO ZERO
	MOVEI	T1,0		;SET SECOND WORD TO ZERO
	POP	P,T5		;RESTORE ACCUMULATORS
	POP	P,T4
	GOODBY	(1)		;RETURN
ALG:	PUSH	P,T2		;SAVE ACCUMULATORS
	PUSH	P,T3
	CAML	T0,PIO4HI	;COMPARE |ARG| WITH PI/4
	  JRST	REDUCE		; REDUCTION IS NECESSARY
	DMOVE	T2,T0		;|F| TO T2
	DMOVE	T0,T4		;AND SIGNED F TO T0.
	SETZM	N		;STORE 0 FOR N
	JRST	FPOS		;BYPASS REDUCTION

REDUCE:	GFMP	T0,TWODPI	;Y*(2/PI)
	EXTEND	T0,[GFIXR T0]	;FIX IT
	MOVEM	T0,N		;MOVE N TO MEMORY
	EXTEND	T0,[GFLTR T0]	;FLOAT IT
	JUMPLE	T4,NEXT		;IF X IS POSITIVE
	  DMOVN	T0,T0		;NEGATE XN
NEXT:	DMOVE	T2,T0		;GET A COPY OF -XN
	GFMP	T2,C1		;FORM -XN*C1
	GFAD	T4,T2		;F=X - XN*C1
	DMOVE	T2,T0		;GET A COPY OF -XN
	GFMP	T2,C3		;FORM -XN*C3
	GFMP	T0,C2		;FORM -XN*C2
	GFAD	T4,T0		;F=F - XN*C2
	GFAD	T2,T4		;F=F - XN*C3
	DMOVE	T0,T2		;MOVE COPY OF F INTO T0
	JUMPGE	T2,FPOS		;IF F IS NEGATIVE
	  DMOVN	T2,T2		;F = -F
FPOS:	CAML	T2,HIEPS	;IS F < EPS?
	  JRST	NO		;NO, GO TO NO
	HRLZI	T4,200140	;YES , F< EPS,
	MOVEI	T5,0		;XDEN = 1.0
	JRST	FLGCHK		;GO TO CHECK FLAG
	
NO:	GFMP	T2,T2		;NO, F .GE. EPS, SET G=F*F
	DMOVE	T4,T2		;SAVE A COPY OF G
	GFMP	T2,XP3		;XNUM = XP3*G +
	GFAD	T2,XP2		; P2 *
	GFMP	T2,T4		; G +
	GFAD	T2,XP1		; P1 *
	GFMP	T2,T4		; G *
	GFMP	T2,T0		; F +
	GFAD	T0,T2		; F
	DMOVE	T2,T4		;SAVE A COPY OF G
	GFMP	T4,Q4		;XDEN = Q4 * G +
	GFAD	T4,Q3		; Q3 *
	GFMP	T4,T2		; G +
	GFAD	T4,Q2		; Q2 *
	GFMP	T4,T2		; G +
	GFAD	T4,Q1		; Q1 *
	GFMP	T4,T2		; G +
	GFAD	T4,ONE		; 1.0
	
FLGCHK:	MOVE	T2,N		;GET COPY OF N
	SKIPE	FLAG		;IF FLAG IS NOT ZERO
	  JRST	DA		;THEN GO TO DA
	TRNN	T2,1		;OTHERWISE, IS N ODD?
	  JRST	DOVN		;NO, GO GET RESULT
	DMOVN	T0,T0		;XNUM = -XNUM
	JRST	NOVD		;GO TO  NOVD
DA:	TRNN	T2,1		;FLAG MUST BE ONE, IS N ODD?
		
	  JRST	NOVD		;NO, GO TO NOVD
	DMOVN	T0,T0		;XNUM = -XNUM
DOVN:	GFDV	T4,T0		;RESULT = XDEN/XNUM
	DMOVE	T0,T4
	JRST RET		;GO TO RET
NOVD:	GFDV	T0,T4		;RESULT = XNUM/XDEN
RET:	POP	P,T3		;RESTORE ACCUMULATORS
	POP	P,T2
	POP	P,T5
	POP	P,T4
	GOODBY	(1)

XP1:    DOUBLE  600135665120,325457340031       ;-.133383500064219607D0
XP2:    DOUBLE  177070072025,061672533663       ;.342488782358905900D-2
XP3:    DOUBLE  601632425106,212723433423       ;-.178617073422544267D-4
Q1:     DOUBLE  600004205175,300102305265       ;-.466716833397552942D0
Q2:     DOUBLE  177364436365,013742053124       ;.256638322894401129D-1
Q3:     DOUBLE  601227102333,067553367667       ;-.311815319070100273D-3
Q4:     DOUBLE  175441335647,203547435105       ;.498194339937865123D-6
C1:     DOUBLE  200162207732,240000000000       ;HIGH 30 BITS OF PI/2
C2:     DOUBLE  174342055060,200000000000       ;C1+C2+C3=PI/2 TO EXTRA PREC
C3:	DOUBLE	170764611431,212134015604
TWODPI: DOUBLE  200050574603,156234420251
ONE:    DOUBLE  200140000000,000000000000
PIO4HI:		200062207733			;HIGH ORDER PART OF PI/4
EPS1:		000240000000			;HIGH ORDER PART OF EPS1
YMAX1:		203662207732			;HIGH ORDER PART OF YMAX
YMAX2:		242102643021			;LOW ORDER PART OF YMAX
HIEPS:	 	174340000000			; 2**(-31)

	SEGMENT	DATA

N:      0
FLAG:	0
	PRGEND
TITLE	GTANH	HYPERBOLIC TANGENT FUNCTION
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.	JUNE 1, 1979


;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GTANH
EXTERN	GTANH.
GTANH=GTANH.
PRGEND
TITLE	GTANH.	HYPERBOLIC TANGENT FUNCTION
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.	JUNE 1, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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 > 21.1409890, TANH = 1.0*SIGN(X)
;	IF F > LN(3)/2 AND F <= 21.1409890, TANH = RESULT 1 =
;		SIGN(X)*(1 - 2/(EXP(2*F) + 1)))  
;	IF F < 2**(-29), 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*(RP0+G*(RP1+RP2*G))/(Q0+G*(Q1+G*(Q2+G))).
;               RP0, RP1, RP2, Q0, Q1, AND Q2 APPEAR BELOW.

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

;REQUIRED (CALLED) ROUTINES:  DEXP

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

;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:

;  MOVEI	L,ARG
;  PUSHJ	P,TANH

;THE HIGH ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T0
;THE LOW ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T1

	SEARCH	MTHPRM
	SEGMENT	CODE
	SALL

	HELLO	(GTANH,.)		;ENTRY TO GTANH ROUTINE
	DMOVE	T0,@(L)			;OBTAIN X
	PUSH	P,T5			;SAVE AN ACCUMULATOR
	MOVE	T5,T0			;SAVE A COPY OF X
	JUMPGE	T0,XPOS			;IF X IS NEGATIVE
	  DMOVN	T0,T0			;F = -X
XPOS:	CAMG	T0,LN2TC		;IF F IS .LE. LN2TC
	  JRST	CALCF			;GO TO CALCF
	HRLZI	T0,200140		;SET RESULT TO 1.0
	SETZ	T1,			;ZERO SECOND WORD
	JUMPGE	T5,RET1			;IF X IS NEGATIVE
	DMOVN	T0,T0			;RESULT = -RESULT
RET1:	POP	P,T5			;RESTORE ACCUMULATORS
	GOODBY	(1)			;RETURN

CALCF:	PUSH	P,T2			;SAVE MORE ACCUMULATORS
	PUSH	P,T3
	PUSH	P,T4
	CAMG	T0,LN3D2		;IF F IS .LE. LN3D2
	  JRST	ALG1			;GO TO ALG1
	EXTEND	T0,[GFSC 1]		;F = F+F
	DMOVEM	T0,TEMP			;SAVE F IN A TEMP REGISTER
	FUNCT	GEXP.,<TEMP>		;EXP(2*F)
	GFAD	T0,ONE			;+1.0
	HRLZI	T2,577540		;SET T2 TO -2.0
	SETZ	T3,			;ZERO SECOND WORD
	GFDV	T2,T0			;-2/(EXP(2*F)+1)
	DMOVE	T0,T2
	GFAD	T0,ONE			;1. - 2/(EXP(2*F)+1)
	JUMPGE	T5,RET			;IF X IS NEGATIVE
	  DMOVN	T0,T0			;RESULT = -RESULT
	POP	P,T4			;RESTORE ACCUMULATORS
	POP	P,T3
	POP	P,T2		
	POP	P,T5
	GOODBY	(1)			;RETURN
ALG1:	CAML	T0,CON1			;IF F IS .GE. 2**(-29)
	JRST	ALG2			;GO TO ALG2
	JUMPGE	T5,RET			;IF X IS NEGATIVE
	  DMOVN	T0,T0			;RESULT = -RESULT
	POP	P,T4			;RESTORE ACCUMULATORS
	POP	P,T3
	POP	P,T2
	POP	P,T5
	GOODBY	(1)			;RETURN
ALG2:	JUMPGE	T5,POSARG		;IF ARGUMENT < 0
	  DMOVN	T0,T0			;  NEGATE |ARGUMENT|
POSARG:	DMOVEM	T0,TEMP			;SAVE SIGNED ARGUMENT.
	GFMP	T0,T0			;G = F*F
	DMOVE	T2,T0			;SAVE A COPY OF G
	GFAD	T2,Q2			;XDEN = G+Q2
      	GFMP	T2,T0			;*G
	GFAD	T2,Q1			;+Q1
	GFMP	T2,T0			;*G
	GFAD	T2,Q0			; + Q0
	DMOVE	T4,T0			;SAVE A COPY OF G
	GFMP	T4,RP2			;XNUM = G*RP2
	GFAD	T4,RP1			; + RP1
	GFMP	T4,T0			; * G
	GFAD	T4,RP0			; + RP0
	GFMP	T0,T4			; *G
	GFDV	T0,T2			;R(G) = XNUM/XDEN
	GFMP	T0,TEMP			;RESULT = F*R
	GFAD	T0,TEMP			; + F
RET:	POP	P,T4			;RESTORE ACCUMULATORS
	POP	P,T3
	POP	P,T2
	POP	P,T5
	GOODBY	(1)			;RETURN

RP0:    DOUBLE  576415451321,262036074743               ;-.161341190239962281D+4
RP1:    DOUBLE  577016306122,362132146345               ;-.992259296722360833D+2
RP2:    DOUBLE  577702217271,210105420140               ;-.964374927772254698D0 
Q0:     DOUBLE  201545640742,272351322265               ;.484023570719886887D+4 
Q1:     DOUBLE  201442716132,150037036260               ;.22337720718962312926D+
Q2:     DOUBLE  200770276517,017277377240               ;.112744743805349493D+3 
LN2TC:		200552220277				;21.1409890E0
CON1:		174340000000				;2**(-30)
LN3D2:	      	200043117523             		;.549306144E0
ONE:	DOUBLE	200140000000,000000000000		;1.0

	SEGMENT	DATA

TEMP:	DOUBLE	0,0
	PRGEND
TITLE	GEXP	EXPONENTIAL FUNCTION
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL	IMSL.INC	APRIL 3, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GEXP
EXTERN	GEXP.
GEXP=GEXP.
PRGEND
TITLE	GEXP.	EXPONENTIAL FUNCTION
;		(DOUBLE PRECISION FLOATING POINT)
SUBTTL	IMSL, INC.APRIL 3, 1979

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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.

;DEXP(X) IS CALCULATED AS FOLLOWS

;  IF X <= -710.475860073943942, EXP = 0
;  IF X >  709.089565712824051, EXP = +MACHINE INFINITY
;  IF X = 0.0, EXP = 1
;  OTHERWISE,
;       THE ARGUMENT REDUCTION IS:
;		LET X1 = [X], THE GREATEST INTEGER IN X
;			X2 = X - X1
;		    N = THE NEAREST INTEGER TO X/LN(2)
;		THE REDUCED ARGUMENT IS G = ((X1 - N*C1)+X2)+N*C2
;		    WHERE C1 = .543 (OCTAL),
;		    AND C2 IS GIVEN BELOW
;		  THE CALCULATION IS:
;		EXP = R(G)*2**(N+1)
;		    WHERE R(G) = 0.5 + G*P/(Q - G*P)
;			P = ((((P2*G**2)+P1)*G**2)+P0)*G**2
;			Q = (((((Q3*G**2)+Q2)*G**2)+Q1)*G**2)+Q0
;		P0, P1, P2, Q0, Q1, Q2, AND Q3 ARE GIVEN BELOW AS
;		XP0, XP1, XP2, XQ0, XQ1, XQ2, AND XQ3 .

;THE RANGE OF DEFINITION FOR DEXP 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:

;  MOVEI	L,ARG
;  PUSHJ	P,GEXP

;THE HIGH ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T0,
;THE LOW ORDER PART OF THE ANSWER IS RETURNED IN ACCUMULATOR T1.

	SEARCH	MTHPRM
	SEGMENT	CODE
	SALL

	HELLO	(GEXP,.)		;ENTRY TO GEXP ROUTINE
	DMOVE	T0,@(L)			;GET DP ARGUMENT
	CAMLE	T0,SMLXHI		;IF HI OF X > SMLXHI
	  JRST	NXTCHK			;  GO TO NXTCHK
	CAME	T0,SMLXHI		;IF HI OF X < SMLXHI
	  JRST OUT2			;  GO TO OUT2
	CAMGE	T1,SMLXLO		;HI PART = SMLXHI,
	  JRST 	OUT2			;  IF LO OF X < SMLXLO, OUT2
NXTCHK:	CAMGE	T0,BIGXHI		;IF HI OF X < BIGXHI
	  JRST	EXP1			;  GO TO EXP1
	CAME	T0,BIGXHI		;IF HI OF X > BIGXHI
	  JRST	MSTK			;  GO TO MSTK
	CAMG	T1,BIGXLO		;IF LO OF X .LE. BIGXLO,
	  JRST	EXP1			;  GO TO EXP1

MSTK:	$LCALL	ROV
;LERR	(LIB,%,<DEXP: result overflow>)
	HRLOI	T0,377777		;DEXP = +MACHINE INFINITY
	HRLOI	T1,377777
	GOODBY	(1)			;RETURN

OUT2:	$LCALL	RUN
;LERR	(LIB,%,<DEXP: result underflow>)
	MOVEI 	T0,0			;EXP = 0
	MOVEI	T1,0
	GOODBY	(1)			;RETURN

EXP1:	JUMPE	T0,[MOVSI T0,200140	;RETURN 1.0 FOR ARG OF ZERO
		GOODBY (1)]		;EXIT
	PUSH	P,T2			;SAVE ACCUMULATORS
	PUSH	P,T3	
	PUSH	P,T4
	PUSH	P,T5
	MOVM	T2,T0			;GET ABS(ARGHI)
	CAML	T2,LN2OV2		;IF .GE. (LN(2))/2
	  JRST	REDUCE			;  MUST REDUCE ARGUMENT.
	SETZ	T4,
	MOVEM	T4,SAVEN		;SET N TO ZERO.
	DMOVE	T4,T0			;GET COPY OF ARG.
	JRST	MERGE			;MERGE WITH MAIN FLOW.

REDUCE:	DMOVE	T2,T0			;GET COPY OF ARG
	GFMP	T2,RNDLN2		;ARG/LN2
	EXTEND	T2,[GFIXR T2]		;NEAREST INTEGER = N
	EXTEND	T2,[GFLTR T2]		;FLOAT N
	MOVEM	T2,SAVEN		;SAVEN
	GFMP	T2,C1			;N*C1
	GFAD	T0,T2			;X + N*C1
	MOVE	T2,SAVEN		;RETRIEVE N
	MOVEI	T3,0			;ZERO SECOND WORD
	GFMP	T2,C2			;FORM N*C2
	GFAD	T0,T2			;N*C2 + (N*C1 + X)
	DMOVE	T4,T0			;SAVE G
	MOVM	T2,T4			;GET ABS(G)
MERGE:	CAML	T2,TWOM30		;IF REDUCED ARG IS>= 2**-30
	  JRST	APPRX			;  GO TO APPRX
	GFAD	T0,ONE			;R(G) = 1. + G
	EXTEND	T0,[GFSC -1]		;*.5
	JRST	BRNCH			;GO TO BRNCH
APPRX:	GFMP	T4,T4			;Z = G*G
	DMOVE	T2,T4			;SAVE Z
	GFMP	T4,XP2			;Z*XP2
	GFAD	T4,XP1			;+XP1
	GFMP	T4,T2			;* Z
	GFAD	T4,XP0			;+ XP0
	GFMP	T0,T4			;* G
	DMOVE	T4,T2			;SAVE Z
	GFMP	T4,XQ3			;XQ3*Z
	GFAD	T4,XQ2			;+XQ2
	GFMP	T4,T2			;*Z
	GFAD	T4,XQ1			;+ XQ1
	GFMP	T4,T2			;* Z
	GFAD	T4,XQ0			; + XQ0
	GFSB	T4,T0			; XQ - G*XP
	GFDV	T0,T4			;(G*XP)/(XQ-G*XP)
	GFAD	T0,XQ0			; + .5
BRNCH:	MOVE	T4,SAVEN		;RETRIEVE N
	SETZ	T5,			;T5=0
	EXTEND	T4,[GFIX T4]
	ADDI	T4,1			;N = N+1
	EXTEND	T0,[GFSC 0(T4)]		;ADD N TO THE EXPONENT

	POP	P,T5			;RESTORE ACCUMULATORS
	POP	P,T4
	POP	P,T3
	POP	P,T2

RET:	GOODBY	(1)			; RETURN

SMLXHI:	576523460613				;-710.475860073943942
SMLXLO:	202140360224				;
BIGXHI:	201254242673				;709.089565712824051
BIGXLO:	161647554056				;
RNDLN2: DOUBLE  200156125073,051270137606       ;1.44269504088896341 = 	1/LN2   
ONE:    DOUBLE  200140000000,000000000000       ;1.0D0                          
TWOM30: DOUBLE  174340000000,000000000000       ;2**-30                         
C1:     DOUBLE  577723500000,000000000000       ;-0.693359375D0                 
C2:     DOUBLE  176467500202,343020625033       ;2.12194440054690583D-4         
XP0:    DOUBLE  177740000000,000000000000       ;0.250D0                        
XP1:    DOUBLE  177176035137,221241124545       ;0.757531801594227767D-2        
XP2:    DOUBLE  176241055041,127151103610       ;0.315551927656846464D-4        
XQ0:    DOUBLE  200040000000,000000000000       ;0.5D0                          
XQ1:    DOUBLE  177472134502,216775477655       ;0.568173026985512218D-1        
XQ2:    DOUBLE  176651274142,341215233732       ;0.631218943743985036D-3        
XQ3:    DOUBLE  175462315430,147120212512       ;0.751040283998700461D-6        
LN2OV2:	DOUBLE	177754271027,367643475715

	SEGMENT	DATA

SAVEN:	0
	PRGEND
TITLE	GINT	DOUBLE PRECISION TRUNCATION TO INTEGER
SUBTTL	CHRIS SMITH/CKS		29-Jan-80

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GINT
EXTERN	GINT.
GINT=GINT.
PRGEND
TITLE	GABS	DOUBLE PRECISION ABSOLUTE VALUE
SUBTTL	CHRIS SMITH/CKS		29-Jan-80

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GABS
EXTERN	DABS.
GABS=DABS.
PRGEND
TITLE	GABS.	DOUBLE PRECISION ABSOLUTE VALUE
SUBTTL	CHRIS SMITH/CKS		29-Jan-80

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1980, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GABS.
EXTERN	DABS.
GABS.=<DABS.+0>			;[4015]
PRGEND
TITLE	GMAX1	DOUBLE PRECISION MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL	CHRIS SMITH/CKS		29-Jan-80

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GMAX1
EXTERN	DMAX1.
GMAX1=DMAX1.
PRGEND
TITLE	GMAX1.	DOUBLE PRECISION MAXIMUM OF A SERIES OF ARGUMENTS
SUBTTL	CHRIS SMITH/CKS		29-Jan-80

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1980, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GMAX1.
EXTERN	DMAX1.
GMAX1.=<DMAX1.+0>			;[4015]
PRGEND
TITLE	GMIN1	DOUBLE PRECISION MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL	CHRIS SMITH/CKS		29-Jan-80

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GMIN1
EXTERN	DMIN1.
GMIN1=DMIN1.
PRGEND
TITLE	GMIN1.	DOUBLE PRECISION MINIMUM OF A SERIES OF ARGUMENTS
SUBTTL	CHRIS SMITH/CKS		29-Jan-80

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1980, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GMIN1.
EXTERN	DMIN1.
GMIN1.=<DMIN1.+0>			;[4015]
PRGEND
TITLE	GSIGN	DOUBLE PRECISION TRANSFER OF SIGN FUNCTION
SUBTTL	CHRIS SMITH/CKS		29-Jan-80

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1980, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GSIGN
EXTERN	DSIGN.
GSIGN=DSIGN.
PRGEND
TITLE	GSIGN.	DOUBLE PRECISION TRANSFER OF SIGN FUNCTION
SUBTTL	CHRIS SMITH/CKS		29-Jan-80

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1980, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GSIGN.
EXTERN	DSIGN.
GSIGN.=<DSIGN.+0>			;[4015]
PRGEND
TITLE	DTOGA	
SUBTTL	M. R. BOUCHER/MRB		11-JUN-84

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	DTOGA
EXTERN	DTOGA.
DTOGA=DTOGA.
PRGEND
TITLE	DTOG	DOUBLE PRECISION TO GFLOAT DOUBLE PRECISION CONVERSION

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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.

					;ARG BLOCK OFFSETS
	SRC==0				;SOURCE ARRAY ADDRESS
	DST==1				;DESTINATION ARRAY ADDRESS
	CNT==2				;NUMBER OF ITEMS TO CONVERT

	SEARCH	MTHPRM
	SEGMENT	CODE
	SALL

	HELLO	(DTOG)
					;CONVERT ONE NUMBER
	DMOVE	T0,@(L)			;GET THE D NUMBER
	PUSHJ	P,DTOGS			;CONVERT IT
	GOODBY

	HELLO	(DTOGA.)		;[4012]
					;CONVERT AN ARRAY OF NUMBERS
	PUSH	P,T3			;SAVE SOME AC'S
	PUSH	P,T4
	PUSH	P,T5
	XMOVEI	T3,@SRC(L)		;GET D PNTR
	XMOVEI	T4,@DST(L)		;GET G PNTR
	MOVE	T5,@CNT(L)		;GET COUNT
DTOGLP:	DMOVE	T0,(T3)			;GET A D NUMBER
	PUSHJ	P,DTOGS			;CONVERT IT
	DMOVEM	T0,(T4)			;SAVE IT
	ADDI	T3,2			;INCR PNTRS
	ADDI	T4,2
	SOJG	T5,DTOGLP		;LOOP FOR ARRAY
	POP	P,T5
	POP	P,T4
	POP	P,T3
	GOODBY

DTOGS:	JUMPL	T0,NEGDTG		;DO SEPARATELY IF NEGATIVE
	JUMPE	T0,DTGZER		;AND NOTHING IF ZERO
	PUSHJ	P,EXPDTG		;NOW DO THE MOST STUFF
	POPJ	P,

NEGDTG:	DMOVN	T0,T0			;MAKE IT POSITIVE
	PUSHJ	P,EXPDTG		;DO MOST STUFF
	DMOVN	T0,T0			;MAKE IT NEGATIVE AGAIN
	POPJ	P,

DTGZER:	DMOVE	T0,[EXP 0,0]		;LOAD ALL ZEROES
	POPJ	P,

EXPDTG:	PUSH	P,T2			;SAVE AN AC
	CAMN	T0,[377777,,-1]		;'OVERFLOW' AMOUNT?
	 CAME	T1,[377777,,-1]
	  JRST	DTGOK			;NO
	JRST	DTGDON			;YES. LEAVE AS IS
DTGOK:	LDB	T2,[POINT 8,T0,8]	;GET THE EXPONENT
	ADDI	T2,1600			;CONVERT TO G-TYPE EXP
	TLZ	T0,777000		;CLEAR THE EXPONENT
	DADD	T0,[EXP 0,4]		;ROUND UP
	ASHC	T0,-3			;SHIFT FRACTION
	TLNN	T0,100			;DID WE OVERFLOW?
	 JRST	EXPOK			;NO
	ASHC	T0,-1			;YES. SHIFT 1 MORE
	ADDI	T2,1			;AND INCR THE EXPONENT
EXPOK:	DPB	T2,[POINT 12,T0,11]	;DROP IN THE EXP
DTGDON:	POP	P,T2			;RESTORE THE AC
	POPJ	P,

	PRGEND
TITLE	GTODA
SUBTTL	M. R. BOUCHER/MRB		11-JUN-84

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
NOSYM
ENTRY	GTODA
EXTERN	GTODA.
GTODA=GTODA.
PRGEND
TITLE	GTOD	GFLOAT DOUBLE PRECISION TO DOUBLE PRECISION CONVERSION

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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.

					;ARG BLOCK OFFSETS
	SRC==0				;SOURCE ARRAY ADDRESS
	DST==1				;DESTINATION ARRAY ADDRESS
	CNT==2				;NUMBER OF ITEMS TO CONVERT

	SEARCH	MTHPRM
	SEGMENT	CODE
	SALL

	HELLO	(GTOD)
					;CONVERT ONE NUMBER
	DMOVE	T0,@(L)			;GET THE G NUMBER
	PUSHJ	P,GTODS			;CONVERT IT
	GOODBY

	HELLO	(GTODA.)		;[4012]
					;CONVERT AN ARRAY OF NUMBERS
	PUSH	P,T3			;SAVE SOME AC'S
	PUSH	P,T4
	PUSH	P,T5
	XMOVEI	T3,@SRC(L)		;GET D PNTR
	XMOVEI	T4,@DST(L)		;GET G PNTR
	MOVE	T5,@CNT(L)		;GET COUNT
GTODLP:	DMOVE	T0,(T3)			;GET A G NUMBER
	PUSHJ	P,GTODS			;CONVERT IT
	DMOVEM	T0,(T4)			;SAVE IT
	ADDI	T3,2			;INCR PNTRS
	ADDI	T4,2
	SOJG	T5,GTODLP		;LOOP FOR ARRAY
	POP	P,T5
	POP	P,T4
	POP	P,T3
	GOODBY

GTODS:	JUMPL	T0,NEGGTD		;DO SEPARATELY IF NEGATIVE
	JUMPE	T0,GTDZER		;AND NOTHING IF ZERO
	PUSHJ	P,EXPGTD		;NOW DO THE MOST STUFF
	POPJ	P,

NEGGTD:	DMOVN	T0,T0			;MAKE IT POSITIVE
	PUSHJ	P,EXPGTD		;DO MOST STUFF
	DMOVN	T0,T0			;MAKE IT NEGATIVE AGAIN
	POPJ	P,

GTDZER:	DMOVE	T0,[EXP 0,0]		;LOAD ALL ZEROES
	POPJ	P,

EXPGTD:	PUSH	P,T2			;SAVE AN AC
	CAMN	T0,[377777,,-1]		;'OVERFLOW' AMOUNT?
	 CAME	T1,[377777,,-1]
	  JRST	GTDOK			;NO
	JRST	GTDDON			;YES. LEAVE AS IS
GTDOK:	LDB	T2,[POINT 11,T0,11]	;GET THE EXPONENT
	SUBI	T2,1600			;CONVERT TO D-TYPE EXP
	JUMPL	T2,GTDLOW		;EXPONENT TO SMALL
	CAIL	T2,400			;TEST IF TOO BIG
	 JRST	GTDHGH			;YUP. IT'S TO BIG
	TLZ	T0,777700		;CLEAR THE EXPONENT
	ASHC	T0,3			;SHIFT THE FRACTION
	DPB	T2,[POINT 9,T0,8]	;DROP IN THE EXP
	JRST	GTDDON
GTDLOW:	$LCALL	RUN
;LERR	(LIB,%,<GTOD: result underflow>)
	DMOVE	T0,[EXP 0,0]		;LOAD ZEROES
	JRST	GTDDON			;AND LEAVE
GTDHGH:	$LCALL	ROV
;LERR	(LIB,%,<GTOD: result overflow>)
	DMOVE	T0,[EXP 377777777777,377777777777] ;LOAD AN OVERFLOW
GTDDON:	POP	P,T2			;RESTORE THE AC
	POPJ	P,

	PRGEND

TITLE	GSN.0

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GSN.0
GSN.0:	GSNGL	0
	PRGEND


TITLE	GSN.2
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GSN.2
GSN.2:	GSNGL	2
	PRGEND


TITLE	GSN.4
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GSN.4
GSN.4:	GSNGL	4
	PRGEND


TITLE	GSN.6
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GSN.6
GSN.6:	GSNGL	6
	PRGEND


TITLE	GSN.10
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GSN.10
GSN.10:	GSNGL	10
	PRGEND


TITLE	GSN.12
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GSN.12
GSN.12:	GSNGL	12
	PRGEND


TITLE	GSN.14
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GSN.14
GSN.14:	GSNGL	14
	PRGEND

TITLE	GDB.0

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GDB.0
GDB.0:	GDBLE	0
	PRGEND


TITLE	GDB.2
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GDB.2
GDB.2:	GDBLE	2
	PRGEND


TITLE	GDB.4
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GDB.4
GDB.4:	GDBLE	4
	PRGEND


TITLE	GDB.6
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GDB.6
GDB.6:	GDBLE	6
	PRGEND


TITLE	GDB.10
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GDB.10
GDB.10:	GDBLE	10
	PRGEND


TITLE	GDB.12
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GDB.12
GDB.12:	GDBLE	12
	PRGEND


TITLE	GDB.14
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GDB.14
GDB.14:	GDBLE	14
	PRGEND

TITLE	GFX.0

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GFX.0
GFX.0:	GFIX	0
	PRGEND


TITLE	GFX.2
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GFX.2
GFX.2:	GFIX	2
	PRGEND


TITLE	GFX.4
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GFX.4
GFX.4:	GFIX	4
	PRGEND


TITLE	GFX.6
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GFX.6
GFX.6:	GFIX	6
	PRGEND


TITLE	GFX.10
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GFX.10
GFX.10:	GFIX	10
	PRGEND


TITLE	GFX.12
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GFX.12
GFX.12:	GFIX	12
	PRGEND


TITLE	GFX.14
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GFX.14
GFX.14:	GFIX	14
	PRGEND

	TITLE	GFL.0

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979, 1987
;ALL RIGHTS RESERVED.
;
;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	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GFL.0
GFL.0:	GFLTR	0
	PRGEND


TITLE	GFL.2
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GFL.2
GFL.2:	GFLTR	2
	PRGEND


TITLE	GFL.4
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GFL.4
GFL.4:	GFLTR	4
	PRGEND


TITLE	GFL.6
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GFL.6
GFL.6:	GFLTR	6
	PRGEND


TITLE	GFL.10
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GFL.10
GFL.10:	GFLTR	10
	PRGEND


TITLE	GFL.12
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GFL.12
GFL.12:	GFLTR	12
	PRGEND


TITLE	GFL.14
	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GFL.14
GFL.14:	GFLTR	14

	PRGEND
	TITLE GDIM G-floating positive difference

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.

	SEARCH	MTHPRM
	SEGMENT	CODE
	NOSYM
	ENTRY	GDIM
	EXTERN	GDIM.
	GDIM=GDIM.
	PRGEND

	TITLE	GDIM. G-Floating Positive Difference.
	SUBTTL	C. McCutcheon	6/26/81

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.

;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 Intrinsic Function for Positive Difference.
; Passed and returned arguments are G-floating double precision.

; Passed: A1,A2
; Returns:	(from page 15-23 of standard)
; 	A1-A2	if A1 .GT. A2
; 	0	if A1 .LE. A2

	SEARCH	MTHPRM
	SEGMENT	CODE
	SALL
	HELLO	(GDIM,.)

	PUSH	P,T2
	PUSH	P,T3

	DMOVE	T0,@0(L)		;A1
	DMOVE	T2,@1(L)		;A2

	CAMN	T0,T2			;If A1 .LT. A2,
	CAML	T1,T3
	CAMGE	T0,T2
	JRST	RET0			; return 0.

	GFSB	T0,@1(L)		;Subtract A1-A2
	JFCL	EXCEP			;Can underflow and overflow

RET:	POP	P,T3
	POP	P,T2
	GOODBYE				;Return

RET0:	SETZB	T0,T1			;Return zero
	JRST	RET

EXCEP:	JUMPE	T0,UNDER		;Underflow?
	$LCALL	ROV,RET			;No, result overflow
UNDER:	$LCALL	RUN,RET			;Result underflow

	PRGEND
	TITLE	GINT.  G-Floating truncation.
	SUBTTL	C. McCutcheon - 6/25/81

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.

;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 G-floating double
; precision truncation of the double precision number passed.

; If Magnitude(A) .LT. 1, then 0 is returned,
; otherwise return the largest integer that does not exceed the
; magnitude of A, and whose sign is the same as that of A.

	SEARCH	MTHPRM
	SEGMENT	CODE
	SALL

	HELLO	(GINT,.)	;Enter routine

	DMOVE	T0,@0(L)	;Get argument to truncate.
	JUMPN	T0,NZERO	;If zero passed, return.
	GOODBYE			;Return

NZERO:	PUSH	P,T2		;Save ac.

	CAIGE	T0,0		;If original number .LT. zero,
	 DMOVN	T0,T0		; negate it.

	HLRZ	T2,T0		;Get exponent
	LSH	T2,-6		;Put rightmost
	CAIG	T2,^O2000	;[3215] If exponent .LE. 2000 then
	 JRST	ZERO		; return zero (number .LT. 1)
	CAIL	T2,^O2073	;If exponent .GE. 2073 then 
	 JRST	DONE		; return the number passed.

; Now shift out the fractional part of the number.

	ASHC	T0,-2073(T2)	;Shift into integer position.
	MOVN	T2,T2		;Negate exponent.
	ASHC	T0,2073(T2)	;Shift back to where found.

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

BYE:	POP	P,T2		;Pop saved ac's
	GOODBYE			;Return

DONE:	DMOVE	T0,@0(L)	;No fractional part, return
	JRST	BYE		; the number passed.

ZERO:	SETZB	T0,T1		;Return 0
	JRST	BYE

	PRGEND
	TITLE	GNINT.  G-Floating nearest whole number.
	SUBTTL	C. McCutcheon - 6/25/81

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.

;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 G-floating double
; precision nearest whole number of the double precision number
; passed.

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

	SEARCH	MTHPRM
	SEGMENT	CODE
	SALL

	HELLO	(GNINT,.)	;Enter routine

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

NZERO:	PUSH	P,T2		;Save ac's
	CAIGE	T0,0		;If original number .LT. zero,
	 DMOVN	T0,T0		; negate it.

; Now Shift out the fractional part of the number.

	HLRZ	T2,T0		;Get exponent
	LSH	T2,-6		;Put rightmost
	CAIL	T2,^O2073	;If exponent .GE. 2073 then 
	 JRST	DONE		; return the number passed.
	CAIGE	T2,2000		;number much .LT. 1.
	 JRST	ZERO		; return 0.

	GFAD	T0,[200040,,0
			0,,0]	;Add .5 before truncation.

	HLRZ	T2,T0		;Get exponent
	LSH	T2,-6		;Put rightmost
	ASHC	T0,-2073(T2)	;Shift into integer position.
	MOVN	T2,T2		;Negate exponent.
	ASHC	T0,2073(T2)	;Shift back to where found.

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

BYE:	POP	P,T2		;Pop saved ac's
	GOODBYE			;Return

DONE:	DMOVE	T0,@0(L)		;No fractional part, return
	JRST	BYE		; the number passed.

ZERO:	SETZB	T0,T1		;Set to 0.
	JRST	BYE

	PRGEND
	TITLE	GPROD.  G-Floating product for single prec. factors.
	SUBTTL	C. McCutcheon - 6/25/81

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.

;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 double precision
; product for two real arguments passed it.

	SEARCH	MTHPRM
	SEGMENT	CODE
	SALL

	HELLO	(GPROD,.)	;Enter routine
	EXTEND	T0,[GDBLE @1(L)] ;Convert 2nd arg to G-floating.
	DMOVEM	T0,MULT		;Save 2nd argument

	EXTEND	T0,[GDBLE @0(L)] ;Convert 1st arg to G-floating.

	GFMP	T0,MULT		;Multiply and leave result in AC0.
	JFCL	EXCEP		;Result can under/overflow

RET:	POPJ	P,		;Return

EXCEP:	JUMPE	T0,UNDER	;Underflow?
	$LCALL	ROV,RET
UNDER:	$LCALL	RUN,RET

	SEGMENT	DATA

MULT:	BLOCK	2		;Multiplier
	PRGEND
	TITLE	IGNIN.  Integer nearest whole number for G-Gloating.
	SUBTTL	C. McCutcheon - 6/25/81

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.

;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 G-floating double precision number passed.

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

	SEARCH	MTHPRM
	SEGMENT	CODE
	SALL

	HELLO	(IGNIN.,IGNINT)	;Enter routine

	DMOVE	T0,@0(L)	;Get argument to round.
	JUMPN	T0,NZERO	;If number passed = 0,
	GOODBYE			;Return

NZERO:	CAIGE	T0,0		;If original number .LT. zero,
	 DMOVN	T0,T0		; negate it.
	TLNN	T0,200000	;Is |number| .LT. 1/2 ?
	 JRST	ZERO		;Yes, go return zero
	PUSH	P,T2		;Save an ac

	GFAD	T0,[200040,,0
			 0,,0]	;Add 0.5G0 before truncation.

; Now shift out the fractional part of the number.

	HLRZ	T2,T0		;Get exponent
	LSH	T2,-6		;Put rightmost
	CAILE	T2,2043		;If exponent .GE. 2043 then 
	 JRST	DONE		; return largest integer

	TLZ	T0,777700	;Eliminate exponent.
	ASHC	T0,-2030(T2)	;Shift into integer position,
				; integer result in T0.

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

BYE:	POP	P,T2		;Pop saved ac's
	GOODBYE			;Return

; Number is .LT. 1/2, return zero quickly (don't use the normal flow
; because GFAD 0.5G0 will round)

ZERO:	SETZ	T0,		;Return . . .
	GOODBYE			; . . . 0

; Number too large to represent as integer.  Return largest
; integer.

DONE:	$LCALL	ROV
;LERR	(LIB,%,<IDNINT: Result overflow>)
	HRLOI	T0,377777	;Largest positive integer.
	SKIPGE	@0(L)		;If original number .LT. zero,
	 HRLZI	T0,400000	; largest negative integer.
	JRST	BYE		;

	END