MINICERN/packlib/kernlib/kerngen/tcgen/vaxgs/ie3fodv.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:49:59  mclareni
   6 * Kernlib
   7 *
   8 *
   9       SUBROUTINE IE3FOD (MS,MT,NDPN,JBAD)
  10 C
  11 C CERN PROGLIB# M220    IE3FOD          .VERSION KERNVAX  2.20  861204
  12
  13 C-    Convert double precision for output with copy
  14 C-    from source in native to target in IEEE data format
  15
  16       DIMENSION    MS(99), MT(99)
  17
  18       DOUBLE PRECISION   THDB
  19       DIMENSION    THIS(2)
  20       EQUIVALENCE  (THDB,THIS)
  21       EQUIVALENCE  (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
  22
  23       PARAMETER    (MSKB16 = '00008000'X)
  24       PARAMETER    (IBADCS = '7F80FE00'X)
  25       PARAMETER    (IBADCD = '7FF01FC0'X)
  26       PARAMETER    (IOVPCS = '7F800000'X)
  27       PARAMETER    (IOVPCD = '7FF00000'X)
  28       PARAMETER    (IOVNCS = 'FF800000'X)
  29       PARAMETER    (IOVNCD = 'FFF00000'X)
  30
  31
  32       JFAI = 0
  33       JMS  = 0
  34       JMT  = 0
  35
  36       DO 449  JL=1,NDPN
  37       ITHA = MS(JMS+1)
  38       IF (ITHA.EQ.0)         GO TO 442
  39       ITHB  = MS(JMS+2)
  40       JSIGN = ITHA .AND. MSKB16
  41       JEXP  = JIBITS (ITHA,7,8)
  42       IF (JEXP.EQ.0)         GO TO 431
  43       IF (JEXP.EQ.255)       GO TO 433
  44       JMANT = JISHFT (JIBITS(ITHA, 0, 7), 13) .OR. JIBITS(ITHA,19,13)
  45       ITHB  = JISHFT (JIBITS(ITHA,16, 3), 29) .OR.
  46      +        JISHFT (JIBITS(ITHB, 0,16), 13) .OR.
  47      +                JIBITS(ITHB,19,13)
  48       ITHA  = JISHFT(JSIGN,16) .OR. JISHFT(JEXP+894,20) .OR. JMANT
  49       GO TO 447
  50
  51 C--      zero / NaN
  52   431 IF (JSIGN.EQ.0)        GO TO 441
  53       ITHB = IBADCD
  54       GO TO 436
  55
  56 C--      overflow
  57   433 IF (JSIGN.EQ.0)    THEN
  58           ITHB = IOVPCD
  59         ELSE
  60           ITHB = IOVNCD
  61         ENDIF
  62   436 JFAI = JL
  63       ITHA = ITHB
  64       GO TO 442
  65
  66   441 ITHA = 0
  67   442 ITHB = 0
  68   447 MT(JMT+1) = ITHA
  69       MT(JMT+2) = ITHB
  70       JMT = JMT + 2
  71   449 JMS = JMS + 2
  72
  73       JBAD = JFAI
  74       RETURN
  75       END