      SUBROUTINE ENCODR2(IEEEF,X)
C
C     * JUL 07/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)
C     * DEC 06/00 - F. MAJAESS - ENSURE IEEE "NEGATIVE ZERO" (IF ANY)
C     *                          CONVERTED INTO IEEE 64-BIT
C     *                          "POSITIVE ZERO" SINCE WITHOUT THIS FIX
C     *                          THE CONVERSION ROUTINES MAY RECOVER
C     *                          INCORRECT RESULTS (SUCH AS -2.0 WHEN
C     *                          RECONVERTING INTO 32-BIT IEEE).
C     * APR 15/92 - J. STACEY - REWRITE OF ENCODR FUNCTION, CONVERTED TO
C     *                         SUBROUTINE CALL TO ALLOW WRITING OF 64-
C     *                         BIT INTEGER CONSTANTS IN "IEEEF" EVEN ON
C     *                         32-BIT MACHINES.
C     *
C     * PURPOSE: THE FLOATING POINT CONSTANT PASSED IN "X" IS CONVERTED
C     *          TO A 64-BIT IEEE REAL*8 VALUE BEFORE BEING PASSED BACK
C     *          TO THE CALLING ROUTINE EITHER AS 2 CONSECUTIVE 32-BIT
C     *          INTEGERS IN "IEEEF" (ON 32-BIT MACHINES) OR AS 1 64-BIT
C     *          INTEGER IN "IEEEF" (ON 64-BIT MACHINES).
C
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)
      DIMENSION IEEEF(*)
C
C     * INTEGER REPRESENTATIONS FOR THE HIGH ORDER 32-BITS OF SQRT(2)
C     * ARE DIFFERENT ON IBM, CRAY AND IEEE MACHINES.  WE USE THIS TO
C     * TEST FOR THE EXACT TYPE OF MACHINE BEFORE CONVERTING TO THE
C     * STANDARD.
C
      PARAMETER  ( IAMIBM=1092001950)
      PARAMETER  (IAMCRAY=1073853700)
      PARAMETER  (IAMIEEE=1073127582)
      REAL*8     A,B
      INTEGER    IA(2),JB
      EQUIVALENCE (A,IA),(B,JB)
      LOGICAL    IBM,CRAY,IEEE,IM64BIT,INTEST2
      DIMENSION  DATUM(2)
      INTEGER    IDATUM(2)
      EQUIVALENCE (DATUM,IDATUM)
      COMMON /MACHTYP/ MACHINE,INTSIZE
C---------------------------------------------------------------------------
C     * USE THE STANDARD TRICK TO SEE IF WE HAVE 32- OR 64-BIT INTEGERS.
C
      IA(2) = 0
      B = 0.D0
      A          = DSQRT(2.0D0)
      JB         = IA(1)
      IF (A .EQ. B) THEN
        IM64BIT  = .TRUE.
        MSHFM32 = -32
        JB = ISHFT(JB,MSHFM32)
      ELSE
        IM64BIT  = .FALSE.
      END IF
C
C     * TEST FOR IBM, CRAY OR IEEE MACHINE.
C
      IBM        = JB .EQ. IAMIBM
      CRAY       = JB .EQ. IAMCRAY
      IEEE       = JB .EQ. IAMIEEE
C     TEST FOR IEEE ON LITTLE-ENDIAN 32-BIT INTEGER MACHINES
      IF(.NOT.IEEE.AND..NOT.IM64BIT) IEEE = IA(2) .EQ. IAMIEEE
      INTEST2   = INTSIZE .EQ. 2
C
C     * NOW BRANCH ON TYPE OF MACHINE.
C
      IF (IBM  .AND. IM64BIT) THEN
        DATUM(1) = X
        IEEEF(1) = 0
        CALL BF1BI64(IDATUM,IEEEF,1)
        RETURN
      END IF

      IF (IBM .AND. .NOT.IM64BIT) THEN
         IF (.NOT.INTEST2) THEN !32' INTEGERS/32' REALS.
            DATUM(1) = X
            IEEEF(1) = 0
            IEEEF(2) = 0
            CALL BF2BI64(IDATUM,IEEEF,1)
         ELSE                   !32' INTEGERS/64' REALS.
            DATUM(1) = X
            IEEEF(1) = 0
            IEEEF(2) = 0
            CALL BF1BI64(IDATUM,IEEEF,1)
         END IF
         RETURN
      END IF

      IF (CRAY) THEN
        DATUM(1) = X
        IEEEF(1) = 0
        CALL CF1CI64(IDATUM,IEEEF,1)
        RETURN
      END IF

      IF (IEEE .AND. IM64BIT) THEN
        MBSE0 = 0
        MBSE63 = 63
        MASKX = IBSET(MBSE0,MBSE63)
        DATUM(1) = X
        IEEEF(1) = IDATUM(1)
        MSHF1 = 1
        IF(IEEEF(1).EQ.MASKX) IEEEF(1)=ISHFT(MASKX,MSHF1)
        RETURN
      END IF

      IF (IEEE .AND. .NOT.IM64BIT) THEN
        MBSE0 = 0
        MBSE31 = 31
        MASK1 = IBSET(MBSE0,MBSE31) !1 BIT MASK FOR SIGN BIT.
        MASK2 = IBITS(-1,0,8)     !8 BIT MASK FOR IEEE 32' EXPONENT.
        MASK3 = IBITS(-1,0,20)    !20 BIT MASK FOR IEEE 32' MANTISSA.
        MASK4 = IBITS(-1,0,3)     !3 BIT MASK FOR 3' OF IEEE MANTISSA.
        MASK5 = IBITS(-1,0,11)    !11 BIT MASK FOR IEEE 64' EXPONENT.
        IF (.NOT.INTEST2) THEN !INTEGERS ARE 32', REALS ARE 32'.
          DATUM(1) = X
C         IF (DATUM(1) .NE. 0.0) THEN
          IF (IDATUM(1) .NE. 0 .AND. IDATUM(1) .NE. MASK1) THEN
            MSHF20 = 20
            MSHFM3 = -3
            IEEEF(1) = IOR(IOR(
     1              IAND(IDATUM(1),MASK1),
     2              ISHFT(IAND(IBITS(IDATUM(1),23,8)-127+1023,MASK5),
     2              MSHF20)
     3                        ),
     4              IAND(ISHFT(IDATUM(1),MSHFM3),MASK3)
     5                        )
            MSHF29 = 29
            IEEEF(2) = ISHFT(IAND(IDATUM(1),MASK4),MSHF29)
          ELSE
            IEEEF(1)     = 0
            IEEEF(2)     = 0
          END IF
        ELSE                   !INTEGERS ARE 32', REALS ARE 64'.
          DATUM(1)     = X
          IEEEF(1)     = IDATUM(1)
          IEEEF(2)     = IDATUM(2)
          MSHF1 = 1
          IF(IEEEF(1).EQ.MASK1 .AND. IEEEF(2).EQ.0 )
     1                             IEEEF(1)=ISHFT(MASK1,MSHF1)
        END IF
        RETURN
      END IF

C     * IF WE GET HERE THEN WE HAVE A FATAL ERROR (WE DON'T KNOW WHAT MACHINE
C     * WE'RE ON).

      WRITE(6,6100)
 6100 FORMAT('0 *** ERROR *** ENCODR2: UNKNOWN MACHINE FORMAT.')
      CALL ABORT
      END
