*
* $Id: ie3tod.F,v 1.1.1.1 1996/02/15 17:52:16 mclareni Exp $
*
* $Log: ie3tod.F,v $
* Revision 1.1.1.1  1996/02/15 17:52:16  mclareni
* Kernlib
*
*
#include "sys/CERNLIB_machine.h"
#include "pilot.h"
      SUBROUTINE IE3TOD (MS,MT,NDPN,JBAD)
C
C CERN PROGLIB# M220    IE3TOD          .VERSION KERNCVX  1.09  910815
C Orig. 31/05/89  JZ

C-    Convert double precision from input with copy
C-    from source in IEEE to target in native REAL*8 format

      DIMENSION    MS(99), MT(99)

      INTEGER*8    MTHIS(2), ITHA, ITHB
      EQUIVALENCE (ITHA,MTHIS(1)), (ITHB,MTHIS(2))

      PARAMETER    (MSK20R = '00000000000FFFFF'X)
      PARAMETER    (MSKEXP = '000000007FF00000'X)
      PARAMETER    (IOVPMD = '7FF7FFFFFFFFFFFF'X)
      PARAMETER    (IOVNMD = 'FFF7FFFFFFFFFFFF'X)
      PARAMETER    (IBADMD = '80007FFFFFFFFFFF'X)


      JFAI = 0
      JMS  = 0
      JMT  = 0

      DO 449  JL=1,NDPN
      ITHA  = MS(JMS+1)
      IF (ITHA.EQ.0)               GO TO 447
      ITHB  = MS(JMS+2)
      JSIGN = ishft (ITHA, -31)
      JEXP  = ishft (ITHA.AND.MSKEXP, -20)
      JMANT = ITHA .AND. MSK20R
      IF (JEXP.EQ.0)               GO TO 441
      IF (JEXP.EQ.2047)            GO TO 433
      IF (JEXP.EQ.2046)            GO TO 434

      JEXP  = JEXP + 2
      ITHA  = ISHFT (JSIGN,63) .OR.
     +        ISHFT (JEXP,52)  .OR.
     +        ISHFT (JMANT,32) .OR.
     +        ITHB
      GO TO 447

C--       overflow
  433 IF (JMANT.NE.0)              GO TO 435
  434 IF (JSIGN.EQ.0)  THEN
          ITHA = IOVPMD
        ELSE
          ITHA = IOVNMD
        ENDIF
      GO TO 437

C--       NaN
  435 ITHA = IBADMD
  437 JFAI = JL
      GO TO 447

  441 ITHA = 0
  447 MT(JMT+1) = ITHA
      MT(JMT+2) = 0
      JMT = JMT + 2
  449 JMS = JMS + 2

      JBAD = JFAI
      RETURN
      END
#ifdef CERNLIB_TCGEN_IE3TOD
#undef CERNLIB_TCGEN_IE3TOD
#endif