/ 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