+++ /dev/null
-*
-* $Id$
-*
-* $Log$
-* Revision 1.1.1.1 1996/02/15 17:49:59 mclareni
-* Kernlib
-*
-*
- SUBROUTINE IE3FOD (MS,MT,NDPN,JBAD)
-C
-C CERN PROGLIB# M220 IE3FOD .VERSION KERNVAX 2.20 861204
-
-C- Convert double precision for output with copy
-C- from source in native to target in IEEE data format
-
- DIMENSION MS(99), MT(99)
-
- DOUBLE PRECISION THDB
- DIMENSION THIS(2)
- EQUIVALENCE (THDB,THIS)
- EQUIVALENCE (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
-
- PARAMETER (MSKB16 = '00008000'X)
- PARAMETER (IBADCS = '7F80FE00'X)
- PARAMETER (IBADCD = '7FF01FC0'X)
- PARAMETER (IOVPCS = '7F800000'X)
- PARAMETER (IOVPCD = '7FF00000'X)
- PARAMETER (IOVNCS = 'FF800000'X)
- PARAMETER (IOVNCD = 'FFF00000'X)
-
-
- JFAI = 0
- JMS = 0
- JMT = 0
-
- DO 449 JL=1,NDPN
- ITHA = MS(JMS+1)
- IF (ITHA.EQ.0) GO TO 442
- ITHB = MS(JMS+2)
- JSIGN = ITHA .AND. MSKB16
- JEXP = JIBITS (ITHA,7,8)
- IF (JEXP.EQ.0) GO TO 431
- IF (JEXP.EQ.255) GO TO 433
- JMANT = JISHFT (JIBITS(ITHA, 0, 7), 13) .OR. JIBITS(ITHA,19,13)
- ITHB = JISHFT (JIBITS(ITHA,16, 3), 29) .OR.
- + JISHFT (JIBITS(ITHB, 0,16), 13) .OR.
- + JIBITS(ITHB,19,13)
- ITHA = JISHFT(JSIGN,16) .OR. JISHFT(JEXP+894,20) .OR. JMANT
- GO TO 447
-
-C-- zero / NaN
- 431 IF (JSIGN.EQ.0) GO TO 441
- ITHB = IBADCD
- GO TO 436
-
-C-- overflow
- 433 IF (JSIGN.EQ.0) THEN
- ITHB = IOVPCD
- ELSE
- ITHB = IOVNCD
- ENDIF
- 436 JFAI = JL
- ITHA = ITHB
- GO TO 442
-
- 441 ITHA = 0
- 442 ITHB = 0
- 447 MT(JMT+1) = ITHA
- MT(JMT+2) = ITHB
- JMT = JMT + 2
- 449 JMS = JMS + 2
-
- JBAD = JFAI
- RETURN
- END