MINICERN/packlib/kernlib/kerngen/tcgens/vaxgs/ie3tos.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:50:23  mclareni
   6 * Kernlib
   7 *
   8 *
   9       SUBROUTINE IE3TOS (MS,MT,NWDO,JBAD)
  10 C
  11 C CERN PROGLIB# M220    IE3TOS          .VERSION KERNVAX  2.25  880302
  12
  13 C-    Convert single 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       JBAD = 0
  33       JMS  = 0
  34       JMT  = 0
  35
  36   301 DO 349  JL=1,NWDO
  37       ITHA = MS(JMS+1)
  38       IF (ITHA.EQ.0)         GO TO 347
  39       JSIGN = JBIT (ITHA,32)
  40       JEXP  = JBYT (ITHA,24,8)
  41       JMANT = JBYT (ITHA,1,23)
  42       IF (JEXP.EQ.0)         GO TO 331
  43       IF (JEXP.EQ.255)       GO TO 333
  44       JEXP  = JEXP - 127
  45       IF (JEXP.LT.JEXMIN)    GO TO 341
  46       IF (JEXP.GT.JEXMAX)    GO TO 332
  47       JPRE  = ISIGN (23,JEXP)
  48       JMANT = JMANT + 8 388 608
  49       THA   = FLOAT(JMANT) * 2.**(JPRE-23)
  50       THA   = THA * 2.**(JEXP-JPRE)
  51       IF (JSIGN.EQ.0)        GO TO 347
  52       THA  = -THA
  53       GO TO 347
  54
  55   331 IF (JMANT.EQ.0)        GO TO 341
  56       THA  = FLOAT(JMANT) * 2.**(-63)
  57       THA  = THA * 2.**(-86)
  58       IF (ITHA .EQ.0)        GO TO 347
  59       IF (JSIGN.EQ.0)        GO TO 347
  60       THA  = -THA
  61       GO TO 347
  62
  63   332 JMANT = 0
  64   333 IF (JMANT.EQ.0)    THEN
  65           IF (JSIGN.EQ.0)  THEN
  66               ITHB = IOVPMS
  67             ELSE
  68               ITHB = IOVNMS
  69             ENDIF
  70         ELSE
  71           ITHB = IBADMS
  72         ENDIF
  73       JBAD = JL
  74       ITHA = ITHB
  75       GO TO 347
  76
  77   341 ITHA = 0
  78   347 MT(JMT+1) = ITHA
  79       JMT = JMT + 1
  80   349 JMS = JMS + 1
  81
  82       RETURN
  83       END