*
* $Id: fzocxff.inc,v 1.1.1.1 1996/03/06 10:47:10 mclareni Exp $
*
* $Log: fzocxff.inc,v $
* 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