| 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 double-pr. F from CRAY -> IEEE |
| 10 | * |
| 11 | * fzocxfd.inc |
| 12 | * |
| 13 | #if defined(CERNLIB_QMCRY) |
| 14 | C-- Cray single-pr. to IEEE double, ignoring 2nd word |
| 15 | C- for the moment (loss of 5 bits) |
| 16 | DO 449 JL=1,NWDODB,2 |
| 17 | ITHA = MS(JMS+1) |
| 18 | IF (ITHA.EQ.0) GO TO 442 |
| 19 | JSIGN = SHIFTR (MASK(1).AND.ITHA, 32) |
| 20 | JEXP = SHIFTR (SHIFTL(ITHA,1), 49) |
| 21 | JEXP = JEXP - 40000B + 1022 |
| 22 | IF (JEXP.LE.0) GO TO 441 |
| 23 | IF (JEXP.GE.2047) GO TO 433 |
| 24 | JMANT = MASK(128-20) .AND. SHIFTR (ITHA,27) |
| 25 | ITHB = SHIFTL (ITHA, 5) .AND. 37777777777B |
| 26 | ITHA = JSIGN .OR. SHIFTL(JEXP,20) .OR. JMANT |
| 27 | GO TO 447 |
| 28 | |
| 29 | C-- overflow |
| 30 | 433 IFOCON(1) = 4 |
| 31 | IFOCON(2) = JMS |
| 32 | IFOCON(3) = ITHA |
| 33 | IF (JSIGN.EQ.0) THEN |
| 34 | ITHA = IOVPCD |
| 35 | ELSE |
| 36 | ITHA = IOVNCD |
| 37 | ENDIF |
| 38 | GO TO 442 |
| 39 | |
| 40 | 441 ITHA = 0 |
| 41 | 442 ITHB = 0 |
| 42 | 447 MT(JMT+1) = ITHA |
| 43 | MT(JMT+2) = ITHB |
| 44 | JMT = JMT + 2 |
| 45 | 449 JMS = JMS + 2 |
| 46 | #endif |
| 47 | * cv double-pr. F from ND -> IEEE |
| 48 | * |
| 49 | * fzocxfd.inc |
| 50 | * |
| 51 | #if defined(CERNLIB_QMND3) |
| 52 | C-- NORD double-precision to IEEE double |
| 53 | DO 449 JL=1,NWDODB,2 |
| 54 | ITHA = MS(JMS+1) |
| 55 | IF (ITHA.EQ.0) GO TO 442 |
| 56 | ITHB = MS(JMS+2) |
| 57 | JSIGN = ISHFT (ITHA,-31) |
| 58 | JEXP = ISHFT (ISHFT(ITHA,1), -23) |
| 59 | IF (JEXP.EQ.0) GO TO 441 |
| 60 | IF (JEXP.EQ.511) GO TO 433 |
| 61 | JMANT = ISHFT (ISHFT(ITHA,10), -12) |
| 62 | ITHB = ISHFT (ITHA,30) .OR. ISHFT (ITHB,-2) |
| 63 | ITHA = ISHFT(JSIGN,31) .OR. ISHFT(JEXP+766,20) .OR. JMANT |
| 64 | GO TO 447 |
| 65 | |
| 66 | C-- overflow / NaN |
| 67 | 433 IFOCON(1) = 4 |
| 68 | IFOCON(2) = JMS |
| 69 | IFOCON(3) = ITHA |
| 70 | IF (ITHA.NE.IBADMS) THEN |
| 71 | IF (JSIGN.EQ.0) THEN |
| 72 | ITHA = IOVPCD |
| 73 | ELSE |
| 74 | ITHA = IOVNCD |
| 75 | ENDIF |
| 76 | ELSE |
| 77 | ITHA = IBADCD |
| 78 | ENDIF |
| 79 | GO TO 442 |
| 80 | |
| 81 | 441 ITHA = 0 |
| 82 | 442 ITHB = 0 |
| 83 | 447 MT(JMT+1) = ITHA |
| 84 | MT(JMT+2) = ITHB |
| 85 | JMT = JMT + 2 |
| 86 | 449 JMS = JMS + 2 |
| 87 | * -------------- sequences for input --------------------- |
| 88 | #endif |
| 89 | * cv double-pr. F from VAX -> IEEE |
| 90 | * |
| 91 | * fzocxfd.inc |
| 92 | * |
| 93 | #if defined(CERNLIB_QMVAX) |
| 94 | C-- VAX double-precision to IEEE double |
| 95 | DO 449 JL=1,NWDODB,2 |
| 96 | ITHA = MS(JMS+1) |
| 97 | IF (ITHA.EQ.0) GO TO 442 |
| 98 | ITHB = MS(JMS+2) |
| 99 | JSIGN = ITHA .AND. MSKB16 |
| 100 | JEXP = JIBITS (ITHA,7,8) |
| 101 | IF (JEXP.EQ.0) GO TO 431 |
| 102 | IF (JEXP.EQ.255) GO TO 433 |
| 103 | JMANT = JISHFT (JIBITS(ITHA, 0, 7), 13) .OR. JIBITS(ITHA,19,13) |
| 104 | ITHB = JISHFT (JIBITS(ITHA,16, 3), 29) .OR. |
| 105 | + JISHFT (JIBITS(ITHB, 0,16), 13) .OR. |
| 106 | + JIBITS(ITHB,19,13) |
| 107 | ITHA = JISHFT(JSIGN,16) .OR. JISHFT(JEXP+894,20) .OR. JMANT |
| 108 | GO TO 447 |
| 109 | |
| 110 | C-- zero / NaN |
| 111 | 431 IF (JSIGN.EQ.0) GO TO 441 |
| 112 | ITHB = IBADCD |
| 113 | GO TO 436 |
| 114 | |
| 115 | C-- overflow |
| 116 | 433 IF (JSIGN.EQ.0) THEN |
| 117 | ITHB = IOVPCD |
| 118 | ELSE |
| 119 | ITHB = IOVNCD |
| 120 | ENDIF |
| 121 | 436 IFOCON(1) = 4 |
| 122 | IFOCON(2) = JMS |
| 123 | IFOCON(3) = ITHA |
| 124 | ITHA = ITHB |
| 125 | GO TO 442 |
| 126 | |
| 127 | 441 ITHA = 0 |
| 128 | 442 ITHB = 0 |
| 129 | 447 MT(JMT+1) = ITHA |
| 130 | MT(JMT+2) = ITHB |
| 131 | JMT = JMT + 2 |
| 132 | 449 JMS = JMS + 2 |
| 133 | #endif |
git://git.uio.no / u / mrichter / AliRoot.git / blame