[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / fq / fzocxff.inc

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/03/06 10:47:10  mclareni
* Zebra
*
*
*   cv single-pr. F from CRAY -> IEEE
*
* fzocxff.inc
*
#if defined(CERNLIB_QMCRY)
C--      Cray single-pr. to IEEE single
  301 DO 349  JL=1,NWDO
      ITHA = MS(JMS+1)
      IF (ITHA.EQ.0)               GO TO 347
      JSIGN = SHIFTR (MASK(1).AND.ITHA, 32)
      JEXP  = SHIFTR (SHIFTL(ITHA,1), 49)
      JEXP  = JEXP - 40000B + 126
      JMANT = MASK(128-24) .AND. SHIFTR(ITHA,23)
      IF (JMANT.EQ.MASK(128-24))  THEN
          JMANT = 0
          JEXP  = JEXP + 1
        ELSE
          JMANT = SHIFTR(JMANT+1,1)
        ENDIF
      IF (JEXP.LE.0)               GO TO 331
      IF (JEXP.GE.255)             GO TO 333
      ITHA  = JSIGN .OR. SHIFTL(JEXP,23) .OR. JMANT
      GO TO 347

C--      make de-normalized number
  331 IF (JEXP.LT.-23)             GO TO 341
      JMANT = SHIFTR (JMANT+40000000B,1-JEXP)
      ITHA  = JSIGN .OR. JMANT
      GO TO 347

C--      overflow
  333 IFOCON(1) = 3
      IFOCON(2) = JMS
      IFOCON(3) = ITHA
      IF (JSIGN.EQ.0)    THEN
          ITHA = IOVPCS
        ELSE
          ITHA = IOVNCS
        ENDIF
      GO TO 347

  341 ITHA = 0
  347 MT(JMT+1) = ITHA
      JMT = JMT + 1
  349 JMS = JMS + 1
      GO TO 801
#endif
*   cv single-pr. F from ND -> IEEE
*
* fzocxff.inc
*
#if defined(CERNLIB_QMND3)
C--      NORD single-precision to IEEE single
  301 DO 349  JL=1,NWDO
      ITHA = MS(JMS+1)
      IF (ITHA.EQ.0)               GO TO 347
      JSIGN = ISHFT (ITHA,-31)
      JEXP  = ISHFT (ISHFT(ITHA,1), -23)
      JEXP  = JEXP - 130
      IF (JEXP.LE.0)               GO TO 331
      IF (JEXP.GE.255)             GO TO 333
      JMANT = ISHFT (ISHFT(ITHA,10), -9)
      ITHA  = ISHFT(JSIGN,31) .OR. ISHFT(JEXP,23) .OR. JMANT
      GO TO 347

C--      make de-normalized number
  331 IF (JEXP.LE.-23)             GO TO 341
      ITHA = ITHA .OR. 20000000 B
      ITHA = ISHFT (ISHFT(ITHA,9),JEXP-9)
      ITHA = ITHA .OR. ISHFT(JSIGN,31)
      GO TO 347

C--      overflow
  333 IFOCON(1) = 3
      IFOCON(2) = JMS
      IFOCON(3) = ITHA
      IF (ITHA.NE.IBADMS)  THEN
          IF (JSIGN.EQ.0)    THEN
              ITHA = IOVPCS
            ELSE
              ITHA = IOVNCS
            ENDIF
        ELSE
          ITHA = IBADCS
        ENDIF
      GO TO 347

  341 ITHA = 0
  347 MT(JMT+1) = ITHA
      JMT = JMT + 1
  349 JMS = JMS + 1
      GO TO 801
#endif
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1996/03/06 10:47:10 mclareni
	6	* Zebra
	7	*
	8	*
	9	* cv single-pr. F from CRAY -> IEEE
	10	*
	11	* fzocxff.inc
	12	*
	13	#if defined(CERNLIB_QMCRY)
	14	C-- Cray single-pr. to IEEE single
	15	301 DO 349 JL=1,NWDO
	16	ITHA = MS(JMS+1)
	17	IF (ITHA.EQ.0) GO TO 347
	18	JSIGN = SHIFTR (MASK(1).AND.ITHA, 32)
	19	JEXP = SHIFTR (SHIFTL(ITHA,1), 49)
	20	JEXP = JEXP - 40000B + 126
	21	JMANT = MASK(128-24) .AND. SHIFTR(ITHA,23)
	22	IF (JMANT.EQ.MASK(128-24)) THEN
	23	JMANT = 0
	24	JEXP = JEXP + 1
	25	ELSE
	26	JMANT = SHIFTR(JMANT+1,1)
	27	ENDIF
	28	IF (JEXP.LE.0) GO TO 331
	29	IF (JEXP.GE.255) GO TO 333
	30	ITHA = JSIGN .OR. SHIFTL(JEXP,23) .OR. JMANT
	31	GO TO 347
	32
	33	C-- make de-normalized number
	34	331 IF (JEXP.LT.-23) GO TO 341
	35	JMANT = SHIFTR (JMANT+40000000B,1-JEXP)
	36	ITHA = JSIGN .OR. JMANT
	37	GO TO 347
	38
	39	C-- overflow
	40	333 IFOCON(1) = 3
	41	IFOCON(2) = JMS
	42	IFOCON(3) = ITHA
	43	IF (JSIGN.EQ.0) THEN
	44	ITHA = IOVPCS
	45	ELSE
	46	ITHA = IOVNCS
	47	ENDIF
	48	GO TO 347
	49
	50	341 ITHA = 0
	51	347 MT(JMT+1) = ITHA
	52	JMT = JMT + 1
	53	349 JMS = JMS + 1
	54	GO TO 801
	55	#endif
	56	* cv single-pr. F from ND -> IEEE
	57	*
	58	* fzocxff.inc
	59	*
	60	#if defined(CERNLIB_QMND3)
	61	C-- NORD single-precision to IEEE single
	62	301 DO 349 JL=1,NWDO
	63	ITHA = MS(JMS+1)
	64	IF (ITHA.EQ.0) GO TO 347
65	JSIGN = ISHFT (ITHA,-31)
66	JEXP = ISHFT (ISHFT(ITHA,1), -23)
67	JEXP = JEXP - 130
68	IF (JEXP.LE.0) GO TO 331
69	IF (JEXP.GE.255) GO TO 333
70	JMANT = ISHFT (ISHFT(ITHA,10), -9)
71	ITHA = ISHFT(JSIGN,31) .OR. ISHFT(JEXP,23) .OR. JMANT
72	GO TO 347
73
74	C-- make de-normalized number
75	331 IF (JEXP.LE.-23) GO TO 341
76	ITHA = ITHA .OR. 20000000 B
77	ITHA = ISHFT (ISHFT(ITHA,9),JEXP-9)
78	ITHA = ITHA .OR. ISHFT(JSIGN,31)
79	GO TO 347
80
81	C-- overflow
82	333 IFOCON(1) = 3
83	IFOCON(2) = JMS
84	IFOCON(3) = ITHA
85	IF (ITHA.NE.IBADMS) THEN
86	IF (JSIGN.EQ.0) THEN
87	ITHA = IOVPCS
88	ELSE
89	ITHA = IOVNCS
90	ENDIF
91	ELSE
92	ITHA = IBADCS
93	ENDIF
94	GO TO 347
95
96	341 ITHA = 0
97	347 MT(JMT+1) = ITHA
98	JMT = JMT + 1
99	349 JMS = JMS + 1
100	GO TO 801
101	#endif