Directory of image this file is from
This file as a plain text file

/ 3	FORTRAN II EXTENDED SUBROUTINE & FUNCTION LIBRARY
/
/	FUNCTION AINT : FLOATING POINT TRUNCATION
/
/	FUNCTION AMOD : ARG1 MODULO ARG2
/
/	STANDARD FORTRAN IV SEE OS/8 HANDBOOK 8-48 & 8-49
/
/	FUNCTION RUND : SIGN(1.0,X)*AINT(ABS(X)+.5)
/
/	31-JAN-78				W. HOUBEN
/
	LAP
	ENTRY	AINT	/ REAL TO REAL TRUNCATION
	ENTRY	AMOD	/ REAL MODULO
	ENTRY	RUND	/ REAL ROUND OFF
/
	DUMMY	ARG1
	DUMMY	ARG2
/
ARG1,	BLOCK	2
ARG2,	BLOCK	2
/
YVAL,	BLOCK	3
/
XPNT,	ARG1
/
HALF,	2004		/ REAL .5
	0
	0001
ZERO,	2330		/ THIS FORCES E.G. 1.5 TO ROTATE
	0		/ 26 PLACES TO THE RIGHT, SO THAT
	0		/ THE NONINTEGER BITS ARE LOST.
/
AINT,
PNTR1,	0
CNTR1,	0
	TAD	XPNT
	DCA	PNTR
	TAD	(-2
	DCA	CNTR
AINT1,	TAD I 	AINT
	INC	AINT#
	DCA I	PNTR
	INC	PNTR
	ISZ	CNTR
	JMP	AINT1
	CALL	1,IFAD
	ARG	ARG1	/ GET ARGUMENT
	CALL	1,FAD
	ARG	ZERO	/ TRUNCATE
	RETRN	AINT
/
AMOD,			/ FLOATING POINT MODULO FUNCTION
PNTR,	0
CNTR,	0
	TAD	XPNT	/ FUNCTION :
	DCA	PNTR1	/ AMOD(X,Y) = X-AINT(X/Y)*Y
	TAD	(-4
	DCA	CNTR1
AMOD1,	TAD I	AMOD
	INC	AMOD#
	DCA I	PNTR1
	INC	PNTR1
	ISZ	CNTR1
	JMP	AMOD1
	CALL	1,IFAD	/ FAC : Y
	ARG	ARG2
	CALL	1,STO
	ARG	YVAL
	CALL	1,IFAD	/ FAC : X
	ARG	ARG1
	CALL	1,FDV	/ FAC : X / Y
	ARG	YVAL
	CALL	1,FAD	/ FAC : AINT ( X / Y )
	ARG	ZERO	/ TRUNCATE
	CALL	1,FMP	/ FAC : AINT(X/Y)*Y
	ARG	YVAL
	CALL	0,CHS	/ FAC : - AINT(X/Y)*Y
	CALL	1,IFAD	/ FAC : X-AINT(X/Y)*Y
	ARG	ARG1
	RETRN	AMOD
RUND,	BLOCK	2	/ FLOATING POINT ROUND OFF FUNCTION
	TAD	XPNT	/ RUND(X)=SIGN(1.0,X)*AINT(ABS(X)+0.5)
	DCA	PNTR
	TAD	(-2
	DCA	CNTR
RUND1,	TAD I	RUND
	INC	RUND#
	DCA I	PNTR
	INC	PNTR
	ISZ	CNTR
	JMP	RUND1
	CALL	1,IFAD	/ FAC : X
	ARG	ARG1
	TAD	ACH	/ IF X .LT. 0.0 GOTO RUND2
	SPA CLA
	JMP	RUND2
	CALL	1,FAD	/ FAC : X + 0.5
	ARG	HALF
RUND3,	CALL	1,FAD	/ FAC : AINT('FAC')
	ARG	ZERO
	RETRN	RUND
RUND2,	CALL	1,FSB	/ FAC : X - 0.5
	ARG	HALF
	JMP	RUND3
	END