SUBROUTINE MONDIV40(AGIGAS, AUNITS, BGIGAS, BUNITS, RGIGAS,RUNITS) C---------------------------------------------------------------------- C- C- Purpose and Methods : Divide one 40-bit number by another 40-bit number. C- C- R = A / B C- C- X = XGIGAS*2**30 + XUNITS C- C- Inputs : AGIGAS A / 2**30 C- AUNITS MOD(A, 2**30) C- C- BGIGAS B / 2**30 C- BUNITS MOD(B, 2**30) C- C- Outputs : RGIGAS R / 2**30 C- RUNITS MOD(R, 2**30) C- C- Controls: none C- C- Created 13-MAY-1992 Philippe Laurens, Steven Klocek C- C---------------------------------------------------------------------- IMPLICIT NONE C LOGICAL MONDIVCMP40 C INTEGER AGIGAS, AUNITS INTEGER BGIGAS, BUNITS INTEGER RGIGAS, RUNITS C INTEGER BIT C INTEGER TGIGAS, TUNITS C RGIGAS = 0 RUNITS = 0 C C The dividend is modified in this algorithm, so move it to a scratch C variable. C TGIGAS = AGIGAS TUNITS = AUNITS C C Perform binary long division C DO BIT = 39, 0, -1 C C If subtracting the divisor would leave a positive result, add to the C quotient and perform the subtraction C IF (MONDIVCMP40(TGIGAS, TUNITS, BIT, BGIGAS, BUNITS) & .EQV. .TRUE.) THEN IF (BIT .GE. 30) THEN RGIGAS = IBSET(RGIGAS, BIT-30) ELSE RUNITS = IBSET(RUNITS, BIT) ENDIF CALL MONDIVSUB40(TGIGAS, TUNITS, BIT, BGIGAS, BUNITS) ENDIF C END DO C---------------------------------------------------------------------- 999 RETURN END C C C LOGICAL FUNCTION MONDIVCMP40( & AGIGAS, AUNITS, A_RIGHTBIT, BGIGAS, BUNITS) C---------------------------------------------------------------------- C- C- Purpose and Methods : Compare two 40-bit integers, specialized for use in a C- long division algorithm. C- C- Returned value : Truth value of the following proposition: C- C- ISHFT(A, -A_RIGHTBIT) >= B C- C- Where A and B are 40-bit integers. C- C- Inputs : AGIGAS A / 2**30 C- AUNITS MOD(A, 2**30) C- A_RIGHTBIT The bit in A to consider as bit #0 C- C- BGIGAS B / 2**30 C- BUNITS MOD(B, 2**30) C- C- Outputs : none C- Controls: none C- C- Created 13-MAY-1992 Philippe Laurens, Steven Klocek C- C---------------------------------------------------------------------- IMPLICIT NONE C INTEGER AGIGAS, AUNITS INTEGER A_RIGHTBIT INTEGER BGIGAS, BUNITS C INTEGER A(0:2), B(0:1) C INTEGER WHICHBYTE(0:78) INTEGER WHICHBIT(0:78) C INTEGER BIT LOGICAL BITA, BITB C DATA WHICHBYTE / 30 * 0, 10 * 1, 39 * 2 / DATA WHICHBIT / 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, & 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, & 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, & 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & 0, 0, 0, 0, 0, 0, 0, 0, 0 / C A(2) = 0 A(1) = AGIGAS A(0) = AUNITS C B(1) = BGIGAS B(0) = BUNITS C MONDIVCMP40 = .TRUE. C DO BIT = 39, 0, -1 BITA = BTEST(A(WHICHBYTE(BIT + A_RIGHTBIT)), & WHICHBIT(BIT + A_RIGHTBIT) ) C BITB = BTEST(B(WHICHBYTE(BIT)), & WHICHBIT(BIT) ) C IF ((BITB .EQV. .TRUE.) .AND. (BITA .EQV. .FALSE.)) THEN MONDIVCMP40 = .FALSE. GOTO 999 ENDIF C IF ((BITB .EQV. .FALSE.) .AND. (BITA .EQV. .TRUE.)) GOTO 999 END DO C---------------------------------------------------------------------- 999 RETURN END C C C SUBROUTINE MONSUB40( & AGIGAS, AUNITS, BGIGAS, BUNITS, RGIGAS, RUNITS) C---------------------------------------------------------------------- C- C- Purpose and Methods : Subtract one 40-bit number from another. C- C- R = A - B C- C- R, A, and B are 40-bit numbers C- C- Inputs : AGIGAS (*Modified*) A / 2**30 C- AUNITS (*Modified*) MOD(A, 2**30) C- C- BGIGAS B / 2**30 C- BUNITS MOD(B, 2**30) C- C- Outputs : RGIGAS R / 2**30 C- RUNITS MOD(R, 2**30) C- C- Controls: NONE C- C- Created 13-MAY-1992 Philippe Laurens, Steven Klocek C- Updated 2-JUL-1992 Philippe Laurens, Steven Klocek C- Fixed bug when RGIGAS should be -1. C- C---------------------------------------------------------------------- IMPLICIT NONE C INTEGER AGIGAS, AUNITS INTEGER BGIGAS, BUNITS INTEGER RGIGAS, RUNITS C INTEGER CLOW, CHIGH C PARAMETER H3F = 63 PARAMETER HFFFFFF = 2**24-1 C CLOW = IAND(AUNITS, HFFFFFF) - IAND(BUNITS, HFFFFFF) CHIGH = IOR(ISHFT(AGIGAS, 6), ISHFT(AUNITS, -24)) & - IOR(ISHFT(BGIGAS, 6), ISHFT(BUNITS, -24)) C IF (CLOW .LT. 0) THEN CLOW = CLOW + HFFFFFF + 1 CHIGH = CHIGH -1 ENDIF C RUNITS = IOR(CLOW, ISHFT(IAND(CHIGH, H3F), 24)) IF (CHIGH .GE. 0) THEN RGIGAS = ISHFT(CHIGH, -6) ELSE RGIGAS = NOT(ISHFT(NOT(CHIGH), -6)) ENDIF C C---------------------------------------------------------------------- 999 RETURN END C C C SUBROUTINE MONDIVSUB40(AGIGAS, AUNITS, A_RIGHTBIT, BGIGAS, BUNITS) C---------------------------------------------------------------------- C- C- Purpose and Methods : Subtract one 40-bit number from a subfield of C- another 40-bit number. Specialized for use with a 40-bit subtraction C- algorithm. C- C- A[39:A_RIGHTBIT] = A[39:A_RIGHTBIT] - B C- C- A and B are 40-bit numbers. C- C- C- Inputs : AGIGAS (*Modified*) A / 2**30 C- AUNITS (*Modified*) MOD(A, 2**30) C- A_RIGHTBIT The rightmost bit of A to consider C- C- BGIGAS B / 2**30 C- BUNITS MOD(B, 2**30) C- C- Outputs : AGIGAS, AUNITS C- Controls: none C- C- Created 13-MAY-1992 Philippe Laurens, Steven Klocek C- C---------------------------------------------------------------------- IMPLICIT NONE C INTEGER AGIGAS, AUNITS INTEGER A_RIGHTBIT INTEGER BGIGAS, BUNITS C INTEGER TGIGAS, TUNITS INTEGER RGIGAS, RUNITS C TGIGAS = 0 TUNITS = 0 C IF (A_RIGHTBIT .LT. 10) TGIGAS = ISHFT(AGIGAS, -A_RIGHTBIT) IF (A_RIGHTBIT .LT. 30) TUNITS = ISHFT(AUNITS, -A_RIGHTBIT) C IF (A_RIGHTBIT .GT. 0) THEN CALL MVBITS(AGIGAS, MAX(0, A_RIGHTBIT-30), MIN(10, A_RIGHTBIT), & TUNITS, MAX(0, 30-A_RIGHTBIT) ) ENDIF C CALL MONSUB40(TGIGAS, TUNITS, BGIGAS, BUNITS, RGIGAS, RUNITS) C IF (A_RIGHTBIT .LT. 10) THEN CALL MVBITS(RGIGAS, 0, 10 - A_RIGHTBIT, AGIGAS, A_RIGHTBIT ) ENDIF C IF (A_RIGHTBIT .GT. 0) THEN CALL MVBITS(RUNITS, MAX(0, 30-A_RIGHTBIT), & MIN(A_RIGHTBIT, 10) - IDIM(A_RIGHTBIT, 30), & AGIGAS, MAX(0, A_RIGHTBIT-30) ) ENDIF C IF (A_RIGHTBIT .LT. 30) THEN CALL MVBITS(RUNITS, 0, 30-A_RIGHTBIT, AUNITS, A_RIGHTBIT) ENDIF C---------------------------------------------------------------------- 999 RETURN END