      SUBROUTINE BF1I64B(IEEEF,BF,NF)
C
C     * JUL 07/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)
C     * JUL 23/92 - J. STACEY - CORRECT NORMALIZATION OF IBM NUMBERS.
C     * JUL 21/92 - J. STACEY - CORRECT SHIFT OF LEAST SIGNIFICANT BITS.
C     * MAY 22/92 - J. STACEY - REMOVE ASSUMPTION THAT INTEGER ARRAYS
C     *                         ARE 64-BITS IN NATIVE FORMAT.
C     * APR 15/92 - J. STACEY -
C     *
C     * CONVERT FLOATING POINT, IEEE 64-BIT TO IBM 64-BIT.  THIS ROUTINE
C     * ASSUMES THAT BOTH "BF" AND "IEEEF" ARE 64-BITS IN NATIVE MODE.
C
      IMPLICIT INTEGER (A-Z)
      INTEGER      BF(1),IEEEF(1)
      INTEGER      IZERO
      REAL*8       ZERO
      LOGICAL      ERROR
      EQUIVALENCE (ZERO,IZERO)
      COMMON /MACHTYP/ MACHINE,INTSIZE
      DATA         ZERO/0.0E0/
C--------------------------------------------------------------------
      MASK2 = IBITS(-1,0,7)            !7 BIT MASK FOR IBM EXPONENT.
      MASK4 = IBITS(-1,0,4)            !4 BIT MASK FOR FIRST HEX DIGIT.
      MASK5 = IBITS(-1,0,11)           !11 BIT MASK FOR IEEE EXPONENT.

      IF (INTSIZE .EQ. 1) THEN   !64-BIT MACHINE.
      MBSE0 = 0
      MBSE63 = 63
      MASK1 = IBSET(MBSE0,MBSE63)       !1 BIT MASK FOR SIGN BIT.
      MBITM1 = -1
      MBIT0 = 0
      MBIT52 = 52
      MASK3 = IBITS(MBITM1,MBIT0,MBIT52) !52 BIT MASK FOR IEEE MANTISSA.
      MBSE0 = 0
      MBSE52 = 52
      IMPLIED = IBSET(MBSE0,MBSE52) !IMPLIED ON BIT IN IEEE MANTISSA.
      DO 100 I=1,NF
        IF (IEEEF(I) .NE. 0) THEN
          MSHFM52 = -52
          IBMEXP = IAND(ISHFT(IEEEF(I),MSHFM52),MASK5) - 1023 + 1
          IMOVE  = MOD(IBMEXP,4)
          IF (IMOVE .LE. 0) THEN
          IMOVE  = IMOVE + 4
          IBMEXP = IBMEXP/4 + 64
          ELSE
          IBMEXP = IBMEXP/4 + 64 + 1
          ENDIF
          MSHF56 = 56
          BF(I)  = IOR(IOR(
     1             IAND(IEEEF(I),MASK1),
     2             ISHFT(IAND(IBMEXP,MASK2),MSHF56)
     3                     ),
     4             ISHFT(IAND(IEEEF(I),MASK3)+IMPLIED,IMOVE-1)
     5                     )
        ELSE
            BF(I)  = IZERO
        END IF
  100 CONTINUE
      ELSE                      !32-BIT INTEGERS WITH 64-BIT REALS.
      MBSE0 = 0
      MBSE31 = 31
      MASK1 = IBSET(MBSE0,MBSE31)       !1 BIT MASK FOR SIGN BIT.
      MASK3 = IBITS(-1,0,20)            !20 BIT MASK FOR IEEE MANTISSA.
      MBSE0 = 0
      MBSE20 = 20
      IMPLIED = IBSET(MBSE0,MBSE20)  !IMPLIED ON BIT IN IEEE MANTISSA.
      DO 101 I=1,NF*2,2
        IF (IEEEF(I) .NE. 0 .OR. IEEEF(I+1) .NE. 0) THEN
          MSHFM20 = -20
          IBMEXP = IAND(ISHFT(IEEEF(I),MSHFM20),MASK5) - 1023 + 1
          IMOVE  = MOD(IBMEXP,4)
          IF (IMOVE .LE. 0) THEN
          IMOVE = IMOVE + 4
          IBMEXP = IBMEXP/4 + 64
          ELSE
          IBMEXP = IBMEXP/4 + 64 + 1
          ENDIF
          MASK0  = IBITS(-1,0,IMOVE)
          ITEMP  = IEEEF(I+1)
CBUG      BF(I)  = IOR(IOR(
CBUG 1             IAND(IEEEF(I),MASK1),
CBUG 2             ISHFT(IAND(IBMEXP,MASK2),24)
CBUG 3                     ),
CBUG 4             ISHFT(IAND(IEEEF(I),MASK3)+IMPLIED,IMOVE)
CBUG 5                 )
          MSHF24 = 24
          BF(I)  = IOR(IOR(IOR(
     1             IAND(IEEEF(I),MASK1),
     2             ISHFT(IAND(IBMEXP,MASK2),MSHF24)
     3                         ),
     4             ISHFT(IAND(IEEEF(I),MASK3)+IMPLIED,IMOVE-1)
     5                     ),
     6             IAND(ISHFT(ITEMP,-32+IMOVE-1),MASK0)
     7                 )
          BF(I+1) = IAND(ISHFT(ITEMP,IMOVE-1),ISHFT(-1,IMOVE-1))
        ELSE
          BF(I)   = IZERO
          BF(I+1) = 0
        END IF
  101 CONTINUE
      END IF

C     * HANDLE 0.0, UNDERFLOW AND OVERFLOW :
C     *
C     * IF THE EXPONENT FIELD GOES NEGATIVE THEN THE IEEE NUMBER WAS
C     * EITHER 0.0 OR TOO SMALL TO REPRESENT IN IBM, IN EITHER CASE
C     * SET THE IBM RESULT TO 0.0.
C     *
C     * IF THE EXPONENT FIELD OVERFLOWS, CALL ABORT.

      ERROR = .FALSE.
      IF (INTSIZE .EQ. 1) THEN
        JSHFT = -52
      ELSE
        JSHFT = -20
      END IF
      DO 200 I=1,NF*INTSIZE,INTSIZE
          IBMEXP = IAND(ISHFT(IEEEF(I),JSHFT),MASK5) - 1023 + 1
          IMOVE = MOD ( IBMEXP,4)
          IF (IMOVE .LE. 0) THEN
          IMOVE  = IMOVE + 4
          IBMEXP = IBMEXP/4 + 64
          ELSE
          IBMEXP = IBMEXP/4 + 64 + 1
          ENDIF
          IF (IBMEXP .LT. 0) THEN
            BF(I) = IZERO
            IF (INTSIZE .EQ. 2) BF(I+1) = 0
          ELSE IF (IBMEXP .GT. MASK2) THEN
            ERROR = .TRUE.
          END IF
  200 CONTINUE
 
      IF (.NOT. ERROR) RETURN
      WRITE(6,6100)
 6100 FORMAT('0 *ERROR* BF1I64B: IEEE EXPONENT OUT OF RANGE FOR IBM.')
      CALL ABORT
      END
