MINICERN/packlib/kernlib/kerngen/tcgen/vaxgs/ie3tod.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 IE3TOD (MS,MT,NDPN,JBAD)
  10 C
  11 C CERN PROGLIB# M220    IE3TOD          .VERSION KERNVAX  2.20  861204
  12
  13 C-    Convert double precision for input with copy
  14 C-    from source in IEEE to target in native 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    (JEXMIN = -127,  JEXMAX=125)
  24       PARAMETER    (IOVPMS = '00007F81'X)
  25       PARAMETER    (IOVNMS = '0000FF81'X)
  26       PARAMETER    (IBADMS = '00008001'X)
  27       PARAMETER    (IBADMD = IBADMS, IBADME = 0)
  28       PARAMETER    (IOVPMD = IOVPMS, IOVNMD = IOVNMS)
  29
  30 #include "kerngen/q_jbit.inc"
  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 = JBIT (ITHA,32)
  41       JEXP  = JBYT (ITHA,21,11)
  42       JMANT = JBYT (ITHA, 1,20)
  43       IF (JEXP.EQ.0)         GO TO 431
  44       IF (JEXP.EQ.2047)      GO TO 433
  45
  46       JMANT = JMANT + 1 048 576
  47       JEXP  = JEXP  - 1023
  48       IF (JEXP.GT.JEXMAX)    GO TO 432
  49   424 IF (JEXP.LT.JEXMIN)    GO TO 441
  50
  51       JMANS = JBYT (ITHB,17,16)
  52       JMANR = JBYT (ITHB, 1,16)
  53
  54       JPRE  = ISIGN (48,JEXP)
  55       THDB  = (  DBLE(JMANT)
  56      +         + DBLE(FLOAT(JMANS)*2.**(-16))
  57      +         + DBLE(FLOAT(JMANR)*2.**(-32)) ) * 2.**(JPRE-20)
  58       THDB  = THDB * 2.**(JEXP-JPRE)
  59       IF (JSIGN.EQ.0)        GO TO 447
  60       THDB = -THDB
  61       GO TO 447
  62
  63   431 IF (JMANT.EQ.0)        GO TO 441
  64       JEXP = -1022
  65       GO TO 424
  66
  67   432 JMANT = 0
  68   433 IF (JMANT.EQ.0)    THEN
  69           IF (JSIGN.EQ.0)  THEN
  70               ITHB = IOVPMD
  71             ELSE
  72               ITHB = IOVNMD
  73             ENDIF
  74         ELSE
  75           ITHB = IBADMD
  76         ENDIF
  77       JFAI = JL
  78       ITHA = ITHB
  79       ITHB = IBADME
  80       GO TO 447
  81
  82   441 ITHA = 0
  83   442 ITHB = 0
  84   447 MT(JMT+1) = ITHA
  85       MT(JMT+2) = ITHB
  86       JMT = JMT + 2
  87   449 JMS = JMS + 2
  88
  89       JBAD = JFAI
  90       RETURN
  91       END