[u/mrichter/AliRoot.git] / MINICERN / packlib / kernlib / kerngen / tcgens / vaxgs / ie3tos.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/02/15 17:50:23  mclareni
* Kernlib
*
*
      SUBROUTINE IE3TOS (MS,MT,NWDO,JBAD)
C
C CERN PROGLIB# M220    IE3TOS          .VERSION KERNVAX  2.25  880302

C-    Convert single precision for input with copy
C-    from source in IEEE to target in native 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    (JEXMIN = -127,  JEXMAX=125)
      PARAMETER    (IOVPMS = '00007F81'X)
      PARAMETER    (IOVNMS = '0000FF81'X)
      PARAMETER    (IBADMS = '00008001'X)
      PARAMETER    (IBADMD = IBADMS, IBADME = 0)
      PARAMETER    (IOVPMD = IOVPMS, IOVNMD = IOVNMS)

#include "kerngen/q_jbit.inc"

      JBAD = 0
      JMS  = 0
      JMT  = 0

  301 DO 349  JL=1,NWDO
      ITHA = MS(JMS+1)
      IF (ITHA.EQ.0)         GO TO 347
      JSIGN = JBIT (ITHA,32)
      JEXP  = JBYT (ITHA,24,8)
      JMANT = JBYT (ITHA,1,23)
      IF (JEXP.EQ.0)         GO TO 331
      IF (JEXP.EQ.255)       GO TO 333
      JEXP  = JEXP - 127
      IF (JEXP.LT.JEXMIN)    GO TO 341
      IF (JEXP.GT.JEXMAX)    GO TO 332
      JPRE  = ISIGN (23,JEXP)
      JMANT = JMANT + 8 388 608
      THA   = FLOAT(JMANT) * 2.**(JPRE-23)
      THA   = THA * 2.**(JEXP-JPRE)
      IF (JSIGN.EQ.0)        GO TO 347
      THA  = -THA
      GO TO 347

  331 IF (JMANT.EQ.0)        GO TO 341
      THA  = FLOAT(JMANT) * 2.**(-63)
      THA  = THA * 2.**(-86)
      IF (ITHA .EQ.0)        GO TO 347
      IF (JSIGN.EQ.0)        GO TO 347
      THA  = -THA
      GO TO 347

  332 JMANT = 0
  333 IF (JMANT.EQ.0)    THEN
          IF (JSIGN.EQ.0)  THEN
              ITHB = IOVPMS
            ELSE
              ITHB = IOVNMS
            ENDIF
        ELSE
          ITHB = IBADMS
        ENDIF
      JBAD = JL
      ITHA = ITHB
      GO TO 347

  341 ITHA = 0
  347 MT(JMT+1) = ITHA
      JMT = JMT + 1
  349 JMS = JMS + 1

      RETURN
      END
Commit	Line	Data
fe4da5cc	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